774 lines
39 KiB
Haskell
774 lines
39 KiB
Haskell
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.Zip
|
|
|
|
import Utils.Lens
|
|
|
|
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 Data.Semigroup (Sum(..))
|
|
|
|
-- import Data.Time
|
|
-- import qualified Data.Text as T
|
|
-- 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 Web.PathPieces
|
|
|
|
import Text.Hamlet (ihamletFile)
|
|
import Text.Blaze.Html (preEscapedToHtml)
|
|
|
|
import Database.Persist.Sql (updateWhereCount)
|
|
|
|
import Data.List (genericLength)
|
|
|
|
import Data.CaseInsensitive (CI)
|
|
import qualified Data.CaseInsensitive as CI
|
|
|
|
import Control.Monad.Trans.Writer (Writer, WriterT(..), runWriter)
|
|
import Control.Monad.Writer.Class (MonadWriter(..))
|
|
|
|
import Control.Monad.Trans.RWS (RWST)
|
|
|
|
import Control.Monad.Trans.State (State, StateT(..), runState)
|
|
import qualified Control.Monad.State.Class as State
|
|
|
|
import Data.Foldable (foldrM)
|
|
import Data.Traversable (for)
|
|
|
|
|
|
|
|
type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
|
|
(expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
|
|
-> expr (E.Value Bool)
|
|
|
|
ratedBy :: Key User -> CorrectionsWhere
|
|
ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
|
|
|
|
courseIs :: Key Course -> CorrectionsWhere
|
|
courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
|
|
|
|
sheetIs :: Key Sheet -> CorrectionsWhere
|
|
sheetIs shid (_course,sheet,_submission) = sheet E.^. SheetId E.==. E.val shid
|
|
|
|
submissionModeIs :: SheetSubmissionMode -> CorrectionsWhere
|
|
submissionModeIs sMode (_course, sheet, _submission) = sheet E.^. SheetSubmissionMode E.==. E.val sMode
|
|
|
|
|
|
type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym))
|
|
|
|
colTerm :: IsDBTable m a => Colonnade _ 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
|
|
|
|
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colCourse = sortable (Just "course") (i18nCell MsgCourse)
|
|
$ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
|
|
let tid = course ^. _3
|
|
ssh = course ^. _4
|
|
csh = course ^. _2
|
|
in anchorCell (CourseR tid ssh csh CShowR) [whamlet|#{display csh}|]
|
|
|
|
colSheet :: IsDBTable m a => Colonnade _ 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}|]
|
|
|
|
colCorrector :: IsDBTable m a => Colonnade _ 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 _ 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 :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool)))
|
|
colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
|
|
|
|
colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
|
|
csh = course ^. _2
|
|
tid = course ^. _3
|
|
ssh = course ^. _4
|
|
link cid = CourseR tid ssh csh $ CUserR cid
|
|
cell = 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 cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
|
|
|
colSMatrikel :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, users) } -> let
|
|
cell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellM (AdminUserR <$> encrypt userId) (maybe mempty toWidget userMatrikelnummer)
|
|
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
|
|
|
|
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId 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
|
|
in anchorCellM mkRoute $(widgetFile "widgets/rating")
|
|
|
|
colAssigned :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
|
|
maybe mempty timeCell submissionRatingAssigned
|
|
|
|
colRated :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
|
|
colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _) } ->
|
|
maybe mempty timeCell submissionRatingTime
|
|
|
|
colPseudonyms :: IsDBTable m a => Colonnade _ 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 _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, a, b))))
|
|
colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell
|
|
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
|
(\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _) } _ -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField "" (Just done))
|
|
|
|
colPointsField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, Maybe Points, b))))
|
|
colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPointsDone) $ formCell
|
|
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
|
(\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _) } _ -> case sheetType of
|
|
NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty)
|
|
_other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt pointsField "" (Just submissionRatingPoints)
|
|
)
|
|
|
|
colCommentField :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData SubmissionId (a, b, Maybe Text))))
|
|
colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell
|
|
(\DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> return subId)
|
|
(\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment))
|
|
|
|
|
|
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))
|
|
|
|
makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
|
|
=> _ -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> Handler (DBResult m x)
|
|
makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
|
|
let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
|
|
dbtSQLQuery ((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 (course,sheet,submission)
|
|
let crse = ( course E.^. CourseName :: E.SqlExpr (E.Value CourseName)
|
|
, course E.^. CourseShorthand
|
|
, course E.^. CourseTerm
|
|
, course E.^. CourseSchool :: E.SqlExpr (E.Value SchoolId)
|
|
)
|
|
return (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.^. UserId]
|
|
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
|
|
, dbtColonnade
|
|
, dbtProj
|
|
, dbtSorting = Map.fromList
|
|
[ ( "term"
|
|
, SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseTerm
|
|
)
|
|
, ( "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
|
|
)
|
|
, ( "ratingtime"
|
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingTime
|
|
)
|
|
, ( "assignedtime"
|
|
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
|
|
)
|
|
]
|
|
, 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)
|
|
)
|
|
, ( "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)
|
|
)
|
|
, ( "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)
|
|
)
|
|
]
|
|
, dbtStyle = def
|
|
, dbtIdent = "corrections" :: Text
|
|
}
|
|
|
|
data ActionCorrections = CorrDownload
|
|
| CorrSetCorrector
|
|
| CorrAutoSetCorrector
|
|
deriving (Eq, Ord, Read, Show, Enum, Bounded)
|
|
instance PathPiece ActionCorrections where
|
|
fromPathPiece = readFromPathPiece
|
|
toPathPiece = showToPathPiece
|
|
|
|
instance RenderMessage UniWorX ActionCorrections where
|
|
renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
|
|
renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector
|
|
renderMessage m ls CorrAutoSetCorrector = renderMessage m ls MsgCorrAutoSetCorrector
|
|
|
|
data ActionCorrectionsData = CorrDownloadData
|
|
| CorrSetCorrectorData (Maybe UserId)
|
|
| CorrAutoSetCorrectorData SheetId
|
|
|
|
correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
|
|
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
|
|
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator return
|
|
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
|
|
((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
|
|
(actionRes, action) <- multiAction actions Nothing
|
|
return ((,) <$> actionRes <*> selectionRes, table <> action)
|
|
|
|
Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
|
|
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] []
|
|
when (not $ 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)
|
|
when (not $ null unassigned) $ do
|
|
num <- updateWhereCount [SubmissionId <-. Set.toList unassigned]
|
|
[ 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
|
|
subs <- mapM decrypt $ Set.toList subs'
|
|
runDB $ do
|
|
num <- updateWhereCount [SubmissionId <-. subs]
|
|
[ SubmissionRatingPoints =. Nothing
|
|
, SubmissionRatingComment =. Nothing
|
|
, SubmissionRatingBy =. Nothing
|
|
, SubmissionRatingAssigned =. Nothing
|
|
, SubmissionRatingTime =. Nothing
|
|
]
|
|
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] []
|
|
when (not $ 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)
|
|
when (not $ null unassigned) $ do
|
|
(assigned, unassigned) <- assignSubmissions shid (Just unassigned)
|
|
when (not $ null assigned) $
|
|
addMessageI Success $ MsgUpdatedAssignedCorrectorsAuto (fromIntegral $ Set.size assigned)
|
|
when (not $ null unassigned) $ do
|
|
mr <- (toHtml . ) <$> getMessageRender
|
|
unassigned' <- forM (Set.toList unassigned) $ \sid -> (encrypt sid :: DB CryptoFileNameSubmission)
|
|
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
|
|
redirect currentRoute
|
|
|
|
fmap toTypedContent . defaultLayout $ do
|
|
setTitleI MsgCourseCorrectionsTitle
|
|
$(widgetFile "corrections")
|
|
|
|
|
|
type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData)
|
|
|
|
downloadAction :: ActionCorrections'
|
|
downloadAction = ( CorrDownload
|
|
, pure CorrDownloadData
|
|
)
|
|
|
|
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
|
|
|
|
return user
|
|
|
|
mr <- getMessageRender
|
|
|
|
correctors' <- fmap ((mr MsgNoCorrector, Nothing) :) . forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (display userDisplayName, ) . Just <$> encrypt entityKey
|
|
|
|
cId <- wpreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe 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
|
|
, colTerm
|
|
, colCourse
|
|
, colSheet
|
|
, colPseudonyms
|
|
, colSubmissionLink
|
|
, colAssigned
|
|
, colRating
|
|
, colRated
|
|
] -- Continue here
|
|
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")
|
|
correctionsR whereClause colonnade 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 psValidator $ Map.fromList
|
|
[ downloadAction
|
|
, assignAction (Left cid)
|
|
]
|
|
|
|
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 psValidator $ Map.fromList
|
|
[ downloadAction
|
|
, assignAction (Right shid)
|
|
, autoAssignAction shid
|
|
]
|
|
|
|
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 . identForm 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))
|
|
<* submitButton
|
|
|
|
((uploadResult, uploadForm), uploadEncoding) <- runFormPost . identForm FIDcorrectionUpload . renderAForm FormStandard $
|
|
areq (zipFileField True) (fslI MsgRatingFiles) Nothing
|
|
<* submitButton
|
|
|
|
case corrResult of
|
|
FormMissing -> return ()
|
|
FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
|
|
FormSuccess (rated, ratingPoints, ratingComment) -> do
|
|
runDBJobs $ do
|
|
uid <- liftHandlerT requireAuthId
|
|
now <- liftIO getCurrentTime
|
|
|
|
Submission{submissionRatingTime} <- getJust sub
|
|
|
|
update sub [ SubmissionRatingBy =. (uid <$ guard rated)
|
|
-- SJ: I don't think we need to update AssignedTime here, since this is just for correction upload
|
|
-- , SubmissionRatingAssigned +=. (Just now) -- TODO: Should submissionRatingAssigned change here if userId changes?
|
|
, 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 fileSource -> do
|
|
uid <- requireAuthId
|
|
|
|
runDBJobs . runConduit $ transPipe (lift . lift) fileSource .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
|
|
|
|
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 $ do
|
|
$(widgetFile "correction-user")
|
|
_ -> notFound
|
|
|
|
|
|
getCorrectionsUploadR, postCorrectionsUploadR :: Handler Html
|
|
getCorrectionsUploadR = postCorrectionsUploadR
|
|
postCorrectionsUploadR = do
|
|
((uploadRes, upload), uploadEncoding) <- runFormPost . identForm FIDcorrectionsUpload . renderAForm FormStandard $
|
|
areq (zipFileField True) (fslI MsgCorrUploadField) Nothing
|
|
<* submitButton
|
|
|
|
case uploadRes of
|
|
FormMissing -> return ()
|
|
FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
|
|
FormSuccess files -> do
|
|
uid <- requireAuthId
|
|
subs <- runDBJobs . runConduit $ transPipe (lift . lift) files .| extractRatingsMsg .| sinkMultiSubmission uid True
|
|
if
|
|
| 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)
|
|
|
|
|
|
defaultLayout $ do
|
|
$(widgetFile "corrections-upload")
|
|
|
|
getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html
|
|
getCorrectionsCreateR = postCorrectionsCreateR
|
|
postCorrectionsCreateR = do
|
|
uid <- requireAuthId
|
|
let sheetOptions = mkOptList <=< runDB $ E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector) -> do
|
|
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
|
|
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
|
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
|
|
E.&&. sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions
|
|
E.orderBy [E.desc $ course E.^. CourseTerm, E.asc $ course E.^. CourseShorthand, E.desc $ sheet E.^. SheetActiveFrom]
|
|
return $ (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
|
|
<*> areq (checkMMap textToList textFromList textareaField) (fslpI MsgCorrectionPseudonyms "Pseudonyme" & setTooltip MsgCorrectionPseudonymsTip) Nothing
|
|
<* submitButton
|
|
|
|
case pseudonymRes of
|
|
FormMissing -> return ()
|
|
FormFailure errs -> forM_ errs $ addMessage Error . toHtml
|
|
FormSuccess (sid, pss) -> do
|
|
now <- liftIO getCurrentTime
|
|
runDB $ do
|
|
Sheet{..} <- get404 sid
|
|
(sps, unknown) <- fmap partition . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)
|
|
forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review pseudonymText
|
|
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
|
|
submission = Submission
|
|
{ submissionSheet = sid
|
|
, submissionRatingPoints = Nothing
|
|
, submissionRatingComment = Nothing
|
|
, submissionRatingBy = Just uid
|
|
, submissionRatingAssigned = Just now
|
|
, submissionRatingTime = Nothing
|
|
}
|
|
when (not $ null duplicate)
|
|
$(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
|
|
existingSubUsers <- E.select . E.from $ \submissionUser -> do
|
|
E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
|
|
return submissionUser
|
|
when (not $ null existingSubUsers) $ 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
|
|
| genericLength sps > maxSize
|
|
-> addMessageI Error $ MsgSheetGroupTooLarge sheetGroupDesc
|
|
| otherwise
|
|
-> do
|
|
subId <- insert submission
|
|
void . insert $ SubmissionEdit uid now subId
|
|
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
|
|
{ submissionUserUser = sheetPseudonymUser
|
|
, submissionUserSubmission = subId
|
|
}
|
|
RegisteredGroups -> do
|
|
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
|
|
case (groups :: [E.Value SubmissionGroupId]) of
|
|
[x] -> do
|
|
subId <- insert submission
|
|
void . insert $ SubmissionEdit uid now subId
|
|
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
|
|
{ submissionUserUser = sheetPseudonymUser
|
|
, submissionUserSubmission = subId
|
|
}
|
|
[] -> do
|
|
subId <- insert submission
|
|
void . insert $ SubmissionEdit uid now subId
|
|
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
|
|
{ submissionUserUser = sheetPseudonymUser
|
|
, submissionUserSubmission = subId
|
|
}
|
|
addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc
|
|
_ -> addMessageI Error $ MsgSheetAmbiguousRegisteredGroup sheetGroupDesc
|
|
NoGroups
|
|
| [SheetPseudonym{sheetPseudonymUser}] <- spGroup
|
|
-> do
|
|
subId <- insert submission
|
|
void . insert $ SubmissionEdit uid now subId
|
|
insert_ SubmissionUser
|
|
{ submissionUserUser = sheetPseudonymUser
|
|
, submissionUserSubmission = subId
|
|
}
|
|
| otherwise -> do
|
|
subId <- insert submission
|
|
void . insert $ SubmissionEdit uid now subId
|
|
insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
|
|
{ submissionUserUser = sheetPseudonymUser
|
|
, submissionUserSubmission = subId
|
|
}
|
|
addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc
|
|
redirect CorrectionsGradeR
|
|
|
|
|
|
defaultLayout $ do
|
|
$(widgetFile "corrections-create")
|
|
where
|
|
partition :: [[Either a b]] -> ([[b]], [a])
|
|
partition = runWriter . mapM (WriterT . Identity . swap . partitionEithers)
|
|
|
|
textToList :: Textarea -> Handler (Either UniWorXMessage [[Pseudonym]])
|
|
textToList (map (map Text.strip . Text.splitOn ",") . filter (not . Text.null) . Text.lines . unTextarea -> ws)
|
|
= let
|
|
invalid :: [Text]
|
|
valid :: [[Pseudonym]]
|
|
(valid, invalid) = partition $ map (map $ \w -> maybe (Left w) Right $ w ^? pseudonymText) ws
|
|
in case invalid of
|
|
(i:_) -> return . Left $ MsgInvalidPseudonym i
|
|
[] -> return $ Right valid
|
|
textFromList :: [[Pseudonym]] -> Textarea
|
|
textFromList = Textarea . Text.unlines . map (Text.intercalate ", " . map (review pseudonymText))
|
|
|
|
getCorrectionsGradeR, postCorrectionsGradeR :: Handler Html
|
|
getCorrectionsGradeR = postCorrectionsGradeR
|
|
postCorrectionsGradeR = do
|
|
uid <- requireAuthId
|
|
let whereClause = ratedBy uid
|
|
displayColumns = mconcat -- should match getSSubsR for consistent UX
|
|
[ dbRow
|
|
, colTerm
|
|
, colCourse
|
|
, colSheet
|
|
, colPseudonyms
|
|
, colSubmissionLink
|
|
, colRated
|
|
, colRatedField
|
|
, colPointsField
|
|
, colCommentField
|
|
] -- Continue here
|
|
psValidator = def
|
|
& defaultSorting [("ratingtime", SortDesc)] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, Maybe Points, Maybe Text)))
|
|
unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
|
|
|
|
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator $ \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), tableEncoding) <- runFormPost tableForm
|
|
|
|
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 $ do
|
|
$(widgetFile "corrections-grade")
|