module Handler.Profile where

import Import

import Handler.Utils
import Handler.Utils.Table.Cells

import Utils.Lens
-- import Colonnade hiding (fromMaybe, singleton)
-- import Yesod.Colonnade
import Data.Monoid (Any(..))
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Database.Esqueleto as E
-- import           Database.Esqueleto      ((^.))



data SettingsForm = SettingsForm
      { stgMaxFavourties :: Int
      , stgTheme         :: Theme
      , stgDateTime      :: DateTimeFormat
      , stgDate          :: DateTimeFormat
      , stgTime          :: DateTimeFormat
      , stgDownloadFiles :: Bool
      , stgNotificationSettings :: NotificationSettings
      }

makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
makeSettingForm template html = do
    (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
        <$  aformSection MsgFormCosmetics
        <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
            (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
        <*> areq (selectField . return $ mkOptionList themeList)
            (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
        <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
        <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
        <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
        <*  aformSection MsgFormBehaviour
        <*> areq checkBoxField (fslI MsgDownloadFiles
                                   & setTooltip MsgDownloadFilesTip
                                ) (stgDownloadFiles <$> template)
        <*  aformSection MsgFormNotifications
        <*> notificationForm (stgNotificationSettings <$> template)
    return (result, widget) -- no validation required here
  where
    themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
--
-- Version with proper grouping:
--
-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
-- makeSettingForm template = identForm FIDsettings $ \html -> do
--     (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
--       <$> aFormGroup "Cosmetics"     cosmeticsForm
--       <*> aFormGroup "Notifications" notificationsForm
--       <*  submitButton
--     return (result, widget) -- no validation required here
--   where
--     settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
--     settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
--     themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
--     cosmeticsForm = (,,,,)
--       <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
--             (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
--       <*> areq (selectField . return $ mkOptionList themeList)
--             (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
--       <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
--     notificationsForm = (,)
--       <$> areq checkBoxField (fslI MsgDownloadFiles
--                                & setTooltip MsgDownloadFilesTip
--                              ) (stgDownloadFiles <$> template)
--       <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
--     nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)

notificationForm :: Maybe NotificationSettings -> AForm Handler NotificationSettings
notificationForm template = NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True
  where
    nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt <$> template)


data ButtonResetTokens = BtnResetTokens
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonResetTokens
instance Finite ButtonResetTokens

nullaryPathPiece ''ButtonResetTokens $ camelToPathPiece' 1

embedRenderMessage ''UniWorX ''ButtonResetTokens id
instance Button UniWorX ButtonResetTokens where
  btnClasses BtnResetTokens = [BCIsButton, BCDanger]

data ProfileAnchor = ProfileSettings | ProfileResetTokens
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe ProfileAnchor
instance Finite ProfileAnchor

nullaryPathPiece ''ProfileAnchor $ camelToPathPiece' 1


getProfileR, postProfileR :: Handler Html
getProfileR = postProfileR
postProfileR = do
  (uid, User{..}) <- requireAuthPair
  let settingsTemplate = Just SettingsForm
        { stgMaxFavourties = userMaxFavourites
        , stgTheme         = userTheme
        , stgDateTime      = userDateTimeFormat
        , stgDate          = userDateFormat
        , stgTime          = userTimeFormat
        , stgDownloadFiles = userDownloadFiles
        , stgNotificationSettings = userNotificationSettings
        }
  ((res,formWidget), formEnctype) <- runFormPost . identifyForm ProfileSettings $ makeSettingForm settingsTemplate

  formResult res $ \SettingsForm{..} -> do
    runDB $ do
      update uid  [ UserMaxFavourites  =. stgMaxFavourties
                  , UserTheme          =. stgTheme
                  , UserDateTimeFormat =. stgDateTime
                  , UserDateFormat     =. stgDate
                  , UserTimeFormat     =. stgTime
                  , UserDownloadFiles  =. stgDownloadFiles
                  , UserNotificationSettings =. stgNotificationSettings
                  ]
      when (stgMaxFavourties < userMaxFavourites) $ do
        -- prune Favourites to user-defined size
        oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid]
                                  [ Desc CourseFavouriteTime
                                  , OffsetBy stgMaxFavourties
                                  ]
        mapM_ delete oldFavs
    addMessageI Info MsgSettingsUpdate
    redirect $ ProfileR :#: ProfileSettings

  ((tokenRes, tokenFormWidget), tokenEnctype) <- runFormPost . identifyForm ProfileResetTokens $ buttonForm

  formResult tokenRes $ \BtnResetTokens -> do
    now <- liftIO getCurrentTime
    runDB $ update uid [ UserTokensIssuedAfter =. Just now ]
    addMessageI Info MsgTokensResetSuccess
    redirect $ ProfileR :#: ProfileResetTokens

  tResetTime <- traverse (formatTime SelFormatDateTime) userTokensIssuedAfter

  siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
    setTitle . toHtml $ "Profil " <> userIdent
    let settingsForm =
          wrapForm formWidget FormSettings
            { formMethod = POST
            , formAction = Just . SomeRoute $ ProfileR :#: ProfileSettings
            , formEncoding = formEnctype
            , formAttrs = []
            , formSubmit = FormSubmit
            , formAnchor = Just ProfileSettings
            }
        tokenForm =
          wrapForm tokenFormWidget FormSettings
            { formMethod = POST
            , formAction = Just . SomeRoute $ ProfileR :#: ProfileResetTokens
            , formEncoding = tokenEnctype
            , formAttrs = []
            , formSubmit = FormNoSubmit
            , formAnchor = Just ProfileResetTokens
            }
        tokenExplanation = $(i18nWidgetFile "profile/tokenExplanation")
    $(widgetFile "profile/profile")


getProfileDataR :: Handler Html
getProfileDataR = do
  userEnt <- requireAuth
  dataWidget <- runDB $ makeProfileData userEnt
  defaultLayout $ do
    dataWidget
    $(widgetFile "dsgvDisclaimer")

makeProfileData :: Entity User -> DB Widget
makeProfileData (Entity uid User{..}) = do
  -- MsgRenderer mr <- getMsgRenderer
  admin_rights <- E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
      E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
      E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
      return (school E.^. SchoolShorthand)
  lecturer_rights <- E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
      E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
      E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
      return (school E.^. SchoolShorthand)
  lecture_corrector <- E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
      E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId
      E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
      E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
      return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
  studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
      E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
      E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
      E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
      return  (studyfeat, studydegree, studyterms)
  --Tables
  (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid -- Tabelle mit eigenen Kursen
  enrolledCoursesTable <- mkEnrolledCoursesTable      uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
  submissionTable      <- mkSubmissionTable           uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
  submissionGroupTable <- mkSubmissionGroupTable      uid -- Tabelle mit allen Abgabegruppen
  correctionsTable     <- mkCorrectionsTable          uid -- Tabelle mit allen Korrektor-Aufgaben
  let examTable        = [whamlet|Klausuren werden momentan leider noch nicht unterstützt.|]
  let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
  let tutorialTable    = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
  lastLogin <- traverse (formatTime SelFormatDateTime) userLastAuthentication
  return $(widgetFile "profileData")



mkOwnedCoursesTable :: UserId -> DB (Bool, Widget)
-- Table listing all courses that the given user is a lecturer for
mkOwnedCoursesTable =
  let dbtIdent = "courseOwnership" :: Text
      dbtStyle = def

      withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
               -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
      withType = id

      dbtSQLQuery' uid (course `E.InnerJoin` lecturer) = do
          E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
          E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
          return ( course E.^. CourseTerm
                 , course E.^. CourseSchool
                 , course E.^. CourseShorthand
                 )
      dbtRowKey (course `E.InnerJoin` _) = course E.^. CourseId
      dbtProj = return . (_dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)))

      dbtColonnade = mconcat
          [ dbRow
          , sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do
              tid <- view (_dbrOutput . _1)
              return $ indicatorCell -- return True if one cell is produced here
                `mappend` termCell tid
          , sortable (Just "school") (i18nCell MsgCourseSchool) $
              schoolCell <$> view (_dbrOutput . _1 . re _Just)
                         <*> view (_dbrOutput . _2 )
          , sortable (Just "course") (i18nCell MsgCourse) $
              courseCellCL <$> view _dbrOutput
          ]

      validator = def & defaultSorting [ SortDescBy "term", SortAscBy "school", SortAscBy "course" ]
      dbtSorting = Map.fromList
          [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
          , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm     )
          , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool   )
          ]
      dbtFilter  = Map.fromList
          [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
          , ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
          , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
          ]
      dbtFilterUI = mempty
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
  in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}



mkEnrolledCoursesTable :: UserId -> DB Widget
-- Table listing all courses that the given user is enrolled in
mkEnrolledCoursesTable =
  let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
               -> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
      withType = id

      validator = def & defaultSorting [SortDescBy "time"]

  in \uid -> dbTableWidget' validator
    DBTable
      { dbtIdent     = "courseMembership" :: Text
      , dbtSQLQuery  = \(course `E.InnerJoin` participant) -> do
          E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
          E.where_ $ participant E.^. CourseParticipantUser E.==. E.val uid
          return (course, participant E.^. CourseParticipantRegistration)
      , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId
      , dbtProj      = \x -> return $ x & _dbrOutput . _2 %~ E.unValue
      , dbtColonnade = mconcat
          [ dbRow
          , sortable (Just "term") (i18nCell MsgTerm) $
              termCell   <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
          , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
              schoolCell <$> view ( _courseTerm . re _Just)
                          <*> view  _courseSchool
          , sortable (Just "course") (i18nCell MsgCourse) $
              courseCell <$> view (_dbrOutput . _1 . _entityVal)
          , sortable (Just "time") (i18nCell MsgRegistered) $ do
              regTime <- view $ _dbrOutput . _2
              return $ dateTimeCell regTime
            ]
      , dbtSorting   = Map.fromList
          [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName  )
          , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm  )
          , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
          , ( "time"  , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
          ]
      , dbtFilter    = Map.fromList
          [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName  )
          , ( "term"  , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm  )
          , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
--          , ( "time"  , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
          ]
      , dbtFilterUI  = mempty
      , dbtStyle     = def
      , dbtParams = def
      , dbtCsvEncode = noCsvEncode
      , dbtCsvDecode = Nothing
      }



mkSubmissionTable :: UserId -> DB Widget
-- Table listing all submissions for the given user
mkSubmissionTable =
  let dbtIdent = "submissions" :: Text
      dbtStyle = def

      withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
              ->  ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
      withType = id

      dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) = do
        E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
        E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
        E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
        E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
        let crse = ( course E.^. CourseTerm
                   , course E.^. CourseSchool
                   , course E.^. CourseShorthand
                   )
        let sht  = sheet E.^. SheetName
        return (crse, sht, submission, lastSubEdit uid submission)
      dbtRowKey (_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) = submission E.^. SubmissionId

      lastSubEdit uid submission = -- latest Edit-Time of this user for submission
        E.sub_select . E.from $ \subEdit -> do
          E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
              E.&&.  subEdit E.^. SubmissionEditUser E.==. E.val uid
          return . E.max_ $ subEdit E.^. SubmissionEditTime

      dbtProj x = return $ x
        & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
        & _dbrOutput . _2 %~ E.unValue
        & _dbrOutput . _4 %~ E.unValue

      dbtColonnade = mconcat
        [ dbRow
        , sortable (Just "term") (i18nCell MsgTerm) $
            termCell    <$> view (_dbrOutput . _1 . _1)
        , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
            schoolCell  <$> view ( _1. re _Just)
                        <*> view  _2
        , sortable (Just "course") (i18nCell MsgCourse) $
            courseCellCL <$> view (_dbrOutput . _1)
        , sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
            sheetCell <$> view _1
                      <*> view _2
        , sortable (toNothingS "submission") (i18nCell MsgSubmission) . magnify _dbrOutput $
            submissionCell  <$> view  _1
                            <*> view  _2
                            <*> view (_3 . _entityKey)
--           , sortable (Just "edit") (i18nCell MsgSubmissionEditUser) $ do
--               regTime <- view $ _dbrOutput . _4
--               return $ maybe mempty dateTimeCell regTime
        , sortable (Just "edit") (i18nCell MsgLastEditByUser) $
            maybe mempty dateTimeCell <$> view (_dbrOutput . _4)
        ]

      validator = def -- DUPLICATED CODE: Handler.Corrections
        & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
        & restrictSorting (\name _ -> name /= "corrector")
        & defaultSorting [SortDescBy "edit"]
      dbtSorting' uid = Map.fromList
        [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
        , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm     )
        , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool   )
        , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName    )
        , ( "edit"  , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` submission `E.InnerJoin` _) -> lastSubEdit uid submission )
        ]
      dbtFilter = Map.fromList
        [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
        , ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
        , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
        ]
      dbtFilterUI = mempty
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
                  dbtSorting  = dbtSorting'  uid
              in  dbTableWidget' validator DBTable{..}
--   in do dbtSQLQuery <- dbtSQLQuery'
--         dbtSorting  <- dbtSorting'
--         return $ dbTableWidget' validator $ DBTable {..}



mkSubmissionGroupTable :: UserId -> DB Widget
-- Table listing all submissions for the given user
mkSubmissionGroupTable =
  let dbtIdent = "subGroups" :: Text
      dbtStyle = def
      withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
              ->  ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
      withType = id

      dbtSQLQuery' uid (course `E.InnerJoin` sgroup `E.InnerJoin` sguser) = do
        E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
        E.on $ sgroup E.^. SubmissionGroupCourse              E.==. course E.^. CourseId
        E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
        let crse =  ( course E.^. CourseTerm
                    , course E.^. CourseSchool
                    , course E.^. CourseShorthand
                    )
        return (crse, sgroup, lastSGEdit sgroup)
      dbtRowKey (_ `E.InnerJoin` sgroup `E.InnerJoin` _) = sgroup E.^. SubmissionGroupId

      lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user
        E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do
          E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser
          E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
          return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime

      dbtProj x = return $ x
        & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
        & _dbrOutput . _3 %~ E.unValue

      dbtColonnade = mconcat
        [ dbRow
        , sortable (Just "term") (i18nCell MsgTerm) $
            termCell    <$> view (_dbrOutput . _1 . _1)
        , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
            schoolCell  <$> view ( _1. re _Just)
                        <*> view _2
        , sortable (Just "course") (i18nCell MsgCourse) $
            courseCellCL <$> view (_dbrOutput . _1)
        , sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
            maybe mempty textCell <$> view _submissionGroupName
        , sortable (Just "edit") (i18nCell MsgLastEdit) $
            maybe mempty dateTimeCell <$> view (_dbrOutput . _3)
        ]

      validator = def -- DUPLICATED CODE: Handler.Corrections
        & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
        & restrictSorting (\name _ -> name /= "corrector")
        & defaultSorting [SortDescBy "edit"]
      dbtSorting = Map.fromList
        [ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
        , ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm     )
        , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool   )
        , ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName )
        , ( "edit"  , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup)
        ]
      dbtFilter = Map.fromList
        [ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
        , ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
        , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
        ]
      dbtFilterUI = mempty
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}



mkCorrectionsTable :: UserId -> DB Widget
-- Table listing sum of corrections made by the given user per sheet
mkCorrectionsTable =
  let dbtIdent = "corrections" :: Text
      dbtStyle = def
-- TODO Continue here
      withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
              ->  ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
      withType = id

      corrsAssigned uid sheet = E.sub_select . E.from $ \submission -> do
          E.where_ $ submission E.^. SubmissionSheet    E.==. sheet E.^. SheetId
              E.&&.  submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
          return E.countRows

      corrsCorrected uid sheet = E.sub_select . E.from $ \submission -> do
          E.where_ $ submission E.^. SubmissionSheet    E.==. sheet E.^. SheetId
               E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
               E.&&. E.not_ (E.isNothing $ submission E.^. SubmissionRatingTime)
          return E.countRows

      dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` corrector) = do
        E.on $ sheet E.^. SheetId     E.==. corrector E.^. SheetCorrectorSheet
        E.on $ sheet E.^. SheetCourse E.==. course    E.^. CourseId
        E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
        let crse =  ( course E.^. CourseTerm
                    , course E.^. CourseSchool
                    , course E.^. CourseShorthand
                    )
        return (crse, sheet E.^. SheetName, corrector, (corrsAssigned uid sheet, corrsCorrected uid sheet))
      dbtRowKey (_ `E.InnerJoin` sheet `E.InnerJoin` _) = sheet E.^. SheetId

      dbtProj x = return $ x
        & _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
        & _dbrOutput . _2 %~ E.unValue

      dbtColonnade = mconcat
        [ dbRow
        , sortable (Just "term") (i18nCell MsgTerm) $
            termCellCL   <$> view (_dbrOutput . _1)
        , sortable (Just "school") (i18nCell MsgCourseSchool) $
            schoolCellCL <$> view (_dbrOutput . _1)
        , sortable (Just "course") (i18nCell MsgCourse) $
            courseCellCL <$> view (_dbrOutput . _1)
        , sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
            sheetCell    <$> view _1 <*> view _2
        , sortable (Just "cstate") (i18nCell MsgCorState) $
            correctorStateCell <$> view (_dbrOutput . _3 . _entityVal)
        , sortable (toNothing "cload")  (i18nCell MsgCorProportion) $
            correctorLoadCell  <$> view (_dbrOutput . _3 . _entityVal)
        , sortable (toNothing "assigned")  (i18nCell MsgCorProportion) $
            int64Cell <$> view (_dbrOutput . _4 . _1 . _Value)
        , sortable (toNothing "corrected")  (i18nCell MsgCorProportion) $
            int64Cell <$> view (_dbrOutput . _4 . _2 . _Value)
        ]

      validator = def & defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "course", SortAscBy "sheet"]
      dbtSorting = Map.fromList
        [ ( "term"  , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse  E.^. CourseTerm     )
        , ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse  E.^. CourseSchool   )
        , ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse  E.^. CourseShorthand)
        , ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _) -> sheet E.^. SheetName      )
        , ( "cstate", SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs)    -> cs    E.^. SheetCorrectorState )
        ]
      dbtFilter = Map.fromList
        [ ( "term",   FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm     )
        , ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool   )
        , ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
        ]
      dbtFilterUI = mempty
      dbtParams = def
      dbtCsvEncode = noCsvEncode
      dbtCsvDecode = Nothing
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}


getAuthPredsR, postAuthPredsR :: Handler Html
getAuthPredsR = postAuthPredsR
postAuthPredsR = do
  (AuthTagActive authTagCurrentActive) <- fromMaybe def <$> lookupSessionJson SessionActiveAuthTags

  let
    blacklist = Set.fromList [ AuthFree, AuthDevelopment, AuthDeprecated ]
    taForm authTag
      | authTag `Set.member` blacklist = aforced checkBoxField (fslI authTag) (authTagIsActive def authTag)
      | otherwise = fromMaybe False <$> aopt checkBoxField (fslI authTag) (Just . Just $ authTagCurrentActive authTag)

  ((authActiveRes, authActiveWidget), authActiveEnctype) <- runFormPost . renderAForm FormStandard
    $ AuthTagActive <$> funcForm taForm (fslI MsgActiveAuthTags) True

  mReferer <- runMaybeT $ do
    param <- MaybeT (lookupGetParam $ toPathPiece GetReferer) <|> MaybeT (lookupPostParam $ toPathPiece GetReferer)
    MaybeT . return $ fromPathPiece param

  let authActiveForm = wrapForm authActiveWidget' def
        { formAction = Just $ SomeRoute AuthPredsR
        , formEncoding = authActiveEnctype
        , formSubmit = FormDualSubmit
        }
      authActiveWidget'
        = [whamlet|
            $newline never
            $maybe referer <- mReferer
              <input type=hidden name=#{toPathPiece GetReferer} value=#{toPathPiece referer}>
            ^{authActiveWidget}
          |]

  formResult authActiveRes $ \authTagActive -> do
    setSessionJson SessionActiveAuthTags authTagActive
    modifySessionJson SessionInactiveAuthTags . fmap $ Set.filter (not . authTagIsActive authTagActive)
    addMessageI Success MsgAuthPredsActiveChanged
    redirect $ fromMaybe AuthPredsR mReferer

  siteLayoutMsg MsgAuthPredsActive $ do
    setTitleI MsgAuthPredsActive
    $(widgetFile "authpreds")


getUserNotificationR, postUserNotificationR :: CryptoUUIDUser -> Handler Html
getUserNotificationR = postUserNotificationR
postUserNotificationR cID = do
  uid <- decrypt cID
  User{userNotificationSettings, userDisplayName} <- runDB $ get404 uid

  ((nsRes, nsInnerWdgt), nsEnc) <- runFormPost . formEmbedJwtPost . renderAForm FormStandard . notificationForm $ Just userNotificationSettings
  mJwt <- askJwt
  isModal <- hasCustomHeader HeaderIsModal
  let formWidget = wrapForm nsInnerWdgt def
        { formAction = Just . SomeRoute $ UserNotificationR cID
        , formEncoding = nsEnc
        , formAttrs = [ asyncSubmitAttr | isModal ]
        }

  formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece jwt) | Just jwt <- pure mJwt ]) $ \ns -> do
    lift . runDB $ update uid [ UserNotificationSettings =. ns ]
    tell . pure =<< messageI Success MsgNotificationSettingsUpdate

  siteLayoutMsg (MsgNotificationSettingsHeading userDisplayName) $ do
    setTitleI $ MsgNotificationSettingsHeading userDisplayName
    formWidget
