{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}

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 Data.Map ((!))
import qualified Data.Set as Set
-- 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)
      <*> formToAForm (nsFieldView =<< renderAForm FormStandard nsForm mempty)
      <*  submitButton
    return (result, widget) -- no validation required here
  where
    nsForm = fmap (\m -> NotificationSettings $ \nt -> m ! nt) . sequenceA . flip Map.fromSet (Set.fromList universeF) $ \nt ->
      areq checkBoxField (fslI nt) (flip notificationAllowed nt . stgNotificationSettings <$> template)
    nsFieldView :: (FormResult NotificationSettings, Widget) -> MForm Handler (FormResult NotificationSettings, [FieldView UniWorX])
    nsFieldView (res, fvInput) = do
      mr <- getMessageRender
      let fvLabel = toHtml $ mr MsgNotificationSettings
          fvTooltip = mempty
          fvRequired = True
          fvErrors
            | FormFailure (err:_) <- res = Just $ toHtml err
            | otherwise = Nothing
      fvId <- newIdent
      return (res, pure FieldView{..})
    -- areq nsField (fslI MsgNotificationSettings) (stgNotficationSettings <$> 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 ()


  (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)
            )
  let formText  = Just MsgSettings
      actionUrl = ProfileR
      settingsForm = $(widgetFile "formPageI18n")
  defaultLayout $ do
    setTitle . toHtml $ userIdent <> "'s User page"
    $(widgetFile "profile")
    $(widgetFile "dsgvDisclaimer")

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 $ do
        $(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 -> do
          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 -> do
          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
              E.&&.  subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
      E.where_ $ E.notExists $ E.from $ \subGroupUser -> do
          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
  -- Tabelle mit eigenen Kursen
  (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
  -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
  enrolledCoursesTable <- mkEnrolledCoursesTable uid
  -- Tabelle mit allen Klausuren und Noten
  examTable <- return [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
  ownTutorialTable <- return [whamlet| Übungsgruppen werden momentan leider noch nicht unterstützt.|]
  -- Tabelle mit allen Tutorials
  tutorialTable <- return [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
  let delWdgt = [whamlet|
        <form .form-inline method=post action=@{ProfileDataR} enctype=#{btnEnctype}>
          <h2>
            Sind Sie sich absolut sicher, alle Ihre in Uni2work gespeicherten Daten zu löschen?
          <div .container>
              Während der Testphase von Uni2work können Sie hiermit
              Ihren Account bei Uni2work vollständig löschen.
              Mit Ihrem Campus-Account können Sie sich aber danach
              jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
          <div .container>
              Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
              wenn die Dateien ausschließlich Ihnen zugeordnet sind.
              Dateien aus Gruppenabgaben werden also erst dann gelöscht,
              wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
          <div .container>
              <em>Achtung:
              Auch abgegebene Hausübungen werden gelöscht!
              Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
              kann dadurch ein etwaiger Hausaufgabenbonus verloren gehen.
              (Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
              Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
              auch nicht mehr rekonstruiert/berücksichtigt werden.)
          <div .container>
            <em>Nach der Testphase von Uni2work wird das Löschen eines Accounts etwas
            eingeschränkt werden, da z.B. Klausurnoten 5 Jahre bis nach Exmatrikulation
            aufbewahrt werden müssen.
          <div .container>
            ^{btnWdgt}
      |]
  defaultLayout $ do
    $(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 = \x -> return $ x & _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 {..}