fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Prettify single submission view

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-03 15:55:45 +02:00
parent dddd262b6b
commit f64bdba774
7 changed files with 120 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
messages/de.msg
View File

@ -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:
RatingTime: Korrigiert
RatingComment: Kommentar
RatingPoints: Punkte
PointsNotPositive: Punktzahl darf nicht negativ sein
FileTitle: Dateiname
FileModified: Letzte Änderung
FileCorrected: Korrigiert

1
package.yaml
View File

@ -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.

46
src/Handler/Corrections.hs
View File

@ -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

54
src/Handler/Submission.hs
View File

@ -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 = []

19
src/Handler/Utils/Form.hs
View File

@ -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
<input id=#{theId} name=#{name} *{attrs} type=number step="0.01" :isReq:required value=#{either id tshow val}>
|]
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

7
templates/correction-user.hamlet
View File

@ -3,9 +3,10 @@
<tr .table__row>
<th .table__th> _{MsgSubmission}
<td .table__td> #{display cid}
<tr .table__row>
<th .table__th> _{MsgRatingBy}
<td .table__td> #{display userDisplayName}
$maybe Entity _ User{..} <- corrector
<tr .table__row>
<th .table__th> _{MsgRatingBy}
<td .table__td> #{display userDisplayName}
$maybe time <- submissionRatingTime
<tr .table__row>
<th .table__th> _{MsgRatingTime}

6
templates/correction.hamlet Normal file
View File

@ -0,0 +1,6 @@
^{userCorrection}
<hr>
<form method=post enctype=#{corrEncoding}>
^{corrForm}