module Handler.Corrections where

import Import
-- import System.FilePath (takeFileName)

import Jobs
import Handler.Utils
import Handler.Utils.Corrections
import Handler.Utils.Submission
import Handler.Utils.Table.Cells
import Handler.Utils.SheetType
import Handler.Utils.Delete
-- import Handler.Utils.Zip

import Utils.Lens

import Data.List as List (nub, foldl, foldr)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map.Strict (Map, (!))
import qualified Data.Map.Strict as Map

import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
import Data.CaseInsensitive (CI)

import Data.Semigroup (Sum(..))
import Data.Monoid (All(..))

-- import Data.Time
-- import Data.Function ((&))
--
-- import Colonnade hiding (fromMaybe, singleton, bool)
-- import Yesod.Colonnade
--
-- import qualified Data.UUID.Cryptographic as UUID
-- import qualified Data.Conduit.List as C

import Database.Esqueleto.Utils.TH
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
import qualified Database.Esqueleto.Internal.Language (From)
-- import qualified Database.Esqueleto.Internal.Sql as E

-- import Control.Monad.Writer (MonadWriter(..), execWriterT)

-- import Network.Mime

import Text.Hamlet (ihamletFile)

import Database.Persist.Sql (updateWhereCount)

import Data.List (genericLength)

import Control.Monad.Trans.Writer (WriterT(..), runWriter, execWriterT)
import Control.Monad.Trans.Reader (mapReaderT)

import Control.Monad.Trans.State (State, runState)
import qualified Control.Monad.State.Class as State

import Data.Foldable (foldrM)



type CorrectionTableExpr  = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym))

correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
    E.on $ corrector E.?. UserId   E.==. submission E.^. SubmissionRatingBy
    E.on $ sheet     E.^. SheetId  E.==. submission E.^. SubmissionSheet
    E.on $ course    E.^. CourseId E.==. sheet      E.^. SheetCourse
    E.where_ $ whereClause t
    return $ returnStatement t

lastEditQuery :: Database.Esqueleto.Internal.Language.From query expr backend (expr (Entity SubmissionEdit))
  => expr (Entity Submission) -> expr (E.Value (Maybe UTCTime))
lastEditQuery submission = E.sub_select $ E.from $ \edit -> do
  E.where_ $ edit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
  return $ E.max_ $ edit E.^. SubmissionEditTime

queryCourse :: CorrectionTableExpr -> E.SqlExpr (Entity Course)
queryCourse = $(sqlIJproj 3 1) . $(sqlLOJproj 2 1)

querySheet :: CorrectionTableExpr -> E.SqlExpr (Entity Sheet)
querySheet = $(sqlIJproj 3 2) . $(sqlLOJproj 2 1)

querySubmission :: CorrectionTableExpr -> E.SqlExpr (Entity Submission)
querySubmission = $(sqlIJproj 3 3) . $(sqlLOJproj 2 1)

queryCorrector :: CorrectionTableExpr -> E.SqlExpr (Maybe (Entity User))
queryCorrector = $(sqlLOJproj 2 2)

-- Where Clauses
ratedBy :: UserId -> CorrectionTableWhere
ratedBy uid   ((_course `E.InnerJoin` _sheet `E.InnerJoin`  submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)

courseIs :: CourseId -> CorrectionTableWhere
courseIs cid  (( course `E.InnerJoin` _sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = course E.^. CourseId E.==. E.val cid

sheetIs :: Key Sheet -> CorrectionTableWhere
sheetIs shid  ((_course `E.InnerJoin`  sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetId E.==. E.val shid


-- Columns
colTerm :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colTerm = sortable (Just "term") (i18nCell MsgTerm)
        $ \DBRow{ dbrOutput } ->
          textCell $ termToText $ unTermKey $ dbrOutput ^. _3 . _3 -- kurze Semsterkürzel

colSchool :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
          $ \DBRow{ dbrOutput } -> let course = dbrOutput ^. _3 in
            anchorCell (TermSchoolCourseListR (course ^. _3) (course ^. _4)) [whamlet|#{unSchoolKey (course ^. _4)}|]

colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse)
        $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _) } -> courseCellCL (tid,sid,csh)

colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row ->
          let sheet = row ^. _dbrOutput . _2
              course= row ^. _dbrOutput . _3
              tid   = course ^. _3
              ssh   = course ^. _4
              csh   = course ^. _2
              shn   = sheetName $ entityVal sheet
          in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|_{shn}|]

colSheetType :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType) $
        i18nCell . sheetType <$> view (_dbrOutput . _2 . _entityVal)
        -- \DBRow{ dbrOutput=(_, sheet, _, _, _, _) } -> i18nCell . sheetType $ entityVal sheet

colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
  DBRow{ dbrOutput = (_, _, _, Nothing  , _, _) } -> cell mempty
  DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _) } -> userCell userDisplayName userSurname

colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
        $ \DBRow{ dbrOutput=(submission, sheet, course, _, _,_) } ->
          let csh = course ^. _2
              tid = course ^. _3
              ssh = course ^. _4
              shn = sheetName $ entityVal sheet
              mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
              mkRoute = do
                cid <- mkCid
                return $ CSubmissionR tid ssh csh shn cid SubShowR
          in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{cid}|])

colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary))
colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> encrypt subId

colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users) } -> let
  csh = course ^. _2
  tid = course ^. _3
  ssh = course ^. _4
  link cid = CourseR tid ssh csh $ CUserR cid
  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, mPseudo)) ->
    anchorCellM (link <$> encrypt userId) $ case mPseudo of
      Nothing -> nameWidget userDisplayName userSurname
      Just p  -> [whamlet|^{nameWidget userDisplayName userSurname} (#{review _PseudonymText p})|]
  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]

colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
  protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer)
  in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]

colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary))
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _) } ->
  let csh = course ^. _2
      tid = course ^. _3
      ssh = course ^. _4
      -- shn = sheetName

      mkRoute = do
        cid <- encrypt subId
        return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
      mTuple mA mB = (,) <$> mA <*> mB -- Hamlet does not support enough haskell-syntax for this
  in mconcat
     [ anchorCellM mkRoute $(widgetFile "widgets/rating/rating")
     , writerCell $ do
         let
           summary :: SheetTypeSummary
           summary = sheetTypeSum sheetType $ submissionRatingPoints <* guard (submissionRatingDone sub)
         scribe (_2 :: Lens' (a, SheetTypeSummary) SheetTypeSummary) summary
     ]

colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
  maybe mempty dateTimeCell submissionRatingAssigned

colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } ->
  maybe mempty dateTimeCell submissionRatingTime

colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let
    lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo ->
      cell [whamlet|#{review _PseudonymText pseudo}|]
  in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]

colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData)))
colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id
  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
  (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done))

colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData)))
colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id
  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
  (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of
      NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
      _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints)
  )

colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (addCellAttrs [("style","width:60%")]) $ formCell id
  (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId)
  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment))

colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $
   \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _) } -> maybe mempty dateTimeCell mbLastEdit


makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
                     => CorrectionTableWhere -> Colonnade h CorrectionTableData (DBCell m x) -> _ -> PSValidator m x -> _ -> DBParams m x -> DB (DBResult m x)
makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' dbtParams = do
  let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
      dbtSQLQuery = correctionsTableQuery whereClause
          (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) ->
            let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value CourseName)
                        , course E.^. CourseShorthand
                        , course E.^. CourseTerm
                        , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
                        )
            in (submission, sheet, crse, corrector, lastEditQuery submission)
          )
      dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData
      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector,  E.Value mbLastEdit) -> do
        submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
          E.on $ pseudonym E.?. SheetPseudonymUser E.==. E.just (user E.^. UserId)
           E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
          E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
          E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
          E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
          return (user, pseudonym E.?. SheetPseudonymPseudonym)
        let
          submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
        dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap)
  dbTable psValidator DBTable
    { dbtSQLQuery
    , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId
    , dbtColonnade
    , dbtProj
    , dbtSorting   = Map.fromList
      [ ( "term"
        , SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseTerm
        )
      , ( "school"
        , SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseSchool
        )
      , ( "course"
        , SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
        )
      , ( "sheet"
        , SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName
        )
      , ( "corrector"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserSurname
        )
      , ( "rating"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
        )
      , ( "israted"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
        )
      , ( "ratingtime"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingTime
        )
      , ( "assignedtime"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
        )
      , ( "submittors"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
            E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
              E.orderBy [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]
              E.limit 1
              return (user E.^. UserSurname)
        )
      , ( "comment" -- sorting by comment specifically requested by correctors to easily see submissions to be done
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingComment
        )
      , ( "last-edit"
        , SortColumn $ \((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) -> lastEditQuery submission
        )
      ]
    , dbtFilter    = Map.fromList
      [ ( "term"
        , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if
            | Set.null tids -> E.val True :: E.SqlExpr (E.Value Bool)
            | otherwise     -> course E.^. CourseTerm `E.in_` E.valList (Set.toList tids)
        )
      , ( "school"
        , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) sids -> if
            | Set.null sids -> E.val True :: E.SqlExpr (E.Value Bool)
            | otherwise     -> course E.^. CourseSchool `E.in_` E.valList (Set.toList sids)
        )
      , ( "course"
        , FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) cshs -> if
            | Set.null cshs -> E.val True :: E.SqlExpr (E.Value Bool)
            | otherwise     -> course E.^. CourseShorthand `E.in_` E.valList (Set.toList cshs)
        )
      , ( "sheet"
        , FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> if
            | Set.null shns -> E.val True :: E.SqlExpr (E.Value Bool)
            | otherwise     -> sheet E.^. SheetName `E.in_` E.valList (Set.toList shns)
        )
      , ( "sheet-search"
        , FilterColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) shns -> case getLast (shns :: Last (CI Text)) of
            Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
            Just needle -> sheet E.^. SheetName `E.ilike` (E.%) E.++. E.val needle E.++. (E.%)
        )
      , ( "corrector"
        , FilterColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector :: CorrectionTableExpr) emails -> if
            | Set.null emails -> E.val True :: E.SqlExpr (E.Value Bool)
            | otherwise       -> corrector E.?. UserEmail `E.in_` E.justList (E.valList . catMaybes $ Set.toList emails)
                           E.||. (if Nothing `Set.member` emails then E.isNothing (corrector E.?. UserEmail) else E.val False)
        )
      , ( "isassigned"
        , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
            Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
            Just True -> E.isJust    $ submission E.^. SubmissionRatingBy
            Just False-> E.isNothing $ submission E.^. SubmissionRatingBy
        )
      , ( "israted"
        , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
            Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
            Just True -> E.isJust    $ submission E.^. SubmissionRatingTime
            Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
        )
      , ( "corrector-name-email" -- corrector filter does not work for text-filtering
        , FilterColumn $ E.anyFilter
            [ E.mkContainsFilterWith Just $ queryCorrector >>> (E.?. UserSurname)
            , E.mkContainsFilterWith Just $ queryCorrector >>> (E.?. UserDisplayName)
            , E.mkContainsFilterWith (Just . CI.mk) $ queryCorrector >>> (E.?. UserEmail)
            ]
        )
      , ( "user-name-email"
        , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionUser `E.InnerJoin` user) -> do
              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
              E.where_ $ querySubmission table E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
              E.where_ $ (\f -> f user $ Set.singleton needle) $ E.anyFilter
                [ E.mkContainsFilter (E.^. UserSurname)
                , E.mkContainsFilter (E.^. UserDisplayName)
                , E.mkContainsFilterWith CI.mk (E.^. UserEmail)
                ]
        )
      , ( "user-matriclenumber"
        , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(submissionUser `E.InnerJoin` user) -> do
              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
              E.where_ $ querySubmission table E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
              E.where_ $ (\f -> f user $ Set.singleton needle) $
                E.mkContainsFilter (E.^. UserMatrikelnummer)
        )
      -- , ( "pseudonym"
      --   , FilterColumn $ E.mkExistsFilter $ \table needle -> E.from $ \(pseudonym) -> do
      --       E.where_ $ querySheet table E.^. SheetId E.==. pseudonym E.^. SheetPseudonymSheet
      --       E.where_ $ E.mkContainsFilter -- DB only stores Pseudonym == Word24. Conversion not possible in DB.
      --   )
      ]
    , dbtFilterUI  = fromMaybe mempty dbtFilterUI
    , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
    , dbtParams
    , dbtIdent     = "corrections" :: Text
    , dbtCsvEncode = noCsvEncode
    , dbtCsvDecode = Nothing
    }

data ActionCorrections = CorrDownload
                       | CorrSetCorrector
                       | CorrAutoSetCorrector
                       | CorrDelete
  deriving (Eq, Ord, Read, Show, Enum, Bounded)

instance Universe ActionCorrections
instance Finite ActionCorrections

nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''ActionCorrections id

data ActionCorrectionsData = CorrDownloadData
                           | CorrSetCorrectorData (Maybe UserId)
                           | CorrAutoSetCorrectorData SheetId
                           | CorrDeleteData

correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
  Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler

  postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
    { drAbort = SomeRoute currentRoute
    , drSuccess = SomeRoute currentRoute
    }

  ((actionRes', statistics), table) <- runDB $
    makeCorrectionsTable whereClause displayColumns dbtFilterUI psValidator return DBParamsForm
      { dbParamsFormMethod = POST
      , dbParamsFormAction = Just $ SomeRoute currentRoute
      , dbParamsFormAttrs = []
      , dbParamsFormSubmit = FormSubmit
      , dbParamsFormAdditional = \frag -> do
          (actionRes, action) <- multiActionM actions "" Nothing mempty
          return ((, mempty) . Last . Just <$> actionRes, toWidget frag <> action)
      , dbParamsFormEvaluate = liftHandlerT . runFormPost
      , dbParamsFormResult = _1
      , dbParamsFormIdent = def
      }
    -- -- Similar Query for Statistics over alle possible Table elements (not just the ones shown)
    -- gradingSummary <- do
    --   let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
    --   points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
    --   -- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
    --   return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
    -- let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
    -- return (tableRes, statistics)

  let actionRes = actionRes' & mapped._2 %~ Map.keysSet . Map.filter id . getDBFormResult (const False)
                             & mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast

  case actionRes of
    FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs
    FormMissing      -> return ()
    FormSuccess (CorrDownloadData, subs) -> do
      ids <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
      addHeader "Content-Disposition" [st|attachment; filename="corrections.zip"|]
      sendResponse =<< submissionMultiArchive ids
    FormSuccess (CorrSetCorrectorData (Just uid), subs') -> do
      subs <- mapM decrypt $ Set.toList subs'
      now <- liftIO getCurrentTime
      runDB $ do
        alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
        unless (null alreadyAssigned) $ do
          mr <- (toHtml . ) <$> getMessageRender
          alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
          addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
        let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
        (unassignedAuth, unassignedUnauth) <- partitionM authorizedToAssign unassigned
        unless (null unassignedUnauth) $ do
          let submissionEncrypt = encrypt :: SubmissionId -> DB CryptoFileNameSubmission
          unassignedUnauth' <- mapM submissionEncrypt $ Set.toList unassignedUnauth
          let numUnassignedUnauth = fromIntegral $ length unassignedUnauth'
              trigger = [whamlet|_{MsgSubmissionsAssignUnauthorized numUnassignedUnauth}|]
              content = Right $(widgetFile "messages/submissionsAssignUnauthorized")
          addMessageModal Warning trigger content
        unless (null unassignedAuth) $ do
          num <- updateWhereCount [SubmissionId <-. Set.toList unassignedAuth]
                    [ SubmissionRatingBy       =. Just uid
                    , SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned
                    ]
          addMessageI Success $ MsgUpdatedAssignedCorrectorSingle num
        (E.Value selfCorrectors:_) <- E.select . E.from $ \(submission `E.InnerJoin` subuser) -> do
            E.on $ submission E.^. SubmissionId E.==. subuser E.^. SubmissionUserSubmission
            E.where_ $ submission E.^. SubmissionId `E.in_` E.valList subs
                E.&&.  submission E.^. SubmissionRatingBy E.==. E.just (subuser E.^. SubmissionUserUser)
            return (E.countRows :: E.SqlExpr (E.Value Int64))
        when (selfCorrectors > 0) $ addMessageI Warning $ MsgSelfCorrectors selfCorrectors
      redirect currentRoute
    FormSuccess (CorrSetCorrectorData Nothing, subs') -> do -- delete corrections
      subs <- mapM decrypt $ Set.toList subs'
      runDB $ do
        num <- updateWhereCount [SubmissionId <-. subs]
                  [ SubmissionRatingBy       =. Nothing
                  , SubmissionRatingAssigned =. Nothing
                  , SubmissionRatingTime     =. Nothing
                  -- , SubmissionRatingPoints   =. Nothing -- Kept for easy reassignment by 2nd corrector
                  -- , SubmissionRatingComment  =. Nothing -- Kept for easy reassignment by 2nd corrector
                  ]
        addMessageI Success $ MsgRemovedCorrections num
      redirect currentRoute
    FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
      subs <- mapM decrypt $ Set.toList subs'
      let
        assignExceptions :: AssignSubmissionException -> Handler ()
        assignExceptions NoCorrectors = addMessageI Error MsgAssignSubmissionExceptionNoCorrectors
        assignExceptions NoCorrectorsByProportion = addMessageI Error MsgAssignSubmissionExceptionNoCorrectorsByProportion
        assignExceptions (SubmissionsNotFound subIds) = do
          subCIDs <- mapM encrypt . Set.toList $ toNullable subIds :: Handler [CryptoFileNameSubmission]
          let errorModal = msgModal
                [whamlet|_{MsgAssignSubmissionExceptionSubmissionsNotFound (length subCIDs)}|]
                (Right $(widgetFile "messages/submissionsAssignNotFound"))
          addMessageWidget Error errorModal

      handle assignExceptions . runDB $ do
        alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
        unless (null alreadyAssigned) $ do
          mr <- (toHtml . ) <$> getMessageRender
          alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
          addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
        let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
        (unassignedAuth, unassignedUnauth) <- partitionM authorizedToAssign unassigned
        unless (null unassignedUnauth) $ do
          let submissionEncrypt = encrypt :: SubmissionId -> DB CryptoFileNameSubmission
          unassignedUnauth' <- mapM submissionEncrypt $ Set.toList unassignedUnauth
          let numUnassignedUnauth = fromIntegral $ length unassignedUnauth'
              trigger = [whamlet|_{MsgSubmissionsAssignUnauthorized numUnassignedUnauth}|]
              content = Right $(widgetFile "messages/submissionsAssignUnauthorized")
          addMessageModal Warning trigger content
        unless (null unassignedAuth) $ do
          (assigned, stillUnassigned) <- assignSubmissions shid (Just unassignedAuth)
          unless (null assigned) $
            addMessageI Success $ MsgUpdatedAssignedCorrectorsAuto (fromIntegral $ Set.size assigned)
          unless (null stillUnassigned) $ do
            mr <- (toHtml . ) <$> getMessageRender
            unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission
            addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
      redirect currentRoute
    FormSuccess (CorrDeleteData, subs) -> do
      subs' <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
      getDeleteR (submissionDeleteRoute subs')
        { drAbort = SomeRoute currentRoute
        , drSuccess = SomeRoute currentRoute
        }

  fmap toTypedContent . defaultLayout $ do
    setTitleI MsgCourseCorrectionsTitle
    $(widgetFile "corrections")

  where
    authorizedToAssign :: SubmissionId -> DB Bool
    authorizedToAssign sId = do
      [(E.Value tid, E.Value ssh, E.Value csh, E.Value shn)] <-
        E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission ) -> do
          E.on $  sheet E.^. SheetId  E.==. submission E.^. SubmissionSheet
          E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
          E.where_ $ submission E.^. SubmissionId E.==. E.val sId
          return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand, sheet E.^. SheetName)
      cID <- encrypt sId
      let route  = CSubmissionR tid ssh csh shn cID SubAssignR
      (== Authorized) <$> evalAccessDB route True

type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData)

downloadAction, deleteAction :: ActionCorrections'
downloadAction = ( CorrDownload
                 , pure CorrDownloadData
                 )
deleteAction = ( CorrDelete
               , pure CorrDeleteData
               )

assignAction :: Either CourseId SheetId -> ActionCorrections'
assignAction selId = ( CorrSetCorrector
                     , wFormToAForm $ do
                         correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do
                           E.on $   user E.^. UserId   E.==. sheetCorrector E.^. SheetCorrectorUser
                           E.on $  sheet E.^. SheetId  E.==. sheetCorrector E.^. SheetCorrectorSheet
                           E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse

                           E.where_ $ either (\cId -> course E.^. CourseId E.==. E.val cId) (\shId -> sheet E.^. SheetId E.==. E.val shId) selId

                           E.orderBy $ [E.asc $ user E.^. UserSurname, E.asc $ user E.^. UserDisplayName]

                           E.distinct $ return user

                         correctors' <- forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (SomeMessage userDisplayName, ) <$> encrypt entityKey

                         cId <- wopt (selectFieldList correctors' :: Field (HandlerT UniWorX IO) CryptoUUIDUser) (fslI MsgCorrector & setTooltip MsgCorrSetCorrectorTooltip) Nothing
                         fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId
                     )

autoAssignAction :: SheetId -> ActionCorrections'
autoAssignAction shid = ( CorrAutoSetCorrector
                        , pure $ CorrAutoSetCorrectorData shid
                        )

getCorrectionsR, postCorrectionsR :: Handler TypedContent
getCorrectionsR = postCorrectionsR
postCorrectionsR = do
  uid <- requireAuthId
  let whereClause = ratedBy uid
      colonnade = mconcat
        [ colSelect
        , dbRow     -- very useful, since correction statistics are still missing.
        , colSchool
        , colTerm
        , colCourse
        , colSheet
        , colPseudonyms
        , colSubmissionLink
        , colAssigned
        , colRating
        , colRated
        ] -- Continue here
      filterUI = Just $ \mPrev -> mconcat
        [ prismAForm (singletonFilter "course" ) mPrev $ aopt (lift `hoistField` selectField courseOptions) (fslI MsgCourse)
        , prismAForm (singletonFilter "term"   ) mPrev $ aopt (lift `hoistField` selectField termOptions)   (fslI MsgTerm)
        , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectField schoolOptions) (fslI MsgCourseSchool)
        , Map.singleton "sheet-search" . maybeToList <$> aopt (lift `hoistField` textField)                 (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
        , prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt boolField             (fslI MsgRatingTime)
        ]
      courseOptions = runDB $ do
        courses <- selectList [] [Asc CourseShorthand] >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . courseShorthand . entityVal) courses
      termOptions = runDB $ do
        courses <- selectList [] [Asc CourseTerm]      >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs $ map (id &&& id) $ nub $ map (termToText . unTermKey . courseTerm . entityVal) courses
      schoolOptions = runDB $ do
        courses <- selectList [] [Asc CourseSchool]    >>= filterM (\(Entity _ Course{..}) -> (== Authorized) <$> evalAccessCorrector courseTerm courseSchool courseShorthand)
        optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses

      psValidator = def
        & restrictFilter  (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
        & restrictSorting (\name _ -> name /= "corrector")
        & defaultSorting [SortAscBy "israted", SortDescBy "ratingTime", SortAscBy "assignedtime" ]
        -- & defaultFilter (Map.fromList [("israted",[toPathPiece False])]) -- DEPENDS ON ISSUE #371 UNCOMMENT THEN
  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
    [ downloadAction
    ]

getCCorrectionsR, postCCorrectionsR ::  TermId -> SchoolId -> CourseShorthand -> Handler TypedContent
getCCorrectionsR = postCCorrectionsR
postCCorrectionsR tid ssh csh = do
  Entity cid _ <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
  let whereClause = courseIs cid
      colonnade = mconcat -- should match getSSubsR for consistent UX
        [ colSelect
        , dbRow
        , colSheet
        , colSMatrikel
        , colSubmittors
        , colSubmissionLink
        , colLastEdit
        , colRating
        , colRated
        , colCorrector
        , colAssigned
        ] -- Continue here
      filterUI = Just $ \mPrev -> mconcat
        [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
        , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
        -- "pseudonym" TODO DB only stores Word24
        , Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet)        (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
        , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
        ]
      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
    [ downloadAction
    , assignAction (Left cid)
    , deleteAction
    ]

getSSubsR, postSSubsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent
getSSubsR = postSSubsR
postSSubsR tid ssh csh shn = do
  shid <- runDB $ fetchSheetId tid ssh csh shn
  let whereClause = sheetIs shid
      colonnade = mconcat -- should match getCCorrectionsR for consistent UX
        [ colSelect
        , dbRow
        , colSMatrikel
        , colSubmittors
        , colSubmissionLink
        , colLastEdit
        , colRating
        , colRated
        , colCorrector
        , colAssigned
        ]
      filterUI = Just $ \mPrev -> mconcat
        [ prismAForm (singletonFilter "user-name-email")      mPrev $ aopt textField (fslI MsgCourseMembers)
        , prismAForm (singletonFilter "user-matriclenumber")  mPrev $ aopt textField (fslI MsgMatrikelNr)
        , prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
        , prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgHasCorrector)
        , prismAForm (singletonFilter "israted"    . maybePrism _PathPiece) mPrev $ aopt boolField (fslI MsgRatingTime)
        -- "pseudonym" TODO DB only stores Word24
        ]
      psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
  correctionsR whereClause colonnade filterUI psValidator $ Map.fromList
    [ downloadAction
    , assignAction (Right shid)
    , autoAssignAction shid
    , deleteAction
    ]

correctionData :: TermId -> SchoolId -> CourseShorthand -> SheetName -> _ -- CryptoFileNameSubmission -> _
correctionData tid ssh csh shn sub = E.select . E.from $ \((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> do
  E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
  E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
  E.where_ $ course E.^. CourseTerm       E.==. E.val tid
       E.&&. course E.^. CourseSchool     E.==. E.val ssh
       E.&&. course E.^. CourseShorthand  E.==. E.val csh
       E.&&. sheet  E.^. SheetName        E.==. E.val shn
       E.&&. submission E.^. SubmissionId E.==. E.val sub
  return (course, sheet, submission, corrector)

getCorrectionR, getCorrectionUserR, postCorrectionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getCorrectionR tid ssh csh shn cid = do
  mayPost <- isAuthorized (CSubmissionR tid ssh csh shn cid CorrectionR) True
  bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid ssh csh shn cid
postCorrectionR tid ssh csh shn cid = do
  sub <- decrypt cid

  results <- runDB $ correctionData tid ssh csh shn sub

  case results of
    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
          pointsForm = case sheetType of
            NotGraded  -> pure Nothing
            _otherwise -> aopt  (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
                                (fslpI MsgRatingPoints "Punktezahl" & setTooltip sheetType)
                                (Just submissionRatingPoints)

      ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
        <$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
        <*> pointsForm
        <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment))
      let corrForm = wrapForm' BtnSave corrForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = corrEncoding
            }

      ((uploadResult, uploadForm'), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionUpload . renderAForm FormStandard $
            areq (zipFileField True Nothing) (fslI MsgRatingFiles) Nothing
      let uploadForm = wrapForm uploadForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = uploadEncoding
            }

      formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do
        uid <- liftHandlerT requireAuthId
        now <- liftIO getCurrentTime

        if
          | errs <- validateRating sheetType Rating'
                      { ratingPoints  = ratingPoints'
                      , ratingComment = ratingComment'
                      , ratingTime    = (now <$ guard rated)
                      }
          , not $ null errs
            -> mapM_ (addMessageI Error) errs
          | otherwise -> do
              runDBJobs $ do
                update sub  [ SubmissionRatingBy      =. Just uid
                            , SubmissionRatingTime    =. (now <$ guard rated)
                            , SubmissionRatingPoints  =. ratingPoints'
                            , SubmissionRatingComment =. ratingComment'
                            ]

                addMessageI Success $ bool MsgRatingDeleted MsgRatingUpdated rated

                when (rated && isNothing submissionRatingTime) $ do
                  $logDebugS "CorrectionR" [st|Rated #{tshow sub}|]
                  queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub
              redirect $ CSubmissionR tid ssh csh shn cid CorrectionR

      formResult uploadResult $ \fileUploads -> do
        uid <- requireAuthId

        res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
        case res of
          Nothing  -> return () -- ErrorMessages are already added by msgSubmissionErrors
          (Just _) -> do
            addMessageI Success MsgRatingFilesUpdated
            redirect $ CSubmissionR tid ssh csh shn cid CorrectionR

      mr <- getMessageRender
      let sheetTypeDesc = mr sheetType
          heading = MsgCorrectionHead tid ssh csh shn cid
          headingWgt = [whamlet|
              $newline never
              _{heading}
              $if not (submissionRatingDone subm)
                \ ^{isVisibleWidget False}
            |]
      siteLayout headingWgt $ do
        setTitleI heading
        let userCorrection = $(widgetFile "correction-user")
        $(widgetFile "correction")
    _ -> notFound


getCorrectionUserR tid ssh csh shn cid = do
  sub <- decrypt cid

  results <- runDB $ correctionData tid ssh csh shn sub

  case results of
    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] -> do
      mr <- getMessageRender
      let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
          sheetTypeDesc = mr sheetType
      defaultLayout $
        $(widgetFile "correction-user")
    _ -> notFound


getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
getCorrectionsUploadR = postCorrectionsUploadR
postCorrectionsUploadR = do
  ((uploadRes, upload), uploadEncoding) <- runFormPost . identifyForm FIDcorrectionsUpload . renderAForm FormStandard $
       areq (zipFileField True Nothing) (fslI MsgCorrUploadField) Nothing

  case uploadRes of
    FormMissing -> return ()
    FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
    FormSuccess files -> do
      uid <- requireAuthId
      mbSubs <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkMultiSubmission uid True
      case mbSubs of
        Nothing -> return ()
        (Just subs)
          | null subs -> addMessageI Warning MsgNoCorrectionsUploaded
          | otherwise -> do
              subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) $ Set.toList subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
              let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
                  content = Right $(widgetFile "messages/correctionsUploaded")
              addMessageModal Success trigger content

  let uploadForm = wrapForm upload def
        { formAction = Just $ SomeRoute CorrectionsUploadR
        , formEncoding = uploadEncoding
        }

  maxUploadMB <- appMaximumContentLength <$> getsYesod appSettings'

  defaultLayout $ do
    let uploadInstruction = $(i18nWidgetFile "corrections-upload-instructions")
    $(widgetFile "corrections-upload")

getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html
getCorrectionsCreateR = postCorrectionsCreateR
postCorrectionsCreateR = do
  uid <- requireAuthId
  let sheetOptions = mkOptList . toListOf (traverse . filtered (view $ _1 . _Value . _submissionModeCorrector) . _2) <=< runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
        E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
        let
          isCorrector = E.exists . E.from $ \sheetCorrector -> E.where_
                $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
            E.&&. sheetCorrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
          isLecturer = E.exists . E.from $ \lecturer -> E.where_
                $ lecturer E.^. LecturerUser E.==. E.val uid
            E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
        E.where_ $ isCorrector E.||. isLecturer
        E.orderBy [E.desc $ course E.^. CourseTerm, E.asc $ course E.^. CourseShorthand, E.desc $ sheet E.^. SheetActiveFrom]
        return (sheet E.^. SheetSubmissionMode, (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName))
      mkOptList :: [(E.Value SheetId, E.Value TermId, E.Value CourseShorthand, E.Value SheetName)] -> Handler (OptionList SheetId)
      mkOptList opts = do
        opts' <- mapM (\v@(E.Value sid, _, _, _) -> (, v) <$> encrypt sid) opts
        MsgRenderer mr <- getMsgRenderer
        return . mkOptionList $ do
          (cID, (E.Value sid, E.Value tid, E.Value csh, E.Value shn)) <- opts'
          let tid' = mr $ ShortTermIdentifier (unTermKey tid)
          return Option
            { optionDisplay = mr $ MsgCorrectionPseudonymSheet tid' csh shn
            , optionInternalValue = sid
            , optionExternalValue = toPathPiece (cID :: CryptoUUIDSheet)
            }
  ((pseudonymRes, pseudonymWidget), pseudonymEncoding) <- runFormPost . renderAForm FormStandard $ (,)
    <$> areq (selectField sheetOptions) (fslI MsgPseudonymSheet) Nothing
    <*> (textToList <$> areq textareaField (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing)

  case pseudonymRes of
    FormMissing -> return ()
    FormFailure errs -> forM_ errs $ addMessage Error . toHtml
    FormSuccess (sid, (pss, invalids)) -> do
      allDone <- fmap getAll . execWriterT $ do
        forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Error "templates/messages/ignoredInvalidPseudonym.hamlet")
        tell . All $ null invalids

        WriterT . runDB . mapReaderT runWriterT $ do
          Sheet{..} <- get404 sid
          (sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)
          forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review _PseudonymText
          tell . All $ null unknown
          now <- liftIO getCurrentTime
          let
            sps' :: [[SheetPseudonym]]
            duplicate :: Set Pseudonym
            ( sps'
              , Map.keysSet . Map.filter (\(getSum -> n) -> n > 1) -> duplicate
              ) = flip runState Map.empty . forM sps . flip (foldrM :: (Entity SheetPseudonym -> [SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) -> [SheetPseudonym] -> [Entity SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) [] $ \(Entity _ p@SheetPseudonym{sheetPseudonymPseudonym}) ps -> do
                    known <- State.gets $ Map.member sheetPseudonymPseudonym
                    State.modify $ Map.insertWith (<>) sheetPseudonymPseudonym (Sum 1)
                    return $ bool (p :) id known ps
            submissionPrototype = Submission
              { submissionSheet = sid
              , submissionRatingPoints = Nothing
              , submissionRatingComment = Nothing
              , submissionRatingBy = Just uid
              , submissionRatingAssigned = Just now
              , submissionRatingTime = Nothing
              }
          unless (null duplicate) $
            addMessageModal Warning [whamlet|_{MsgSheetDuplicatePseudonym}|] $ Right $(widgetFile "messages/submissionCreateDuplicates")
          existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
            E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
            E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
                 E.&&. submission E.^. SubmissionSheet E.==. E.val sid
            return submissionUser
          unless (null existingSubUsers) . mapReaderT lift $ do
            (Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
            let trigger = [whamlet|_{MsgSheetCreateExisting}|]
                content = Right $(widgetFile "messages/submissionCreateExisting")
            addMessageModal Warning trigger content
          let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
          forM_ sps'' $ \spGroup
            -> let
                 sheetGroupDesc = Text.intercalate ", " $ map (review _PseudonymText . sheetPseudonymPseudonym) spGroup
                in case sheetGrouping of
            Arbitrary maxSize -> do
              subId <- insert submissionPrototype
              void . insert $ SubmissionEdit uid now subId
              insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
                { submissionUserUser = sheetPseudonymUser
                , submissionUserSubmission = subId
                }
              when (genericLength spGroup > maxSize) $
                addMessageI Warning $ MsgSheetGroupTooLarge sheetGroupDesc
            RegisteredGroups -> do
              let spGroup' = Map.fromList $ map (sheetPseudonymUser &&& id) spGroup
              groups <- E.select . E.from $ \submissionGroup -> do
                E.where_ . E.exists . E.from $ \submissionGroupUser ->
                  E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser `E.in_` E.valList (map sheetPseudonymUser spGroup)
                return $ submissionGroup E.^. SubmissionGroupId
              groupUsers <- fmap (Set.fromList . map E.unValue) . E.select . E.from $ \submissionGroupUser -> do
                E.where_ $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup `E.in_` E.valList (map E.unValue groups)
                return $ submissionGroupUser E.^. SubmissionGroupUserUser
              if
                | [_] <- groups
                , Map.keysSet spGroup' `Set.isSubsetOf` groupUsers
                  -> do
                    subId <- insert submissionPrototype
                    void . insert $ SubmissionEdit uid now subId
                    insertMany_ . flip map (Set.toList groupUsers) $ \sheetUser -> SubmissionUser
                      { submissionUserUser = sheetUser
                      , submissionUserSubmission = subId
                      }
                    when (null groups) $
                      addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc
                | length groups < 2
                  -> do
                    forM_ (Set.toList (Map.keysSet spGroup' `Set.difference` groupUsers)) $ \((spGroup' !) -> SheetPseudonym{sheetPseudonymPseudonym}) -> do
                      addMessageI Error $ MsgSheetNoRegisteredGroup (review _PseudonymText sheetPseudonymPseudonym)
                      tell $ All False
                | otherwise ->
                    addMessageI Error $ MsgSheetAmbiguousRegisteredGroup sheetGroupDesc
            NoGroups -> do
              subId <- insert submissionPrototype
              void . insert $ SubmissionEdit uid now subId
              insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
                { submissionUserUser = sheetPseudonymUser
                , submissionUserSubmission = subId
                }
              when (length spGroup > 1) $
                addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc
      when allDone $
        redirect CorrectionsGradeR

  let pseudonymForm = wrapForm pseudonymWidget def
        { formAction   = Just $ SomeRoute CorrectionsCreateR
        , formEncoding = pseudonymEncoding
        }

  defaultLayout
    $(widgetFile "corrections-create")
  where
    partitionEithers' :: [[Either a b]] -> ([[b]], [a])
    partitionEithers' = runWriter . mapM (WriterT . Identity . swap . partitionEithers)

    textToList :: Textarea -> ([[Pseudonym]], Map (Text, Text) [Pseudonym])
    textToList (map (map Text.strip . Text.splitOn ",") . filter (not . Text.null) . map Text.strip . Text.lines . unTextarea -> ws)
      = runWriter . fmap (mapMaybe sequence) $ mapM (\ws' -> mapM (toPseudonym ws') ws') ws
      where
        toPseudonym w' w
          | Just res <- w ^? _PseudonymText = return $ Just res
          | otherwise = Nothing <$ tell (Map.singleton (Text.intercalate ", " w', w) $ w ^.. pseudonymFragments . _PseudonymWords)

getCorrectionsGradeR, postCorrectionsGradeR :: Handler Html
getCorrectionsGradeR = postCorrectionsGradeR
postCorrectionsGradeR = do
  uid <- requireAuthId
  let whereClause = ratedBy uid
      displayColumns = mconcat -- should match getSSubsR for consistent UX
        [ -- dbRow,
          colSchool
        , colTerm
        , colCourse
        , colSheet
        , colPseudonyms
        , colSubmissionLink
        , colRated
        , colRatedField
        , colPointsField
        , colCommentField
        ] -- Continue here
      psValidator = def
        & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData))
      unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
      dbtProj' i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _, _) = do
        cID <- encrypt subId
        void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
        return i

  (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns mempty psValidator dbtProj' $ def
    { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR
    }

  case tableRes of
    FormMissing -> return ()
    FormFailure errs -> forM_ errs $ addMessage Error . toHtml
    FormSuccess resMap -> do
      now <- liftIO getCurrentTime
      subs <- fmap catMaybes . runDB . forM (Map.toList resMap) $ \(subId, (rated, mPoints, mComment)) -> do
        s@Submission{..} <- get404 subId
        if
          | submissionRatingPoints /= mPoints || submissionRatingComment /= mComment || rated /= submissionRatingDone s
            -> Just subId <$ update subId [ SubmissionRatingPoints =. mPoints
                                          , SubmissionRatingComment =. mComment
                                          , SubmissionRatingBy =. Just uid
                                          , SubmissionRatingTime =. now <$ guard rated
                                          ]
          | otherwise -> return Nothing
      subs' <- traverse (\x -> (,) <$> encrypt x <*> encrypt x) subs :: Handler [(CryptoFileNameSubmission, CryptoUUIDSubmission)]
      let trigger = [whamlet|_{MsgCorrectionsUploaded (genericLength subs')}|]
          content = Right $(widgetFile "messages/correctionsUploaded")
      unless (null subs') $ addMessageModal Success trigger content

  defaultLayout $
    $(widgetFile "corrections-grade")


data ButtonSubmissionsAssign = BtnSubmissionsAssign
  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Universe ButtonSubmissionsAssign
instance Finite   ButtonSubmissionsAssign
nullaryPathPiece ''ButtonSubmissionsAssign camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonSubmissionsAssign id
instance Button UniWorX ButtonSubmissionsAssign where
  btnClasses BtnSubmissionsAssign = [BCIsButton, BCPrimary]

-- | DEPRECATED use CorrectorInfo instead. Gather info about corrector assignment per sheet
data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiCorrectorNr, saiUnassignedNr :: Int }

getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCAssignR = postCAssignR
postCAssignR tid ssh csh = do
  cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh
  assignHandler tid ssh csh cid []

getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
getSAssignR = postSAssignR
postSAssignR tid ssh csh shn = do
  (shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
  assignHandler tid ssh csh cid [shid]

{- TODO: Feature:
  make distivt buttons for each sheet, so that users see which sheet will be assigned.
  Currently this information is available within the page heading!

  Stub:
data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
    deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
instance Button UniWorX ButtonCorrectionsAssign
-- Are those needed any more?
instance Universe ButtonCorrectionsAssign
instance Finite   ButtonCorrectionsAssign
nullaryPathPiece ''ButtonCorrectionsAssign camelToPathPiece
embedRenderMessage ''UniWorX ''ButtonCorrectionsAssign id
instance Button UniWorX ButtonCorrectionsAssign where
  btnClasses BtnCorrectionsAssign = [BCIsButton, BCPrimary]
-- use runButtonForm' instead later on
-}

assignHandler :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
assignHandler tid ssh csh cid assignSids = do
  -- evaluate form first, since it affects DB action
  (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions

  -- gather data
  (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
      -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
      nrParticipants <- count [CourseParticipantCourse ==. cid]

      sheetList <- selectList [SheetCourse ==. cid] [Desc SheetActiveTo, Desc SheetActiveFrom]
      let orderedSheetNames = fmap (\(Entity _ Sheet{sheetName}) -> sheetName) sheetList
          sheets = entities2map sheetList
          sheetIds = Map.keys sheets
          groupsPossible :: Bool
          groupsPossible =
            let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
            in  List.foldr foldFun False sheetList
          assignSheetNames = fmap sheetName $ mapMaybe (\sid -> Map.lookup sid sheets) assignSids

      -- plan or assign unassigned submissions for given sheets
      let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational))
          buildA acc sid = maybeT (return acc) $ do
            let shn = sheetName $ sheets ! sid
            -- is sheet closed?
            guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR  -- we must check, whether the submission is already closed and thus assignable
            -- ask for assignment plan
            let ignoreExceptions :: AssignSubmissionException -> DB (Map SubmissionId (Maybe UserId), Map UserId Rational) -- silently ignore errors, since we check all sheets and only care about sheets with unassigned corrections
                ignoreExceptions NoCorrectors             = return mempty
                ignoreExceptions NoCorrectorsByProportion = return mempty
                ignoreExceptions (SubmissionsNotFound _sids_not_found) = return mempty -- cannot happen, since last argument to planSubmissions is Nothing
            (plan,deficit) <- lift $ handle ignoreExceptions $ planSubmissions sid Nothing
            guard $ not $ null plan -- only proceed if there is a plan for this sheet
            -- implement assignment plan
            status <- lift $ case btnResult of
              Nothing -> return (Set.empty, Set.empty)
              (Just BtnSubmissionsAssign) -> do
                status@(sub_ok,sub_fail) <- writeSubmissionPlan plan
                let nr_ok      = olength sub_ok
                    nr_fail    = olength sub_fail
                    alert_ok   = toMaybe (nr_ok   > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoAssigned nr_ok
                    alert_fail = toMaybe (nr_fail > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoFailed   nr_fail
                    msg_status = bool Success Error $ nr_fail > 0
                    msg_header = SomeMessage $ shn <> ":"
                when (nr_ok > 0 || nr_fail > 0) $
                  addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail]
                return status
            return $ Map.insert shn (status, countMapElems plan, deficit) acc
      assignSids' <- if null assignSids -- assignAll; we distinguish assignSids' here avoid useless Alerts
                      then selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
                      else return assignSids
      assignment <- foldM buildA Map.empty assignSids'

      correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
          E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
          E.where_ $ corrector E.^. SheetCorrectorSheet `E.in_` E.valList sheetIds
          return (corrector, user)
      let correctorMap' :: Map UserId (User, Map SheetName SheetCorrector)
          correctorMap' = (\f -> foldl f Map.empty correctors)
            (\acc (Entity _ sheetcorr@SheetCorrector{sheetCorrectorSheet}, Entity uid user) ->
                let shn = sheetName $ sheets ! sheetCorrectorSheet
                in  Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb))  uid (user, Map.singleton shn sheetcorr) acc
            )
      -- Lecturers may correct without being enlisted SheetCorrectors, so fetch all names
      act_correctors <- E.select . E.distinct . E.from $ \(submission `E.InnerJoin` user) -> do
          E.on $ submission E.^. SubmissionRatingBy E.==. (E.just $ user E.^. UserId)
          E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
          return (submission E.^. SubmissionSheet, user)
      let correctorMap :: Map UserId (User, Map SheetName SheetCorrector)
          correctorMap = (\f -> foldl f correctorMap' act_correctors)
            (\acc (E.Value sheetCorrectorSheet, Entity uid user) ->
                let shn = sheetName $ sheets ! sheetCorrectorSheet
                    scr = SheetCorrector uid sheetCorrectorSheet mempty CorrectorExcused
                in  Map.insertWith (\_new old -> old) uid (user, Map.singleton shn scr) acc -- keep already known correctors unchanged
            )

      submissions <- E.select . E.from $ \submission -> do
          E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds
          let numSubmittors = E.sub_select . E.from $ \subUser -> do
                E.where_ $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
                return E.countRows
          return (submission, numSubmittors)
      -- prepare map
      let infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo)
          infoMap  = List.foldl (flip buildS) emptySheets submissions

          -- ensure that all sheets are shown, including those without any submissions
          emptySheets = foldl (\m sid -> Map.insert (sheetName $ sheets ! sid) emptyCorrs m) Map.empty sheetIds
          emptyCorrs  = foldl (\m uid -> let cic = Just uid in
                                         Map.insert cic mempty{ciCorrector=cic} m) Map.empty $ Map.keys correctorMap


          buildS :: (Entity Submission, E.Value Int64) -> Map SheetName (Map (Maybe UserId) CorrectionInfo) -> Map SheetName (Map (Maybe UserId) CorrectionInfo)
          buildS (Entity _sheetId Submission{..}, E.Value nrSbmtrs) m =
              let shnm    = sheetName $ sheets ! submissionSheet
                  corTime = diffUTCTime <$> submissionRatingTime <*> submissionRatingAssigned
                  cinf    = Map.singleton submissionRatingBy $ CorrectionInfo
                            { ciSubmittors  = fromIntegral nrSbmtrs
                            , ciSubmissions = 1
                            , ciAssigned    = maybe 0 (const 1) submissionRatingBy   -- only used in sheetMap
                            , ciCorrected   = maybe 0 (const 1) submissionRatingTime
                            , ciCorrector   = submissionRatingBy
                            , ciMin = corTime
                            , ciTot = corTime
                            , ciMax = corTime
                            }
              in Map.insertWith (Map.unionWith (<>)) shnm cinf m

      return (orderedSheetNames, assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)

  let -- infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
      -- create aggregate maps

      -- Always iterate over orderedSheetNames for consistent sorting!
      sheetMap :: Map SheetName CorrectionInfo
      sheetMap = Map.map fold infoMap

      sheetLoad :: Map SheetName Load
      sheetLoad = -- Map.unionsWith (<>) ((Map.filter () ) . snd) <$> Map.elems correctorMap)
        let buildSL acc (_user,mSnSc) = Map.foldlWithKey buildL acc mSnSc
            buildL acc s SheetCorrector{sheetCorrectorLoad=l, sheetCorrectorState=CorrectorNormal}
              = Map.insertWith (<>) s l acc
            buildL acc _ _ = acc
        in  Map.foldl buildSL Map.empty correctorMap

      deficitMap :: Map UserId Rational
      deficitMap = foldMap (view _3) assignment

      corrMap  :: Map (Maybe UserId) CorrectionInfo
      corrMap  = Map.unionsWith (<>) $ Map.elems infoMap

      corrInfos :: [CorrectionInfo]
      corrInfos = sortBy (compare `on` (byName . ciCorrector) ) $ Map.elems corrMap
        where byName Nothing    = Nothing
              byName (Just uid) = Map.lookup uid correctorMap
      corrMapSum :: CorrectionInfo
      corrMapSum = fold corrMap

  let -- whamlet convenience functions
      -- avoid nestes hamlet $maybe with duplicated $nothing
      getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector, Text)
      getCorrector (Just uid)
        | Just (User{..},loadMap) <- Map.lookup uid correctorMap
        = (nameEmailWidget userEmail userDisplayName userSurname, loadMap, userDisplayName)
        --  | Just (User{..} ) <- Map.lookup uid lecturerNames
        --  = (nameEmailWidget userEmail userDisplayName userSurname, mempty)  -- lecturers may also correct in rare cases
      getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty, mempty)
      -- avoid nestes hamlet $maybe with duplicated $nothing
      getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo
      getCorrSheetStatus corr shn
        | (Just smap) <- Map.lookup shn infoMap
        = Map.lookup corr smap
      getCorrSheetStatus _ _ = Nothing
      -- avoid nestes hamlet $maybe with duplicated $nothing
      getCorrNewAssignment :: Maybe UserId -> SheetName -> Maybe Int
      getCorrNewAssignment corr shn
        | (Just (_,cass,_)) <- Map.lookup shn assignment
        = Map.lookup corr cass
      getCorrNewAssignment _ _ = Nothing
      -- avoid nestes hamlet $maybe with duplicated $nothing
      getCorrDeficit :: Maybe UserId -> Maybe Rational
      getCorrDeficit (Just uid) = Map.lookup uid deficitMap
      getCorrDeficit _          = Nothing

      getLoadSum :: SheetName -> Text
      getLoadSum shn | (Just load) <- Map.lookup shn sheetLoad
                     = showCompactCorrectorLoad load CorrectorNormal
      getLoadSum  _  = mempty

      showDiffDays :: Maybe NominalDiffTime -> Text
      showDiffDays = foldMap formatDiffDays
      showAvgsDays :: Maybe NominalDiffTime -> Integer -> Text
      showAvgsDays Nothing   _ = mempty
      showAvgsDays (Just dt) n = formatDiffDays $ dt / fromIntegral n
      heat :: Integer -> Integer -> Double
      heat = heat' 0.3
      heat' :: Double -> Integer -> Integer -> Double
      heat' cut full achieved = roundToDigits 3 $ cutOffPercent cut (fromIntegral full^2) (fromIntegral achieved^2)
  let headingShort
        | 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment
        | otherwise               = MsgMenuCorrectionsAssign
      headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign

      unassignableSheets = filter (\shn -> Map.notMember shn assignment) assignSheetNames
  unless (null unassignableSheets) $ addMessageI Warning $ MsgSheetsUnassignable $ Text.intercalate ", " $ fmap CI.original unassignableSheets

  siteLayoutMsg headingShort $ do
    setTitleI headingLong
    $(widgetFile "corrections-overview")



