module Handler.Corrections where

import Import
-- import System.FilePath (takeFileName)

import Jobs
import Handler.Utils
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 (nub)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map, (!))
import qualified Data.Map 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 qualified Database.Esqueleto as E
-- 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), 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

-- 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=(_, _, course, _, _) } ->
          -- cell [whamlet| _{untermKey $ course ^. _3}|]   -- lange, internationale Semester
          textCell $ termToText $ unTermKey $ course ^. _3 -- kurze Semsterkürzel

colSchool :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSchool = sortable (Just "school") (i18nCell MsgCourseSchool)
          $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
            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)
        $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
          let tid   = course ^. _3
              ssh   = course ^. _4
              csh   = course ^. _2
              shn   = sheetName $ entityVal sheet
          in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]

colSheetType :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType)
        $ \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|#{display cid}|])

colSelect :: forall act h. (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) (maybe mempty toWidget 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 pointsField (fsUniq mkUnique "points") (Just submissionRatingPoints)
  )

colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData)))
colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ 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))


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)
          )
      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) -> 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 = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
        dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, 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)
        )
      ]
    , 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)
        )
      , ( "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.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
            Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
        )
      ]
    , dbtFilterUI  = fromMaybe mempty dbtFilterUI
    , dbtStyle     = def { dbsFilterLayout = maybe (\_ _ _ -> id) (\_ -> defaultDBSFilterLayout) dbtFilterUI }
    , dbtParams
    , dbtIdent     = "corrections" :: Text
    }

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
          $(addMessageFile Warning "templates/messages/submissionsAssignUnauthorized.hamlet")
        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'
      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
          $(addMessageFile Warning "templates/messages/submissionsAssignUnauthorized.hamlet")
        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 SAssignR
      (== 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.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) 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
        , 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` searchField False)         (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" ]
  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
        , colRating
        , colRated
        , colCorrector
        , colAssigned
        ] -- Continue here
      psValidator = def
  correctionsR whereClause colonnade Nothing 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
        , colRating
        , colRated
        , colCorrector
        , colAssigned
        ]
      psValidator = def
  correctionsR whereClause colonnade Nothing 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 _ 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")
                                (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 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) (fslI MsgRatingFiles) Nothing
      let uploadForm = wrapForm uploadForm' def
            { formAction = Just . SomeRoute $ CSubmissionR tid ssh csh shn cid CorrectionR
            , formEncoding = uploadEncoding
            }

      case corrResult of
        FormMissing -> return ()
        FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
        FormSuccess (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 -> 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

      case uploadResult of
        FormMissing -> return ()
        FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
        FormSuccess 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
      defaultLayout $ do
        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) (fslI MsgCorrUploadField & addAttr "uw-file-input" "") 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 encrypt $ Set.toList subs :: Handler [CryptoFileNameSubmission]
              mr <- (toHtml .) <$> getMessageRender
              addMessage Success =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)

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


  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)
            $(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
          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
            $(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
          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 encrypt subs :: Handler [CryptoFileNameSubmission]
      unless (null subs') $(addMessageFile Success "templates/messages/correctionsUploaded.hamlet")

  defaultLayout $
    $(widgetFile "corrections-grade")


getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html
getSAssignR = postSAssignR
postSAssignR tid ssh csh shn cID = do
  let actionUrl = CSubmissionR tid ssh csh shn cID SAssignR
  sId <- decrypt cID
  (currentCorrector, sheetCorrectors) <- runDB $ do
    Submission{submissionRatingBy, submissionSheet} <- get404 sId
    sheetCorrectors <- map (sheetCorrectorUser . entityVal) <$> selectList [SheetCorrectorSheet ==. submissionSheet] []
    userCorrector <- traverse getJustEntity submissionRatingBy
    return (userCorrector, maybe id (:) submissionRatingBy sheetCorrectors)

  $logDebugS "SAssignR" $ tshow currentCorrector
  let correctorField  = selectField $ optionsPersistCryptoId [UserId <-. sheetCorrectors] [Asc UserSurname, Asc UserDisplayName] userDisplayName
  ((corrResult, corrForm'), corrEncoding) <- runFormPost . renderAForm FormStandard $
        aopt correctorField (fslI MsgCorrector) (Just currentCorrector)
  formResult corrResult $ \(fmap entityKey -> mbUserId) -> do
    when (mbUserId /= fmap entityKey currentCorrector) . runDB $ do
      now <- liftIO getCurrentTime
      update sId  [ SubmissionRatingBy =. mbUserId
                  , SubmissionRatingAssigned =. (now <$ mbUserId)
                  ]
      addMessageI Success MsgCorrectorUpdated
    redirect actionUrl
  let corrForm = wrapForm corrForm' def
        { formAction = Just $ SomeRoute actionUrl
        , formEncoding = corrEncoding
        }
  defaultLayout $ do
      setTitleI MsgCorrectorAssignTitle
      $(widgetFile "submission-assign")




