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 = identForm FIDsettings $ \html -> do
    let themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
    (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
      <$> 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)
      <*> areq checkBoxField (fslI MsgDownloadFiles
                               & setTooltip MsgDownloadFilesTip
                             ) (stgDownloadFiles <$> template)
      <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
      <*  submitButton
    return (result, widget) -- no validation required here
  where
    nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)


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 $ makeSettingForm settingsTemplate
  case res of
    (FormSuccess 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 -- TODO: them change does not happen without redirect

    (FormFailure msgs) -> forM_ msgs $ addMessage Warning . toHtml
    _ -> return ()

  let formText  = Nothing :: Maybe UniWorXMessage
      actionUrl = ProfileR      
  defaultLayout $ do
    setTitle . toHtml $ userIdent <> "'s User page"
    $(widgetFile "formPageI18n")    

postProfileDataR  :: Handler Html
postProfileDataR = do
  ((btnResult,_), _) <- runFormPost buttonForm
  case btnResult of
    (FormSuccess BtnDelete) -> do
      (uid, User{..}) <- requireAuthPair
      clearCreds False -- Logout-User
      ((deletedSubmissions,groupSubmissions),deletedSubmissionGroups) <- runDB $ deleteUser uid
      -- addMessageIHamlet
      $(addMessageFile Success "templates/deletedUser.hamlet") -- USE THIS ONE
      -- addMessageI Success $ MsgDeleteUser deletedSubmissions
      -- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
      defaultLayout
        $(widgetFile "deletedUser")

    (FormSuccess BtnAbort ) -> do
      addMessageI Info MsgAborted
      redirect ProfileDataR
    _other -> getProfileDataR



deleteUser :: UserId -> DB ((Int,Int),Int64) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration
deleteUser duid = do
    -- E.deleteCount for submissions is not cascading, hence we first select and then delete manually
    -- We delete all files tied to submissions where the user is the lone submissionUser

    -- Do not deleteCascade submissions where duid is the corrector:
    updateWhere [SubmissionRatingBy ==. Just duid] [SubmissionRatingBy =. Nothing]

    groupSubmissions  <- selectSubmissionsWhere (\numBuddies -> numBuddies E.>.  E.val (0::Int64))
    singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64))
    deleteCascade duid
    forM_ singleSubmissions $ \(E.Value submissionId) -> do
      deleteFileIds  <- map E.unValue <$> getSubmissionFiles submissionId
      deleteCascade submissionId
      deleteCascadeWhere [FileId <-. deleteFileIds] -- TODO: throws exception for de-duplicated files

    deletedSubmissionGroups <- deleteSingleSubmissionGroups
    return ((length singleSubmissions, length groupSubmissions),deletedSubmissionGroups)
  where
    selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool)) -> DB [E.Value (Key Submission)]
    selectSubmissionsWhere whereBuddies = E.select $ E.from $ \(submission `E.InnerJoin` suser) -> do
        E.on $ submission E.^. SubmissionId E.==. suser E.^. SubmissionUserSubmission
        let numBuddies = E.sub_select $ E.from $ \subUsers -> do
                E.where_ $ subUsers E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
                    E.&&.  subUsers E.^. SubmissionUserUser E.!=. E.val duid
                return E.countRows
        E.where_ $ suser E.^. SubmissionUserUser E.==. E.val duid
             E.&&. whereBuddies numBuddies
        return $ submission E.^. SubmissionId

    getSubmissionFiles :: SubmissionId ->  DB [E.Value (Key File)]
    getSubmissionFiles subId = E.select $ E.from $ \file -> do
      E.where_ $ E.exists $ E.from $ \submissionFile ->
          E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
              E.&&.  submissionFile E.^. SubmissionFileFile E.==. file E.^. FileId
      return $ file E.^. FileId

    deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
      E.where_ $ E.exists $ E.from $ \subGroupUser ->
          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
               E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
      E.where_ $ E.notExists $ E.from $ \subGroupUser ->
          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
               E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid






getProfileDataR :: Handler Html
getProfileDataR = do
  (uid, User{..}) <- requireAuthPair
  --   mr <- getMessageRender
  (admin_rights,lecturer_rights,lecture_corrector,studies) <- runDB $ (,,,) <$>
    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)
      )
    <*>
    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)
      )
    <*>
    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)
      )
    <*>
    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  ( ( studydegree E.^. StudyDegreeName
                      , studydegree E.^. StudyDegreeKey
                      )
                  , ( studyterms  E.^. StudyTermsName
                      , studyterms  E.^. StudyTermsKey
                      )
                  , studyfeat   E.^. StudyFeaturesType
                  , studyfeat   E.^. StudyFeaturesSemester)
      )
  -- Tabelle mit eigenen Kursen
  (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
  -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
  enrolledCoursesTable <- mkEnrolledCoursesTable uid
  -- Tabelle mit allen Klausuren und Noten
  let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
  -- Tabelle mit allen Abgaben und Abgabe-Gruppen
  submissionTable <- mkSubmissionTable uid
  -- Tabelle mit allen Abgabegruppen
  submissionGroupTable <- mkSubmissionGroupTable uid
  -- Tabelle mit allen Korrektor-Aufgaben
  correctionsTable <- mkCorrectionsTable uid
  -- Tabelle mit allen eigenen Tutorials
  let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
  -- Tabelle mit allen Tutorials
  let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
  -- Delete Button
  (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form BtnDelete)
  -- TODO: move this into a Message and/or Widget-File
  defaultLayout $ do
    let delWdgt = $(widgetFile "widgets/data-delete")
    $(widgetFile "profileData")
    $(widgetFile "dsgvDisclaimer")



mkOwnedCoursesTable :: UserId -> Handler (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
                 )
      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 [ ("term", SortDesc), ("school", SortAsc), ("course", SortAsc) ]
      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   )
          ]
  in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}



mkEnrolledCoursesTable :: UserId -> Handler 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 [("time",SortDesc)]

  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)
      , 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 $ timeCell 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 )
          ]
      , dbtStyle     = def
      }



mkSubmissionTable :: UserId -> Handler 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)

      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 timeCell regTime
        , sortable (Just "edit") (i18nCell MsgLastEditByUser) $
            maybe mempty timeCell <$> 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 [("edit",SortDesc)]
      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   )
        ]
  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 -> Handler 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)

      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 timeCell <$> 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 [("edit",SortDesc)]
      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   )
        ]
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}



mkCorrectionsTable :: UserId -> Handler 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))

      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 . _unValue)
        , sortable (toNothing "corrected")  (i18nCell MsgCorProportion) $
            int64Cell <$> view (_dbrOutput . _4 . _2 . _unValue)
        ]

      validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc),("sheet",SortAsc)]
      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)
        ]
  in \uid ->  let dbtSQLQuery = dbtSQLQuery' uid
              in  dbTableWidget' validator DBTable{..}