{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE TupleSections #-}

module Handler.Sheet where

import Import
import System.FilePath (takeFileName)

import Handler.Utils
import Handler.Utils.Zip

-- import Data.Time
import qualified Data.Text as T
-- import Data.Function ((&))
--
import Colonnade hiding (fromMaybe, singleton, bool)
import qualified Yesod.Colonnade as Yesod
import Text.Blaze (text)
-- 
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 Control.Monad.Trans.RWS.Lazy (RWST, local)

import qualified Text.Email.Validate as Email

import qualified Data.List as List

import Network.Mime

import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Map as Map

import Data.Map (Map, (!), (!?))
import qualified Data.Map as Map

import Control.Lens
import Utils.Lens


instance Eq (Unique Sheet) where
  (CourseSheet cid1 name1) == (CourseSheet cid2 name2) =
    cid1 == cid2 && name1 == name2

{-
  * Implement Handlers
  * Implement Breadcrumbs in Foundation
  * Implement Access in Foundation
-}

data SheetForm = SheetForm
      { sfName         :: Text
      , sfDescription  :: Maybe Html
      , sfType         :: SheetType
      , sfGrouping     :: SheetGroup
      , sfMarkingText  :: Maybe Html
      , sfVisibleFrom  :: Maybe UTCTime
      , sfActiveFrom   :: UTCTime
      , sfActiveTo     :: UTCTime
      , sfSheetF       :: Maybe (Source Handler (Either FileId File))
      , sfHintFrom     :: Maybe UTCTime
      , sfHintF        :: Maybe FileInfo
      , sfSolutionFrom :: Maybe UTCTime
      , sfSolutionF    :: Maybe FileInfo
      -- Keine SheetId im Formular!
      }


makeSheetForm :: Maybe SheetId -> Maybe SheetForm -> Form SheetForm
makeSheetForm msId template = identForm FIDsheet $ \html -> do
    let oldFileIds fType
          | Just sId <- msId = fmap setFromList . fmap (map E.unValue) . runDB . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
              E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
              E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sId
                   E.&&. sheetFile E.^. SheetFileType    E.==. E.val fType
              return (file E.^. FileId)
          | otherwise = return Set.empty

    (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm
      <$> areq textField      (fsb "Name")                     (sfName <$> template)
      <*> aopt htmlField      (fsb "Hinweise für Teilnehmer")  (sfDescription <$> template)
      <*> sheetTypeAFormReq   (fsb "Bewertung")                (sfType <$> template)
      <*> sheetGroupAFormReq  (fsb "Abgabegruppengröße") (sfGrouping <$> template)
      <*> aopt htmlField      (fsb "Hinweise für Korrektoren") (sfMarkingText <$> template)
      <*> aopt utcTimeField   (fsb "Sichtbar ab") (sfVisibleFrom  <$> template)
      <*> areq utcTimeField   (fsb "Abgabe ab")   (sfActiveFrom   <$> template)
      <*> areq utcTimeField   (fsb "Abgabefrist") (sfActiveTo     <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetExercise) (fsb "Aufgabenstellung") (sfSheetF <$> template)
      <*> aopt utcTimeField   (fsb "Hinweis ab")  (sfHintFrom     <$> template)
      <*> fileAFormOpt        (fsb "Hinweis")
      <*> aopt utcTimeField   (fsb "Lösung ab")   (sfSolutionFrom <$> template)
      <*> fileAFormOpt        (fsb "Lösung")
      <*  submitButton
    return $ case result of
      FormSuccess sheetResult
        | errorMsgs <- validateSheet sheetResult
        , not $ null errorMsgs ->
            (FormFailure errorMsgs,
                  [whamlet|
                    <div class="alert alert-danger">
                      <div class="alert__content">
                        <h4> Fehler:
                        <ul>
                          $forall errmsg <- errorMsgs
                            <li> #{errmsg}
                    ^{widget}
                  |]
                )
      _ -> (result, widget)
  where
    validateSheet :: SheetForm -> [Text]
    validateSheet (SheetForm{..}) =
      [ msg | (False, msg) <-
        [ ( maybe True (sfActiveFrom >=) sfVisibleFrom
          , "Sichtbarkeit muss vor Beginn der Abgabefrist liegen."
          )
        , ( sfActiveTo >= sfActiveFrom
          , "Ende der Abgabefrist muss nach deren Beginn liegen."
          )
        -- TODO: continue validation here!!!
      ] ]

-- List Sheets
getSheetListCID :: CourseId -> Handler Html
getSheetListCID cid = getSheetList =<<
  (Entity cid) <$> (runDB $ get404 cid)

getSheetListR :: TermId -> Text -> Handler Html
getSheetListR tid csh = getSheetList =<<
  (runDB $ getBy404 $ CourseTermShort tid csh)

getSheetList :: Entity Course -> Handler Html
getSheetList courseEnt = do
  -- mbAid <- maybeAuthId
  let cid    = entityKey courseEnt
  let course = entityVal courseEnt
  let csh    = courseShorthand course
  let tid    = courseTerm course
  sheets <- runDB $ do
    rawSheets <- selectList [SheetCourse ==. cid] [Desc SheetActiveFrom]
    forM rawSheets $ \(Entity sid sheet) -> do
        let sheetsub = [SubmissionSheet ==. sid]
        submissions <- count sheetsub
        rated       <- count $ (SubmissionRatingTime !=. Nothing):sheetsub
        return (sid, sheet, (submissions, rated))
  let colBase = mconcat
        [ headed "Blatt"       $ \(sid,sheet,_) -> simpleLink (toWgt $ sheetName sheet) $ CSheetR tid csh (sheetName sheet) SShowR
        , headed "Abgabe ab"   $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3
        , headed "Abgabe bis"  $ toWgt . formatTimeGerWD . sheetActiveTo   . snd3
        , headed "Bewertung"   $ toWgt . display . sheetType . snd3
        ]
  let colAdmin = mconcat -- only show edit button for allowed course assistants
        [ headed "Korrigiert"  $ toWgt . snd . trd3
        , headed "Eingereicht" $ toWgt . fst . trd3
        , headed ""            $ \s -> simpleLink "Edit"   $ CSheetR tid csh (sheetName $ snd3 s) SEditR
        , headed ""            $ \s -> simpleLink "Delete" $ CSheetR tid csh (sheetName $ snd3 s) SDelR
        ]
  showAdmin <- case sheets of
    ((_,firstSheet,_):_) -> do
      setUltDestCurrent
      (Authorized ==) <$> isAuthorized (CSheetR tid csh (sheetName firstSheet) SEditR) False
    _otherwise   -> return False
  let colSheets = if showAdmin
        then colBase `mappend` colAdmin
        else colBase
  defaultLayout $ do
    setTitle $ toHtml $ csh <> " Übungsblätter"
    if null sheets
      then [whamlet|Es wurden noch keine Übungsblätter angelegt.|]
      else Yesod.encodeWidgetTable tableDefault colSheets sheets


-- Show single sheet
getSShowR :: TermId -> Text -> Text -> Handler Html
getSShowR tid csh shn = do
  entSheet <- runDB $ fetchSheet tid csh shn
  let sheet = entityVal entSheet
      sid   = entityKey entSheet
  -- without Colonnade
--   fileNameTypes <- runDB $ E.select $ E.from $
--     \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
--       -- Restrict to consistent rows that correspond to each other
--       E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
--       E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
--       -- filter to requested file
--       E.where_ (sheet     E.^. SheetId      E.==. E.val sid )
--       -- return desired columns
--       return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
--   let fileLinks = map (\(E.Value fName, E.Value modified, E.Value fType) -> (CSheetR tid csh (SheetFileR shn fType fName),modified)) fileNameTypes
  -- with Colonnade

  let fileData (sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) = do
        -- Restrict to consistent rows that correspond to each other
        E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
        E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
        -- filter to requested file
        E.where_ $  sheet     E.^. SheetId      E.==. E.val sid
              E.&&. E.not_ (E.isNothing $ file E.^. FileContent)
        -- return desired columns
        return $ (file E.^. FileTitle, file E.^. FileModified, sheetFile E.^. SheetFileType)
  let colonnadeFiles = widgetColonnade $ mconcat
        [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> stringCell ftype
        , sortable (Just "path") "Dateiname" $ anchorCell (\(E.Value fName,_,E.Value fType) -> CSheetR tid csh shn (SFileR fType fName))
                                                          (\(E.Value fName,_,_) -> str2widget fName)
        , sortable Nothing "Freigabe"  $ \(_,_, E.Value ftype) ->
            case ftype of
              SheetExercise -> textCell $ display $ sheetActiveFrom   sheet
              SheetHint     -> textCell $ display $ sheetHintFrom     sheet
              SheetSolution -> textCell $ display $ sheetSolutionFrom sheet
        , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT (modified :: UTCTime)
        ]
  fileTable <- dbTable def $ DBTable
    { dbtSQLQuery = fileData
    , dbtColonnade = colonnadeFiles
    , dbtAttrs = tableDefault
    , dbtFilter = Map.empty
    , dbtIdent = "files" :: Text
    -- TODO: Add column for and visibility date
    , dbtSorting = [ ( "type"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> sheetFile E.^. SheetFileType
                     )
                   , ( "path"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileTitle
                     )
                   , ( "time"
                     , SortColumn $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> file E.^. FileModified
                     )
                   ]
    }
  defaultLayout $ do
    setTitle $ toHtml $ T.append "Übung " $ sheetName sheet
    $(widgetFile "sheetShow")
    [whamlet| Under Construction !!! |] -- TODO

getSFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent
getSFileR tid csh shn typ title = do
  content <- runDB $ E.select $ E.from $
    \(course `E.InnerJoin` sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do
      -- Restrict to consistent rows that correspond to each other
      E.on (file      E.^. FileId           E.==. sheetFile E.^. SheetFileFile)
      E.on (sheetFile E.^. SheetFileSheet E.==. sheet     E.^. SheetId)
      E.on (sheet     E.^. SheetCourse    E.==. course    E.^. CourseId)
      -- filter to requested file
      E.where_ ((file      E.^. FileTitle       E.==. E.val title)
        E.&&.   (sheetFile E.^. SheetFileType   E.==. E.val typ  )
        E.&&.   (sheet     E.^. SheetName       E.==. E.val shn  )
        E.&&.   (course    E.^. CourseShorthand E.==. E.val csh  )
        E.&&.   (course    E.^. CourseTerm    E.==. E.val tid  )
        )
      -- return desired columns
      return $ file E.^. FileContent
  let mimeType = defaultMimeLookup $ pack title
  case content of
    [E.Value (Just nochmalContent)] -> do
      addHeader "Content-Disposition" "attachment"
      respond mimeType nochmalContent
    []     -> notFound
    _other -> error "Multiple matching files found."


getSheetNewR :: TermId -> Text -> Handler Html
getSheetNewR tid csh = do
  let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days
  let action newSheet = -- More specific error message for new sheet could go here, if insertUnique returns Nothing
        insertUnique $ newSheet
  handleSheetEdit tid csh Nothing template action

postSheetNewR :: TermId -> Text -> Handler Html
postSheetNewR = getSheetNewR


getSEditR :: TermId -> Text -> Text -> Handler Html
getSEditR tid csh shn = do
  (sheetEnt, sheetFileIds) <- runDB $ do
    ent <- fetchSheet tid csh shn
    fIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
      E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
      E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent)
           E.&&. sheetFile E.^. SheetFileType    E.==. E.val SheetExercise
      return (file E.^. FileId)
    return (ent, fIds)
  let sid = entityKey sheetEnt
  let oldSheet@(Sheet {..}) = entityVal sheetEnt
  let template = Just $ SheetForm
        { sfName         = sheetName
        , sfDescription  = sheetDescription
        , sfType         = sheetType
        , sfGrouping     = sheetGrouping
        , sfMarkingText  = sheetMarkingText
        , sfVisibleFrom  = sheetVisibleFrom
        , sfActiveFrom   = sheetActiveFrom
        , sfActiveTo     = sheetActiveTo
        , sfSheetF       = Just . yieldMany . map Left $ Set.toList sheetFileIds
        , sfHintFrom     = sheetHintFrom
        , sfHintF        = Nothing -- TODO
        , sfSolutionFrom = sheetSolutionFrom
        , sfSolutionF    = Nothing -- TODO
        }
  let action newSheet = do
        replaceRes <- myReplaceUnique sid $ newSheet
        case replaceRes of
          Nothing     -> return $ Just sid
          (Just _err) -> return $ Nothing -- More specific error message for edit old sheet could go here
  handleSheetEdit tid csh (Just sid) template action

postSEditR :: TermId -> Text -> Text -> Handler Html
postSEditR = getSEditR

handleSheetEdit :: TermId -> Text -> Maybe SheetId -> Maybe SheetForm -> (Sheet -> YesodDB UniWorX (Maybe SheetId)) -> Handler Html
handleSheetEdit tid csh msId template dbAction = do
  let mbshn  = sfName <$> template
  aid  <- requireAuthId
  ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm msId template
  case res of
    (FormSuccess SheetForm{..}) -> do
      saveOkay <- runDB $ do
        actTime <- liftIO getCurrentTime
        cid <- getKeyBy404 $ CourseTermShort tid csh
        let newSheet = Sheet
              { sheetCourse     = cid
              , sheetName         = sfName
              , sheetDescription  = sfDescription
              , sheetType         = sfType
              , sheetGrouping     = sfGrouping
              , sheetMarkingText  = sfMarkingText
              , sheetVisibleFrom  = sfVisibleFrom
              , sheetActiveFrom   = sfActiveFrom
              , sheetActiveTo     = sfActiveTo
              , sheetHintFrom     = sfHintFrom
              , sheetSolutionFrom = sfSolutionFrom
              }
        mbsid <- dbAction newSheet
        case mbsid of
          Nothing    -> False <$ addMessageI "danger" (MsgSheetNameDup tid csh sfName)
          (Just sid) ->  do -- save files in DB:
            whenIsJust sfSheetF    $ insertSheetFile' sid SheetExercise
            whenIsJust sfHintF     $ insertSheetFile sid SheetHint
            whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution
            insert_ $ SheetEdit aid actTime sid
            addMessageI "info" $ MsgSheetEditOk tid csh sfName
            return True
      when saveOkay $ redirect $ CSheetR tid csh sfName SShowR -- redirect must happen outside of runDB
    (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml
    _ -> return ()
  let pageTitle = maybe (MsgSheetTitleNew tid csh)
                        (MsgSheetTitle    tid csh) mbshn
--   let formTitle = pageTitle -- no longer used in template
  let formText  = Nothing :: Maybe UniWorXMessage
  actionUrl <- fromMaybe (CourseR tid csh SheetNewR) <$> getCurrentRoute
  defaultLayout $ do
    setTitleI pageTitle
    $(widgetFile "formPageI18n")



getSDelR :: TermId -> Text -> Text -> Handler Html
getSDelR tid csh shn = do
  ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete)
  case result of
    (FormSuccess BtnAbort)  -> redirectUltDest $ CSheetR tid csh shn SShowR
    (FormSuccess BtnDelete) -> do
      runDB $ fetchSheetId tid csh shn >>= deleteCascade
      -- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!!
      addMessageI "info" $ MsgSheetDelOk tid csh shn
      redirect $ CourseR tid csh SheetListR
    _other -> do
      submissionno <- runDB $ do
          sid <- fetchSheetId tid csh shn
          count [SubmissionSheet ==. sid]
      let formTitle = MsgSheetDelHead tid csh shn
      let formText  = Just $ MsgSheetDelText submissionno
      let actionUrl = CSheetR tid csh shn SDelR
      defaultLayout $ do
        setTitleI $ MsgSheetTitle tid csh shn
        $(widgetFile "formPageI18n")

postSDelR :: TermId -> Text -> Text -> Handler Html
postSDelR = getSDelR



insertSheetFile :: SheetId -> SheetFileType -> FileInfo -> YesodDB UniWorX ()
insertSheetFile sid ftype finfo = do
    runConduit $ (sourceFiles finfo) =$= C.mapM_ finsert
  where
    finsert file = do
      fid <- insert file
      void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step

insertSheetFile' :: SheetId -> SheetFileType -> Source Handler (Either FileId File) -> YesodDB UniWorX ()
insertSheetFile' sid ftype fs = do
    oldFileIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do
      E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile
      E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid
           E.&&. sheetFile E.^. SheetFileType    E.==. E.val ftype
      return (file E.^. FileId)
    keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert
    mapM_ deleteCascade $ (oldFileIds \\ keep :: Set FileId)
  where
    finsert (Left fileId) = tell $ singleton fileId
    finsert (Right file) = lift $ do
      fid <- insert file
      void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step

  
data CorrectorForm = CorrectorForm
  { cfUserId :: UserId
  , cfUserName :: Text
  , cfResult :: FormResult Load
  , cfViewByTut, cfViewProp, cfViewDel :: FieldView UniWorX
  }

type Loads = Map UserId Load

defaultLoads :: SheetId -> DB Loads
-- ^ Generate `Loads` in such a way that minimal editing is required
--
-- For every user, that ever was a corrector for this course, return their last `Load`.
-- "Last `Load`" is taken to mean their `Load` on the `Sheet` with the most recent creation time (first edit).
defaultLoads shid = do
  cId <- sheetCourse <$> getJust shid
  fmap toMap . E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> E.distinctOnOrderBy [E.asc (sheetCorrector E.^. SheetCorrectorUser)] $ do
    E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet

    let creationTime = E.sub_select . E.from $ \sheetEdit -> do
          E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
          return . E.min_ $ sheetEdit E.^. SheetEditTime

    E.where_ $ sheet E.^. SheetCourse E.==. E.val cId
    
    E.orderBy [E.desc creationTime]
  
    return (sheetCorrector E.^. SheetCorrectorUser, sheetCorrector E.^. SheetCorrectorLoad)
  where
    toMap :: [(E.Value UserId, E.Value Load)] -> Loads
    toMap = foldMap $ \(E.Value uid, E.Value load) -> Map.singleton uid load


correctorForm :: SheetId -> MForm Handler (FormResult (Set SheetCorrector), [FieldView UniWorX])
correctorForm shid = do
  cListIdent <- newFormIdent
  let
    guardNonDeleted :: UserId -> Handler (Maybe UserId)
    guardNonDeleted uid = do
      cID@CryptoID{..} <- encrypt uid :: Handler CryptoUUIDUser
      deleted <- lookupPostParam $ tshow ciphertext <> "-" <> "del"
      return $ bool Just (const Nothing) (isJust deleted) uid
  formCIDs <- mapM decrypt =<< catMaybes <$> liftHandlerT (map fromPathPiece <$> lookupPostParams cListIdent :: Handler [Maybe CryptoUUIDUser])
  let
    currentLoads :: DB Loads
    currentLoads = Map.fromList . map (\(Entity _ SheetCorrector{..}) -> (sheetCorrectorUser, sheetCorrectorLoad)) <$> selectList [ SheetCorrectorSheet ==. shid ] []
  (defaultLoads', currentLoads') <- lift . runDB $ (,) <$> defaultLoads shid <*> currentLoads
  loads' <- fmap (Map.fromList [(uid, mempty) | uid <- formCIDs] `Map.union`) $ if
    | Map.null currentLoads'
    , null formCIDs          -> defaultLoads' <$ when (not $ Map.null defaultLoads') (addMessageI "warn" MsgCorrectorsDefaulted)
    | otherwise              -> return $ Map.fromList (map (, mempty) formCIDs) `Map.union` currentLoads'

  deletions <- lift $ foldM (\dels uid -> maybe (Set.insert uid dels) (const dels) <$> guardNonDeleted uid) Set.empty (Map.keys loads')

  let loads'' = Map.restrictKeys loads' (Map.keysSet loads' `Set.difference` deletions)
      didDelete = any (flip Set.member deletions) formCIDs

  (countTutRes, countTutView) <- mreq checkBoxField (fsm MsgCountTutProp) . Just $ any (\Load{..} -> fromMaybe False byTutorial) $ Map.elems loads'
  let
    tutorField :: Field Handler [Text]
    tutorField = multiEmailField
      { fieldView = \theId name attrs val isReq -> asWidgetT $ do
          listIdent <- newIdent
          userId <- handlerToWidget requireAuthId
          previousCorrectors <- handlerToWidget . runDB . E.select . E.from $ \(user `E.InnerJoin` sheetCorrector `E.InnerJoin` sheet `E.InnerJoin` course `E.InnerJoin` lecturer) -> E.distinctOnOrderBy [E.asc $ user E.^. UserEmail ] $ do
            E.on $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
            E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
            E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
            E.on $ sheetCorrector E.^. SheetCorrectorUser E.==. user E.^. UserId
            E.where_ $ lecturer E.^. LecturerUser E.==. E.val userId
            return $ user E.^. UserEmail
          [whamlet|
            $newline never
            <input id=#{theId} name=#{name} list=#{listIdent} *{attrs} type=email multiple :isReq:required value="" placeholder=_{MsgCorrectorsPlaceholder}>
            <datalist id=#{listIdent}>
              $forall E.Value prev <- previousCorrectors
                <option value=#{prev}>
          |]
      }
  (addTutRes, addTutView) <- mopt tutorField (fsm MsgAddCorrector) (Just Nothing)

  loads <- case addTutRes of
    FormSuccess (Just emails) -> fmap Map.unions . forM emails $ \email -> do
      mUid <- fmap (fmap entityKey) . lift . runDB $ getBy (UniqueEmail email)
      case mUid of
        Nothing  -> loads'' <$ addMessageI "error" (MsgEMailUnknown email)
        Just uid
          | not (Map.member uid loads') -> return $ Map.insert uid mempty loads''
          | otherwise                   -> loads'' <$ addMessageI "warning" (MsgCorrectorExists email)
    FormFailure errs -> loads'' <$ mapM_ (addMessage "error" . toHtml) errs
    _ -> return loads''

  let deletions' = deletions `Set.difference` Map.keysSet loads
  
  names <- fmap (Map.fromList . map (\(E.Value a, E.Value b) -> (a, b))) . lift . runDB . E.select . E.from $ \user -> do
    E.where_ $ user E.^. UserId `E.in_` E.valList (Map.keys  loads)
    return $ (user E.^. UserId, user E.^. UserDisplayName)
    
  let
    constructFields :: (UserId, Text, Load) -> MForm Handler CorrectorForm
    constructFields (uid, uname, Load{..}) = do
      cID@CryptoID{..} <- encrypt uid :: MForm Handler CryptoUUIDUser
      let
        fs name = ""
          { fsName = Just $ tshow ciphertext <> "-" <> name
          }
        rationalField = convertField toRational fromRational doubleField

      (byTutRes, cfViewByTut) <- mreq checkBoxField (fs "bytut") (Just $ isJust byTutorial)
      (propRes, cfViewProp) <- mreq (checkBool (>= 0) MsgProportionNegative $ rationalField) (fs "prop") (Just byProportion)
      (_, cfViewDel) <- mreq checkBoxField (fs "del") (Just False)
      let
        cfResult :: FormResult Load
        cfResult = Load <$> tutRes' <*> propRes
        tutRes'
          | FormSuccess True <- byTutRes  = Just <$> countTutRes
          | otherwise                     = Nothing <$ byTutRes
        cfUserId = uid
        cfUserName = uname
      return CorrectorForm{..}

  corrData <- sequence . catMaybes . (flip map) (Map.keys loads) $ \uid -> fmap constructFields $ (,,) <$> pure uid <*> names !? uid <*> loads !? uid

  mr <- getMessageRender

  $logDebugS "SCorrR" $ tshow (didDelete, addTutRes)

  let
    corrColonnade = mconcat
      [ headed (Yesod.textCell $ mr MsgCorrector) $ \CorrectorForm{..} -> Yesod.textCell cfUserName
      , headed (Yesod.textCell $ mr MsgCorByTut) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewByTut
      , headed (Yesod.textCell $ mr MsgCorProportion) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewProp
      , headed (Yesod.textCell $ mr MsgDeleteRow) $ \CorrectorForm{..} -> Yesod.cell $ fvInput cfViewDel
      ]
    corrResults
      | FormSuccess (Just es) <- addTutRes
      , not $ null es = FormMissing
      | didDelete = FormMissing
      | otherwise = fmap Set.fromList $ sequenceA [ SheetCorrector <$> pure cfUserId <*> pure shid <*> cfResult
                                                  | CorrectorForm{..} <- corrData
                                                  ]
    idField CorrectorForm{..} = do
      cID <- encrypt cfUserId :: WidgetT UniWorX IO CryptoUUIDUser
      toWidget [hamlet|<input name=#{cListIdent} type=hidden value=#{toPathPiece cID}>|]

    delField uid = do
      cID <- encrypt uid :: WidgetT UniWorX IO CryptoUUIDUser
      toWidget [hamlet|<input name="#{toPathPiece cID}-del" type=hidden value=yes>|]

  return (corrResults, [ countTutView
                       , FieldView
                           { fvLabel = text $ mr MsgCorrectors
                           , fvTooltip = Nothing
                           , fvId = ""
                           , fvInput = Yesod.encodeCellTable tableDefault corrColonnade corrData >> mapM_ idField corrData >> mapM_ delField deletions
                           , fvErrors = Nothing
                           , fvRequired = True
                           }
                       , addTutView
                           { fvInput = [whamlet|
                               <div>
                                 ^{fvInput addTutView}
                                 <button type=submit formnovalidate data-formnorequired>Hinzufügen
                             |]
                           }
                       ])
  
  -- Eingabebox für Korrektor hinzufügen
  -- Eingabe für Korrekt ausgefüllt: FormMissing zurückschicken um dann Feld hinzuzufügen

getSCorrR, postSCorrR :: TermId
                      -> Text -- ^ Course shorthand
                      -> Text -- ^ Sheet name
                      -> Handler Html
postSCorrR = getSCorrR
getSCorrR tid csh shn = do
  Entity shid Sheet{..} <- runDB $ fetchSheet tid csh shn

  ((res,formWidget), formEnctype) <- runFormPost . identForm FIDcorrectors . renderAForm FormStandard $ formToAForm (correctorForm shid) <* submitButton

  case res of
    FormFailure errs -> mapM_ (addMessage "error" . toHtml) errs
    FormSuccess res -> runDB $ do
      deleteWhere [SheetCorrectorSheet ==. shid]
      insertMany_ $ Set.toList res
      addMessageI "success" MsgCorrectorsUpdated
    FormMissing -> return ()

  let
    --     formTitle = MsgSheetCorrectorsTitle tid csh shn
    formText  = Nothing :: Maybe (SomeMessage UniWorX)
    actionUrl = CSheetR tid csh shn SCorrR
    -- actionUrl = CSheetR tid csh shn SShowR
  defaultLayout $ do
    setTitleI $ MsgSheetCorrectorsTitle tid csh shn
    $(widgetFile "formPageI18n")