diff --git a/messages/de.msg b/messages/de.msg index 61cb14977..b9eb9af92 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -146,14 +146,22 @@ CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht aut CorrectionsUploaded num@Int64: #{display num} Korrekturen wurden gespeichert: -RatingBy: Korrigiert von: -AchievedBonusPoints: Erreichte Bonuspunkte: -AchievedNormalPoints: Erreichte Punkte: -AchievedPassPoints: Erreichte Punkte: +RatingBy: Korrigiert von +AchievedBonusPoints: Erreichte Bonuspunkte +AchievedNormalPoints: Erreichte Punkte +AchievedPassPoints: Erreichte Punkte AchievedOf achieved@Points possible@Points: #{display achieved} von #{display possible} PassAchievedOf points@Points passingPoints@Points maxPoints@Points: #{display points} von #{display maxPoints} (Bestanden ab #{display passingPoints}) -PassedResult: Ergebnis: +PassedResult: Ergebnis Passed: Bestanden NotPassed: Nicht bestanden -RatingTime: Korrigiert: -RatingComment: Kommentar: \ No newline at end of file +RatingTime: Korrigiert +RatingComment: Kommentar + +RatingPoints: Punkte +PointsNotPositive: Punktzahl darf nicht negativ sein + +FileTitle: Dateiname +FileModified: Letzte Änderung + +FileCorrected: Korrigiert \ No newline at end of file diff --git a/package.yaml b/package.yaml index ccfb37678..1f2496141 100644 --- a/package.yaml +++ b/package.yaml @@ -82,6 +82,7 @@ dependencies: - lens - MonadRandom - email-validate +- scientific # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 0430185d7..ad2ee77c1 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -343,28 +343,48 @@ postSSubsR tid csh shn = do , autoAssignAction shid ] +correctionData tid 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.^. 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 -> Text -> Text -> CryptoFileNameSubmission -> Handler Html getCorrectionR tid csh shn cid = do mayPost <- isAuthorized (CSubmissionR tid csh shn cid CorrectionR) True bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid csh shn cid -postCorrectionR tid csh shn cid = undefined +postCorrectionR tid csh shn cid = do + sub <- decrypt cid + + results <- runDB $ correctionData tid 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)) + + now <- liftIO getCurrentTime + ((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ Rating' + <$> aopt pointsField (fslI MsgRatingPoints) (Just $ submissionRatingPoints) + <*> (((\t -> t <$ guard (not $ null t)) =<<) . fmap (Text.strip . unTextarea) <$> aopt textareaField (fslI MsgRatingComment) (Just $ Textarea <$> submissionRatingComment)) + <* submitButton + + defaultLayout $ do + let userCorrection = $(widgetFile "correction-user") + $(widgetFile "correction") + _ -> notFound getCorrectionUserR tid csh shn cid = do sub <- decrypt cid - results <- runDB . 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.^. 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) + results <- runDB $ correctionData tid csh shn sub case results of - [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, Just (Entity _ User{..}))] -> do + [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] -> do let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c)) defaultLayout $ do diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 7e8ce5b86..d5ab0d592 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -14,6 +14,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE MultiWayIf #-} module Handler.Submission where @@ -38,6 +39,7 @@ import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Internal.Sql as E (unsafeSqlFunction) import qualified Data.Conduit.List as Conduit import Data.Conduit.ResumableSink @@ -50,7 +52,7 @@ import Data.Bifunctor import System.FilePath -import Colonnade hiding (bool) +import Colonnade hiding (bool, fromMaybe) import qualified Yesod.Colonnade as Yesod import qualified Text.Blaze.Html5.Attributes as HA @@ -238,24 +240,54 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do -- Maybe construct a table to display uploaded archive files let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (WidgetT UniWorX IO) ()) colonnadeFiles cid = mconcat - -- [ sortable (Just "type") "Typ" $ \(_,_, E.Value ftype) -> textCell $ toPathPiece ftype - [ sortable (Just "path") "Dateiname" $ \input@(_, Entity _ File{..}) -> case isNothing fileContent of - False -> anchorCell (\(Entity _ SubmissionFile{..}, Entity _ File{..}) -> CSubmissionR tid csh shn cid $ SubDownloadR (isUpdateSubmissionFileType submissionFileIsUpdate) fileTitle) - (\(_, Entity _ File{..}) -> str2widget fileTitle) - input - True -> textCell $ addTrailingPathSeparator fileTitle - , sortable (Just "time") "Modifikation" $ \(_, Entity _ File{..}) -> stringCell $ formatTimeGerWDT fileModified + [ sortable (Just "path") (textCell MsgFileTitle) $ \(coalesce -> (mOrig, mCorr)) -> let + Just fileTitle' = fileTitle . entityVal . snd <$> (mOrig <|> mCorr) + origIsFile = fmap (isJust . fileContent . entityVal . snd) mOrig + corrIsFile = fmap (isJust . fileContent . entityVal . snd) mCorr + Just isFile = origIsFile <|> corrIsFile + in if + | Just True <- origIsFile -> anchorCell (\() -> CSubmissionR tid csh shn cid $ SubDownloadR SubmissionOriginal fileTitle') + (\() -> [whamlet|#{fileTitle'}|]) + () + | otherwise -> textCell $ bool (<> "/") id isFile fileTitle' + , sortable Nothing (cell mempty) $ \(coalesce -> (_, mCorr)) -> case mCorr of + Nothing -> cell mempty + Just (_, Entity _ File{..}) + | isJust fileContent -> anchorCell (\() -> CSubmissionR tid csh shn cid $ SubDownloadR SubmissionCorrected fileTitle) + (\() -> [whamlet|_{MsgFileCorrected}|]) + () + | otherwise -> textCell MsgFileCorrected + , sortable (Just "time") (textCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let + origTime = fileModified . entityVal . snd <$> mOrig + corrTime = fileModified . entityVal . snd <$> mCorr + Just fileTime = (max <$> origTime <*> corrTime) <|> origTime <|> corrTime + in textCell $ display fileTime ] + coalesce :: ((Maybe (Entity SubmissionFile), Maybe (Entity File)), (Maybe (Entity SubmissionFile), Maybe (Entity File))) -> (Maybe (Entity SubmissionFile, Entity File), Maybe (Entity SubmissionFile, Entity File)) + coalesce ((ma, mb), (mc, md)) = ((,) <$> ma <*> mb, (,) <$> mc <*> md) + submissionFiles :: _ -> _ -> E.SqlQuery _ + submissionFiles smid ((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) = do + E.on $ f2 E.?. FileId E.==. sf2 E.?. SubmissionFileFile + E.on $ f1 E.?. FileTitle E.==. f2 E.?. FileTitle + E.&&. sf1 E.?. SubmissionFileSubmission E.==. sf2 E.?. SubmissionFileSubmission + E.&&. f1 E.?. FileId E.!=. f2 E.?. FileId + E.on $ f1 E.?. FileId E.==. sf1 E.?. SubmissionFileFile + + E.where_ $ (sf1 E.?. SubmissionFileIsUpdate E.==. E.val (Just False) E.||. E.isNothing (sf1 E.?. SubmissionFileIsUpdate)) + E.&&. (sf2 E.?. SubmissionFileIsUpdate E.==. E.val (Just True) E.||. E.isNothing (sf2 E.?. SubmissionFileIsUpdate)) + E.&&. (sf1 E.?. SubmissionFileSubmission E.==. E.val (Just smid) E.||. sf2 E.?. SubmissionFileSubmission E.==. E.val (Just smid)) + + return ((sf1, f1), (sf2, f2)) smid2ArchiveTable (smid,cid) = DBTable - { dbtSQLQuery = submissionFileQuery smid + { dbtSQLQuery = submissionFiles smid , dbtColonnade = colonnadeFiles cid , dbtAttrs = tableDefault , dbtIdent = "files" :: Text , dbtSorting = [ ( "path" - , SortColumn $ \(sf `E.InnerJoin` f) -> f E.^. FileTitle + , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle] ) , ( "time" - , SortColumn $ \(sf `E.InnerJoin` f) -> f E.^. FileModified + , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime))) ) ] , dbtFilter = [] diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 770129424..3b0d963a4 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -48,11 +48,15 @@ import qualified Data.Map as Map import Control.Monad.Writer.Class +import Data.Scientific (Scientific) +import Data.Ratio +import Text.Read (readMaybe) + ------------------------------------------------ -- Unique Form Identifiers to avoid accidents -- ------------------------------------------------ -data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors | FIDcorrectorTable | FIDcorrectionsUpload +data FormIdentifier = FIDcourse | FIDsheet | FIDsubmission | FIDsettings | FIDcorrectors | FIDcorrectorTable | FIDcorrection | FIDcorrectionsUpload deriving (Enum, Eq, Ord, Bounded, Read, Show) @@ -262,6 +266,19 @@ posIntField d = checkBool (>= 1) (T.append d " muss eine positive Zahl sein.") minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) $ intField +pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points +pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..} + where + fieldEnctype = UrlEncoded + fieldView theId name attrs val isReq + = [whamlet| + $newline never + + |] + fieldParse = parseHelper $ \t -> do + sci <- maybe (Left $ MsgInvalidNumber t) Right (readMaybe $ unpack t :: Maybe Scientific) + return . fromRational $ round (sci * 100) % 100 + --termField: see Utils.Term schoolField :: Field Handler SchoolId diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet index 805553b26..7bdd3e25d 100644 --- a/templates/correction-user.hamlet +++ b/templates/correction-user.hamlet @@ -3,9 +3,10 @@ _{MsgSubmission} #{display cid} - - _{MsgRatingBy} - #{display userDisplayName} + $maybe Entity _ User{..} <- corrector + + _{MsgRatingBy} + #{display userDisplayName} $maybe time <- submissionRatingTime _{MsgRatingTime} diff --git a/templates/correction.hamlet b/templates/correction.hamlet new file mode 100644 index 000000000..f079d7d13 --- /dev/null +++ b/templates/correction.hamlet @@ -0,0 +1,6 @@ +^{userCorrection} + +
+ +
+ ^{corrForm}