Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

This commit is contained in:
Gregor Kleen 2018-12-21 12:56:15 +01:00
commit 1621ee1fe8
11 changed files with 131 additions and 130 deletions

View File

@ -69,7 +69,7 @@ CourseSemester: Semester
CourseSchool: Institut CourseSchool: Institut
CourseSchoolShort: Fach CourseSchoolShort: Fach
CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt
CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich CourseRegisterFromTip: Ohne Datum ist keine eigenständige Anmeldung von Studierenden möglich
CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein
CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
CourseFilterSearch: Volltext-Suche CourseFilterSearch: Volltext-Suche
@ -145,8 +145,8 @@ SubmissionFile: Datei zur Abgabe
SubmissionFiles: Abgegebene Dateien SubmissionFiles: Abgegebene Dateien
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt. SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
SubmissionsDeleteQuestion count@Int: Wollen Sie #{pluralDE count "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen? SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen?
SubmissionsDeleted count@Int: #{pluralDE count "Abgabe gelöscht" "Abgaben gelöscht"} SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"}
SubmissionGroupName: Gruppenname SubmissionGroupName: Gruppenname
@ -416,8 +416,9 @@ SheetTypeNotGraded: Unbewertet
SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer. SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information der Teilnehmer.
SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter.
SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt. SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt.
SheetGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Blätter SummaryTitle: Zusammenfassung über alle
SubmissionGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Abgaben SheetGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Blatt" "Blätter"}
SubmissionGradingSummaryTitle count@Integer: #{display count} #{pluralDE count "Abgabe" "Abgaben"}
SheetTypeBonus': Bonus SheetTypeBonus': Bonus
SheetTypeNormal': Normal SheetTypeNormal': Normal
@ -587,6 +588,6 @@ AuthTagAuthentication: Authentifizierung erfüllt Anforderungen
AuthTagRead: Zugriff ist nur lesend AuthTagRead: Zugriff ist nur lesend
AuthTagWrite: Zugriff ist i.A. schreibend AuthTagWrite: Zugriff ist i.A. schreibend
DeleteCopyStringIfSure count@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE count "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab. DeleteCopyStringIfSure n@Int: Wenn Sie sich sicher sind, dass Sie #{pluralDE n "das obige Objekt" "obige Objekte"} unwiderbringlich löschen möchten, schreiben Sie bitte zunächst den angezeigten Text ab.
DeleteConfirmation: Bestätigung DeleteConfirmation: Bestätigung
DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen. DeleteConfirmationWrong: Bestätigung muss genau dem angezeigten Text entsprechen.

View File

@ -147,10 +147,11 @@ pattern CSubmissionR tid ssh csh shn cid ptn
= CSheetR tid ssh csh shn (SubmissionR cid ptn) = CSheetR tid ssh csh shn (SubmissionR cid ptn)
pluralDE :: Int -- ^ Count pluralDE :: (Eq a, Num a)
-> Text -- ^ Singular => a -- ^ Count
-> Text -- ^ Plural -> Text -- ^ Singular
-> Text -> Text -- ^ Plural
-> Text
pluralDE num singularForm pluralForm pluralDE num singularForm pluralForm
| num == 1 = singularForm | num == 1 = singularForm
| otherwise = pluralForm | otherwise = pluralForm

View File

@ -248,10 +248,9 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d
E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
E.orderBy [E.asc $ user E.^. UserDisplayName] E.orderBy [E.asc $ user E.^. UserSurname]
E.limit 1 E.limit 1
return (user E.^. UserDisplayName) return (user E.^. UserSurname)
) )
] ]
, dbtFilter = Map.fromList , dbtFilter = Map.fromList

View File

@ -202,7 +202,7 @@ getSheetListR tid ssh csh = do
] ]
psValidator = def psValidator = def
& defaultSorting [SortAscBy "submission-since"] & defaultSorting [SortDescBy "submission-since"]
(table,raw_statistics) <- runDB $ liftA2 (,) (table,raw_statistics) <- runDB $ liftA2 (,)
(dbTableWidget' psValidator DBTable (dbTableWidget' psValidator DBTable

View File

@ -9,25 +9,22 @@ import Utils.Lens
addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
addBonusToPoints sts = addBonusToPoints sts =
sts & _normalSummary . _achievedPoints %~ maxBonusPts . addBonusPts sts & _normalSummary . _achievedPasses %~ (min passmax . (passbonus +))
& _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass & _normalSummary . _achievedPoints %~ (min ptsmax . (ptsbonus +))
where where
bonusPoints = sts ^. _bonusSummary . _achievedPoints passmax = sts ^. _normalSummary . _numMarkedPasses
maxPoints = sts ^. _normalSummary . _sumGradePoints passbonus = sts ^. _bonusSummary . _achievedPasses
maxBonusPts = fmap $ min maxPoints ptsmax = sts ^. _normalSummary . _sumMarkedPoints
addBonusPts = maybeAdd bonusPoints ptsbonus = sts ^. _bonusSummary . _achievedPoints
bonusPasses = sts ^. _bonusSummary . _achievedPasses gradeSummaryWidget :: RenderMessage UniWorX msg => (Integer -> msg) -> SheetTypeSummary -> Widget
maxPasses = sts ^. _normalSummary . _numGradePasses
maxBonusPass = fmap $ min maxPasses
addBonusPass = maybeAdd bonusPasses
gradeSummaryWidget :: RenderMessage UniWorX msg => (Int -> msg) -> SheetTypeSummary -> Widget
gradeSummaryWidget title sts = gradeSummaryWidget title sts =
let SheetTypeSummary{..} = addBonusToPoints sts let SheetTypeSummary{..} = addBonusToPoints sts
sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded) sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)
hasPassings = positiveSum $ numGradePasses sumSummaries hasPasses = positiveSum $ numSheetsPasses sumSummaries
hasPoints = positiveSum $ sumGradePoints sumSummaries hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries
hasPoints = positiveSum $ numSheetsPoints sumSummaries
hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries
rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow")
| (sumHeader,summary) <- | (sumHeader,summary) <-
[ (MsgSheetTypeNormal' ,normalSummary) [ (MsgSheetTypeNormal' ,normalSummary)

View File

@ -11,7 +11,7 @@ import Database.Persist.Quasi
import Database.Persist.TH.Directory import Database.Persist.TH.Directory
-- import Data.Time -- import Data.Time
-- import Data.ByteString -- import Data.ByteString
import Model.Types import Model.Types hiding (_maxPoints, _passingPoints)
import Cron.Types import Cron.Types
import Data.Aeson (Value) import Data.Aeson (Value)

View File

@ -109,7 +109,7 @@ instance FromJSON a => FromJSON (E.Value a) where
parseJSON = fmap E.Value . parseJSON parseJSON = fmap E.Value . parseJSON
type Count = Sum Integer
type Points = Centi type Points = Centi
toPoints :: Integral a => a -> Points -- deprecated toPoints :: Integral a => a -> Points -- deprecated
@ -123,6 +123,8 @@ fromPoints = round
instance DisplayAble Points instance DisplayAble Points
instance DisplayAble a => DisplayAble (Sum a) where
display (Sum x) = display x
data SheetGrading data SheetGrading
= Points { maxPoints :: Points } = Points { maxPoints :: Points }
@ -137,17 +139,35 @@ deriveJSON defaultOptions
} ''SheetGrading } ''SheetGrading
derivePersistFieldJSON ''SheetGrading derivePersistFieldJSON ''SheetGrading
makeLenses_ ''SheetGrading
_passingBound :: Fold SheetGrading (Either () Points)
_passingBound = folding passPts
where
passPts :: SheetGrading -> Maybe (Either () Points)
passPts (Points{}) = Nothing
passPts (PassPoints{passingPoints}) = Just $ Right passingPoints
passPts (PassBinary) = Just $ Left ()
gradingPassed :: SheetGrading -> Points -> Maybe Bool gradingPassed :: SheetGrading -> Points -> Maybe Bool
gradingPassed (Points {}) _ = Nothing gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints where pBinary _ = pts /= 0
gradingPassed (PassBinary {}) pts = Just $ pts /= 0 pPoints b = pts >= b
data SheetGradeSummary = SheetGradeSummary data SheetGradeSummary = SheetGradeSummary
{ numSheets :: Sum Int { numSheets :: Count -- Total number of sheets, includes all
, numGradePasses :: Sum Int , numSheetsPasses :: Count -- Number of sheets required to pass FKA: numGradePasses
, sumGradePoints :: Sum Points , numSheetsPoints :: Count -- Number of sheets having points FKA: sumGradePointsd
, achievedPasses :: Maybe (Sum Int) , sumSheetsPoints :: Sum Points -- Total of all points in all sheets
, achievedPoints :: Maybe (Sum Points) -- Marking dependend
, numMarked :: Count -- Number of already marked sheets
, numMarkedPasses :: Count -- Number of already marked sheets with passes
, numMarkedPoints :: Count -- Number of already marked sheets with points
, sumMarkedPoints :: Sum Points -- Achieveable points within marked sheets
--
, achievedPasses :: Count -- Achieved passes (within marked sheets)
, achievedPoints :: Sum Points -- Achieved points (within marked sheets)
} deriving (Generic, Read, Show, Eq) } deriving (Generic, Read, Show, Eq)
instance Monoid SheetGradeSummary where instance Monoid SheetGradeSummary where
@ -160,20 +180,23 @@ instance Semigroup SheetGradeSummary where
makeLenses_ ''SheetGradeSummary makeLenses_ ''SheetGradeSummary
sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
sheetGradeSum gr Nothing = mempty
{ numSheets = 1
, numSheetsPasses = bool mempty 1 $ has _passingBound gr
, numSheetsPoints = bool mempty 1 $ has _maxPoints gr
, sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints
}
sheetGradeSum gr (Just p) = sheetGradeSum gr (Just p) =
let baseSum = (sheetGradeSum gr Nothing) { achievedPasses = Sum . bool 0 1 <$> gradingPassed gr p } let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
in case gr of PassBinary -> baseSum in unmarked
_other -> baseSum { achievedPoints = Just $ Sum $ p } { numMarked = numSheets
sheetGradeSum (Points {..}) Nothing = mempty { numSheets = Sum 1 , numMarkedPasses = numSheetsPasses
, sumGradePoints = Sum maxPoints , numMarkedPoints = numSheetsPoints
} , sumMarkedPoints = sumSheetsPoints
sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets = Sum 1 , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p
, numGradePasses = Sum 1 , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr
, sumGradePoints = Sum maxPoints }
}
sheetGradeSum (PassBinary) Nothing = mempty { numSheets = Sum 1
, numGradePasses = Sum 1
}
data SheetType data SheetType
= Normal { grading :: SheetGrading } = Normal { grading :: SheetGrading }
@ -193,7 +216,7 @@ data SheetTypeSummary = SheetTypeSummary
{ normalSummary { normalSummary
, bonusSummary , bonusSummary
, informationalSummary :: SheetGradeSummary , informationalSummary :: SheetGradeSummary
, numNotGraded :: Sum Int , numNotGraded :: Count
} deriving (Generic, Read, Show, Eq) } deriving (Generic, Read, Show, Eq)
instance Monoid SheetTypeSummary where instance Monoid SheetTypeSummary where

View File

@ -337,7 +337,7 @@ ifMaybeM :: Monad m => Maybe a -> b -> (a -> m b) -> m b -- more convenient argu
ifMaybeM Nothing dft _ = return dft ifMaybeM Nothing dft _ = return dft
ifMaybeM (Just x) _ act = act x ifMaybeM (Just x) _ act = act x
maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespear: one $maybe instead of $with & $if maybePositive :: (Num a, Ord a) => a -> Maybe a -- convenient for Shakespeare: one $maybe instead of $with & $if
maybePositive a | a > 0 = Just a maybePositive a | a > 0 = Just a
| otherwise = Nothing | otherwise = Nothing

View File

@ -1,15 +1,25 @@
$# Displays gradings Summary for various purposes $# Displays gradings Summary for various purposes
$# Expects several variables:
$# sumSummaries :: SheetGradeSummary -- summary over all grading types
$# hasPasses :: Maybe Int -- Should Passing be displayed?
$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets
$# -- $# --
<div> <div>
<h3>_{title $ getSum $ numSheets $ sumSummaries} <h3>_{MsgSummaryTitle} _{title $ getSum $ numSheets $ sumSummaries}
<table .table .table--striped> <table .table .table--striped>
<tr .table__row .table__row--head> <tr .table__row .table__row--head>
<th> <th>
$# empty cell for row headers $# empty cell for row headers
$maybe _ <- hasPassings $maybe _ <- hasMarkedPasses
<th .table__th colspan=2>_{MsgSheetGradingPassing'} <th .table__th colspan=2>_{MsgCorrected}
$maybe _ <- hasPasses
<th .table__th>_{MsgSheetGradingPassing'}
$maybe _ <- hasMarkedPoints
<th .table__th colspan=2>_{MsgCorrected}
$maybe _ <- hasPoints $maybe _ <- hasPoints
<th .table__th colspan=2>_{MsgSheetGradingPoints'} <th .table__th>_{MsgSheetGradingPoints'}
<th .table__th>_{MsgSheetGradingCount'} <th .table__th>_{MsgSheetGradingCount'}
$# Number of Sheet/Submissions used for calculating maximum passes/points $# Number of Sheet/Submissions used for calculating maximum passes/points
$forall row <- rowWdgts $forall row <- rowWdgts
@ -17,14 +27,18 @@ $# --
$maybe nrNoGrade <- positiveSum $ numNotGraded $maybe nrNoGrade <- positiveSum $ numNotGraded
<tr .table__row> <tr .table__row>
<th .table__th>_{MsgSheetTypeNotGraded} <th .table__th>_{MsgSheetTypeNotGraded}
$maybe _ <- hasPassings $maybe _ <- hasMarkedPasses
<td colspan=2> <td colspan=2>
$maybe _ <- hasPoints $maybe _ <- hasPasses
<td .table__td>
$maybe _ <- hasMarkedPoints
<td .table__td colspan=2> <td .table__td colspan=2>
$maybe _ <- hasPoints
<td .table__td>
<td .table__td>#{display nrNoGrade} <td .table__td>#{display nrNoGrade}
$maybe _ <- positiveSum $ bonusSummary ^. _numSheets $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
<p>_{MsgSheetTypeInfoBonus} <p>_{MsgSheetTypeInfoBonus} #
$maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints) $maybe _ <- positiveSum $ bonusSummary ^. _achievedPoints
_{MsgSheetGradingBonusIncluded} _{MsgSheetGradingBonusIncluded}
$maybe _ <- positiveSum $ informationalSummary ^. _numSheets $maybe _ <- positiveSum $ informationalSummary ^. _numSheets
<p>_{MsgSheetTypeInfoNotGraded} <p>_{MsgSheetTypeInfoNotGraded}

View File

@ -1,33 +1,40 @@
$# Displays one row of the grading summary $# Displays one row of the grading summary
$# Expects several variables: $# Expects several variables:
$# hasPassing :: Maybe Int -- Should Passing be displayed?
$# hasPoints :: Maybe Poibts -- Should Points be displayed?
$# summary :: SheetGradeSummary -- summary to display $# summary :: SheetGradeSummary -- summary to display
$# sumHeader :: UniWorXMessage -- row header $# sumHeader :: UniWorXMessage -- row header
$# hasPasses :: Maybe Int -- Should Passing be displayed?
$# hasMarkedPasses :: Maybe Int -- Number of marked pass-sheets
$# hasPoints :: Maybe Points -- Should Points be displayed?
$# hasMarkedPoints :: Maybe Int -- Number of marked point-sheets
$# $#
$maybe nrSheets <- positiveSum $ summary ^. _numSheets $# TODO: Durschnittliche Punktzahl anzeigen
<tr .table__row > $# TODO: Extra-Spalte für Punkte Bewertet = numMarkedPoints / Punkte Gesamt = sumSheetPoints
$#
$maybe _ <- positiveSum $ summary ^. _numSheets
<tr .table__row>
<th .table__th>_{sumHeader} <th .table__th>_{sumHeader}
$maybe _ <- hasPassings $maybe _ <- hasMarkedPasses
$with Sum pmax <- summary ^. _numGradePasses $with Sum pmax <- summary ^. _numMarkedPasses
$maybe Sum pacv <- summary ^. _achievedPasses $with Sum pacv <- summary ^. _achievedPasses
<td .table__td> <td .table__td>
$if pmax /= 0 $if pmax > 0
#{textPercentInt pacv pmax} #{textPercentInt pacv pmax}
<td .table__td> <td .table__td>
#{display pacv} / #{display pmax} #{display pacv} / #{display pmax}
$nothing $maybe _ <- hasPasses
<td .table__td colspan=2> <td .table__td>
#{display pmax } #{display $ summary ^. _numSheetsPasses}
$maybe _ <- hasMarkedPoints
$with Sum pmax <- summary ^. _sumMarkedPoints
$with Sum pacv <- summary ^. _achievedPoints
<td .table__td>
$if pmax > 0
#{textPercent $ realToFrac $ pacv / pmax}
<td .table__td>
#{display pacv} / #{display pmax}
\ (_{title $ getSum $ summary ^. _numMarkedPoints})
$maybe _ <- hasPoints $maybe _ <- hasPoints
$with Sum pmax <- summary ^. _sumGradePoints <td .table__td>
$maybe Sum pacv <- summary ^. _achievedPoints #{display (summary ^. _sumSheetsPoints)}
<td .table__td> \ (_{title $ getSum $ summary ^. _numSheetsPoints})
$if pmax /= 0 <td .table__td>#{display $ summary ^. _numSheets}
#{textPercent $ realToFrac $ pacv / pmax}
<td .table__td>
#{display pacv} / #{display pmax}
$nothing
<td .table__td colspan=2>
#{display pmax }
<td .table__td>#{display nrSheets}

View File

@ -1,41 +0,0 @@
$# DEPRECATED IN FAVOUR OF widgets/gradingSummary.hamlet DO NOT USE !!!
$with realGrades <- normalSummary <> bonusSummary
$# $with allGrades <- realGrades <> informationalSummary
<div>
$maybe realPoints <- positiveSum (sumGradePoints realGrades)
<p>
Gesamtpunktzahl #{display realPoints}
$maybe nPts <- getSum <$> achievedPoints realGrades
\ davon #{display nPts} erreicht
$maybe bPts <- getSum <$> achievedPoints bonusSummary
\ (inklusive #{display bPts} #
$maybe achievedBonus <- positiveSum (sumGradePoints bonusSummary)
von #{display achievedBonus} erreichbaren #
Bonuspunkten)
$if realPoints /= 0
\ #{textPercent $ realToFrac $ nPts / realPoints}
\.
$maybe fakePoints <- positiveSum (sumGradePoints informationalSummary)
<p>
<em>Hinweis:
\ #{display fakePoints} Punkte gab es für Aufgabenblätter, #
welche nicht gewertet wurden, sondern nur informativen Charakter besitzen
$maybe achievedFakes <- getSum <$> achievedPoints informationalSummary
, davon wurden #{display achievedFakes} erreicht
$if fakePoints /= 0
\ #{textPercent $ realToFrac $ achievedFakes / fakePoints}
\.
$maybe reqPasses <- positiveSum (numGradePasses normalSummary)
<p>
Aufgaben zum Bestehen: #{display reqPasses}
$maybe passed <- getSum <$> achievedPasses realGrades
\ davon #{display passed} bestanden
$maybe bonusPassed <- getSum <$> achievedPasses bonusSummary
\ (inklusive #{display bonusPassed} Bonusaufgaben)
\.
$maybe noGradeSheets <- positiveSum numNotGraded
<p>
#{display noGradeSheets} unbewertete Aufgabenblätter.