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

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

Browse Source
This commit is contained in:
Gregor Kleen 2018-10-31 13:21:00 +01:00
commit 75dcb120ed
16 changed files with 262 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
.vscode/tasks.json vendored
View File

@ -4,12 +4,32 @@
"version": "2.0.0",
"tasks": [
{
"label": "echo",
"label": "start",
"type": "shell",
"command": "echo Hello",
"command": "./start.sh",
"group": "test",
"presentation": {
"echo": true,
"reveal": "always",
"focus": false,
"panel": "shared",
"showReuseMessage": true
}
},
{
"label": "build",
"type": "shell",
"command": "stack build --flag uniworx:dev --flag uniworx:library-only",
"group": {
"kind": "build",
"isDefault": true
},
"presentation": {
"echo": true,
"reveal": "always",
"focus": false,
"panel": "shared",
"showReuseMessage": true
}
}
]

29
messages/uniworx/de.msg
View File

@ -351,18 +351,27 @@ MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n
MailEditNotifications: Benachrichtigungen ein-/ausschalten
MailSubjectSupport: Supportanfrage
SheetTypeBonus: Bonus
SheetTypeNormal: Normal
SheetTypePass: Bestehen
SheetTypeNotGraded: Keine Wertung
SheetGrading: Bewertung
SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte
SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
SheetGradingPassBinary: Bestanden/Nicht Bestanden
SheetTypeBonus' maxPoints@Points: #{tshow maxPoints} Bonuspunkte
SheetTypeNormal' maxPoints@Points: #{tshow maxPoints} Punkte
SheetTypePass' maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
SheetTypeNotGraded': Nicht gewertet
SheetGradingPoints': Punkte
SheetGradingPassPoints': Bestehen nach Punkten
SheetGradingPassBinary': Bestanden/Nicht bestanden
SheetTypeMaxPoints: Maximalpunktzahl
SheetTypePassingPoints: Notwendig zum Bestehen
SheetTypeBonus grading@SheetGrading: Bonus
SheetTypeNormal grading@SheetGrading: Normal
SheetTypeInformational grading@SheetGrading: Keine Wertung
SheetTypeNotGraded: Unbewertet
SheetTypeBonus': Bonus
SheetTypeNormal': Normal
SheetTypeInformational': Keine Wertung
SheetTypeNotGraded': Unbewertet
SheetGradingMaxPoints: Maximalpunktzahl
SheetGradingPassingPoints: Notwendig zum Bestehen
SheetGroupArbitrary: Arbiträre Gruppen
SheetGroupRegisteredGroups: Registrierte Gruppen

7
src/Foundation.hs
View File

@ -222,10 +222,11 @@ instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
embedRenderMessage ''UniWorX ''MessageClass ("Message" <>)
embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
embedRenderMessage ''UniWorX ''SheetType $ \st -> "SheetType" <> st <> "'"
embedRenderMessage ''UniWorX ''StudyFieldType id
embedRenderMessage ''UniWorX ''SheetFileType id
embedRenderMessage ''UniWorX ''CorrectorState id
embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>)
embedRenderMessage ''UniWorX ''SheetType ("SheetType" <>)
newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
@ -893,7 +894,7 @@ defaultLinks = -- Define the menu items of the header.
, menuItemAccessCallback' = return True
}
, NavbarRight $ MenuItem
{ menuItemLabel = "Einstellungen"
{ menuItemLabel = "Anpassen"
, menuItemIcon = Just "cogs"
, menuItemRoute = ProfileR
, menuItemModal = False
@ -928,7 +929,7 @@ defaultLinks = -- Define the menu items of the header.
, menuItemAccessCallback' = return True
}
, NavbarAside $ MenuItem
{ menuItemLabel = "Korrekturen"
{ menuItemLabel = "Korrektur"
, menuItemIcon = Just "check"
, menuItemRoute = CorrectionsR
, menuItemModal = False

5
src/Handler/Corrections.hs
View File

@ -535,6 +535,8 @@ postCorrectionR tid ssh csh shn cid = do
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")
@ -546,8 +548,9 @@ getCorrectionUserR tid ssh csh shn cid = do
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

19
src/Handler/Sheet.hs
View File

@ -44,11 +44,11 @@ import qualified Data.Map as Map
import Data.Monoid (Sum(..), Any(..))
import Control.Lens
-- import Utils.Lens
-- import Control.Lens
import Utils.Lens
import qualified Data.Text as Text
import qualified Data.Aeson as Aeson
--import qualified Data.Aeson as Aeson
import Control.Monad.Random.Class (MonadRandom(..))
import Utils.Sql
@ -166,7 +166,7 @@ getSheetListR tid ssh csh = do
, sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
$ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveTo
, sortable Nothing (i18nCell MsgSheetType)
$ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType
$ \(Entity _ Sheet{..}, _, _) -> i18nCell sheetType
, sortable Nothing (i18nCell MsgSubmission)
$ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
Nothing -> mempty
@ -190,12 +190,11 @@ getSheetListR tid ssh csh = do
(i18nCell MsgRatingPercent)
$ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
(Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
case sType of
NotGraded -> mempty
_ | maxPoints sType > 0 ->
let percent = sPoints / maxPoints sType
in textCell $ textPercent $ realToFrac percent
_other -> mempty
case preview (_grading . _maxPoints) sType of
(Nothing) -> mempty
(Just maxPoints) ->
let percent = sPoints / maxPoints
in textCell $ textPercent $ realToFrac percent
_other -> mempty
]
psValidator = def

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

@ -310,7 +310,23 @@ multiFileField permittedFiles' = Field{..}
Right _ -> return ()
Left r -> yield r
data SheetType' = Bonus' | Normal' | Pass' | NotGraded'
data SheetGrading' = Points' | PassPoints' | PassBinary'
deriving (Eq, Ord, Read, Show, Enum, Bounded)
instance Universe SheetGrading'
instance Finite SheetGrading'
$(return [])
instance PathPiece SheetGrading' where
toPathPiece = $(nullaryToPathPiece ''SheetGrading' [intercalate "-" . splitCamel , fromJust . stripSuffix "'"])
fromPathPiece = finiteFromPathPiece
embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)
data SheetType' = Bonus' | Normal' | Informational' | NotGraded'
deriving (Eq, Ord, Read, Show, Enum, Bounded)
instance Universe SheetType'
@ -322,14 +338,8 @@ instance PathPiece SheetType' where
toPathPiece = $(nullaryToPathPiece ''SheetType' [intercalate "-" . splitCamel , fromJust . stripSuffix "'"])
fromPathPiece = finiteFromPathPiece
instance RenderMessage UniWorX SheetType' where
renderMessage f ls = \case
Bonus' -> render MsgSheetTypeBonus
Normal' -> render MsgSheetTypeNormal
Pass' -> render MsgSheetTypePass
NotGraded' -> render MsgSheetTypeNotGraded
where
render = renderMessage f ls
embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)
data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups'
deriving (Eq, Ord, Read, Show, Enum, Bounded)
@ -351,44 +361,40 @@ instance RenderMessage UniWorX SheetGroup' where
where
render = renderMessage f ls
sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType
sheetTypeAFormReq FieldSettings{..} template = formToAForm $ do
let
selOptions = Map.fromList
[ ( Bonus', Bonus <$> maxPointsReq )
, ( Normal', Normal <$> maxPointsReq )
, ( Pass', Pass
<$> maxPointsReq
<*> apreq pointsField (fslpI MsgSheetTypePassingPoints "Punkte" & noValidate) (preview _passingPoints =<< template)
)
, ( NotGraded', pure NotGraded )
sheetGradingAFormReq :: FieldSettings UniWorX -> Maybe SheetGrading -> AForm Handler SheetGrading
sheetGradingAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
where
selOptions = Map.fromList
[ ( Points', Points <$> maxPointsReq )
, ( PassPoints', PassPoints <$> maxPointsReq <*> passPointsReq )
, ( PassBinary', pure PassBinary)
]
(res, selView) <- multiAction selOptions (classify' <$> template)
fvId <- maybe newIdent return fsId
MsgRenderer mr <- getMsgRenderer
return (res,
[ FieldView
{ fvLabel = toHtml $ mr fsLabel
, fvTooltip = toHtml . mr <$> fsTooltip
, fvId
, fvInput = selView
, fvErrors = case res of
FormFailure [e] -> Just $ toHtml e
_ -> Nothing
, fvRequired = True
}
])
where
maxPointsReq = apreq pointsField (fslpI MsgSheetTypeMaxPoints "Punkte" & noValidate) (preview _maxPoints =<< template)
classify' :: SheetGrading -> SheetGrading'
classify' = \case
Points {} -> Points'
PassPoints {} -> PassPoints'
PassBinary {} -> PassBinary'
maxPointsReq = apreq pointsField (fslI MsgSheetGradingMaxPoints) (template >>= preview _maxPoints)
passPointsReq = apreq pointsField (fslI MsgSheetGradingPassingPoints) (template >>= preview _passingPoints)
sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType
sheetTypeAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
where
selOptions = Map.fromList
[ ( Bonus' , Bonus <$> gradingReq )
, ( Normal', Normal <$> gradingReq )
, ( Informational', Informational <$> gradingReq )
, ( NotGraded', pure NotGraded )
]
gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading) (template >>= preview _grading)
classify' :: SheetType -> SheetType'
classify' = \case
Bonus _ -> Bonus'
Normal _ -> Normal'
Pass _ _ -> Pass'
Bonus {} -> Bonus'
Normal {} -> Normal'
Informational {} -> Informational'
NotGraded -> NotGraded'
sheetGroupAFormReq :: FieldSettings UniWorX -> Maybe SheetGroup -> AForm Handler SheetGroup

10
src/Handler/Utils/Rating.hs
View File

@ -45,6 +45,8 @@ import qualified Database.Esqueleto as E
import qualified Data.Conduit.List as Conduit
import Utils.Lens hiding ((<.>))
instance HasResolution prec => Pretty (Fixed prec) where
pretty = pretty . show
@ -53,6 +55,12 @@ instance Pretty x => Pretty (CI x) where
pretty = pretty . CI.original
instance Pretty SheetGrading where
pretty (Points {..}) = pretty ( (show maxPoints) <> " Punkte" :: String)
pretty (PassPoints {..}) = pretty ( (show maxPoints) <> " Punkte, bestanden ab " <> (show passingPoints) <> " Punkte" :: String )
pretty (PassBinary) = pretty ( "Bestanden (1) / Nicht bestanden (0)" :: String )
data Rating = Rating
{ ratingCourseName :: CourseName
, ratingSheetName :: SheetName
@ -119,7 +127,7 @@ formatRating cID Rating{ ratingValues = Rating'{..}, ..} = let
[ Just $ "Veranstaltung:" <+> pretty ratingCourseName
, Just $ "Blatt:" <+> pretty ratingSheetName
, ("Korrektor:" <+>) . pretty <$> ratingCorrectorName
, Just $ "Bewertung:" <+> pretty (display ratingSheetType)
, ("Bewertung:" <+>) . pretty <$> (ratingSheetType ^? _grading)
]
, "Abgabe-Id:" <+> pretty (Text.unpack $ toPathPiece cID)
, "============================================="

3
src/Jobs/Handler/SendNotification/SubmissionRated.hs
View File

@ -25,6 +25,7 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
csid <- encrypt nSubmission
MsgRenderer mr <- getMailMsgRenderer
let termDesc = mr . ShortTermIdentifier $ unTermKey courseTerm
let sheetTypeDesc = mr sheetType
submissionRatingTime' <- traverse (formatTimeMail SelFormatDateTime) submissionRatingTime
let tid = courseTerm
ssh = courseSchool
@ -39,7 +40,7 @@ dispatchNotificationSubmissionRated nSubmission jRecipient = userMailT jRecipien
, "submission-rating-comment" Aeson..= submissionRatingComment
, "submission-rating-time" Aeson..= submissionRatingTime
, "submission-rating-by" Aeson..= (userDisplayName <$> corrector)
, "submission-rating-passed" Aeson..= ((>=) <$> submissionRatingPoints <*> preview _passingPoints sheetType)
, "submission-rating-passed" Aeson..= (join $ gradingPassed <$> sheetType ^? _grading <*> submissionRatingPoints)
, "sheet-name" Aeson..= sheetName
, "sheet-type" Aeson..= sheetType
, "course-name" Aeson..= courseName

2
src/Jobs/Handler/SendTestEmail.hs
View File

@ -2,7 +2,7 @@ module Jobs.Handler.SendTestEmail
( dispatchJobSendTestEmail
) where
import Import hiding ((.=))
import Import
import Handler.Utils.DateTime

6
src/Model/Migration.hs
View File

@ -8,6 +8,7 @@ import Utils (lastMaybe)
import Model
import Model.Migration.Version
import qualified Model.Migration.Types as Legacy
import Data.Map (Map)
import qualified Data.Map as Map
@ -188,6 +189,11 @@ customMigrations = Map.fromListWith (>>)
UPDATE "user" SET "notification_settings" = (#{def :: NotificationSettings} :: json) WHERE "notification_settings" is null;
|]
)
, ( AppliedMigrationKey [migrationVersion|5.0.0|] [version|6.0.0|]
, whenM (tableExists "sheet") $ do
sheets <- [sqlQQ| SELECT "id", "type" FROM "sheet"; |]
forM_ sheets $ \(sid, Single lsty) -> update sid [SheetType =. Legacy.sheetType lsty]
)
]

33
src/Model/Migration/Types.hs Normal file
View File

@ -0,0 +1,33 @@
module Model.Migration.Types where
import ClassyPrelude.Yesod hiding (derivePersistFieldJSON)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Data.Aeson (FromJSON(..), ToJSON(..), FromJSONKey(..), ToJSONKey(..), FromJSONKeyFunction(..), withText, withObject, Value())
import Data.Aeson.Types (toJSONKeyText)
import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..), SumEncoding(..))
import Database.Persist.Sql
import qualified Model as Current
import qualified Model.Types.JSON as Current
data SheetType
= Bonus { maxPoints :: Current.Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
| Normal { maxPoints :: Current.Points } -- Erhöht das Maximum, wird gutgeschrieben
| Pass { maxPoints, passingPoints :: Current.Points }
| NotGraded
deriving (Show, Read, Eq)
sheetType :: SheetType -> Current.SheetType
sheetType Bonus {..} = Current.Bonus $ Current.Points {..}
sheetType Normal {..} = Current.Normal $ Current.Points {..}
sheetType Pass {..} = Current.Normal $ Current.PassPoints {..}
sheetType NotGraded = Current.NotGraded
{- TODO:
* RenderMessage instance for newtype(SheetType) if needed
-}
deriveJSON defaultOptions ''SheetType
Current.derivePersistFieldJSON ''SheetType

49
src/Model/Types.hs
View File

@ -113,24 +113,40 @@ fromPoints = round
instance DisplayAble Points
data SheetType
= Bonus { maxPoints :: Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
| Normal { maxPoints :: Points } -- Erhöht das Maximum, wird gutgeschrieben
-- | Informational { maxPoints :: Points } -- Erhöht nicht das Maximum Keine Gutschrift
| Pass { maxPoints, passingPoints :: Points }
data SheetGrading
= Points { maxPoints :: Points }
| PassPoints { maxPoints, passingPoints :: Points }
| PassBinary -- non-zero means passed
deriving (Eq, Read, Show)
deriveJSON defaultOptions
{ constructorTagModifier = intercalate "-" . map toLower . splitCamel
, fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
, sumEncoding = TaggedObject "type" "data"
} ''SheetGrading
derivePersistFieldJSON ''SheetGrading
gradingPassed :: SheetGrading -> Points -> Maybe Bool
gradingPassed (Points {}) _ = Nothing
gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints
gradingPassed (PassBinary {}) pts = Just $ pts /= 0
data SheetType
= Bonus { grading :: SheetGrading }
| Normal { grading :: SheetGrading }
| Informational { grading :: SheetGrading }
| NotGraded
deriving (Show, Read, Eq)
deriving (Eq, Read, Show)
instance DisplayAble SheetType where
display (Bonus {..}) = tshow maxPoints <> " Bonuspunkte"
display (Normal{..}) = tshow maxPoints <> " Punkte"
display (Pass {..}) = "Bestanden ab " <> tshow (pToI passingPoints) <> " von " <> tshow maxPoints
display (NotGraded) = "Unbewertet"
deriveJSON defaultOptions ''SheetType
deriveJSON defaultOptions
{ constructorTagModifier = intercalate "-" . map toLower . splitCamel
, fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
, sumEncoding = TaggedObject "type" "data"
} ''SheetType
derivePersistFieldJSON ''SheetType
makeLenses_ ''SheetType
data SheetTypeSummary = SheetTypeSummary
{ sumBonusPoints :: Sum Points
@ -146,12 +162,15 @@ instance Monoid SheetTypeSummary where
mempty = memptydefault
mappend = mappenddefault
sheetTypeSum :: (SheetType, Maybe Points) -> SheetTypeSummary
sheetTypeSum = error "TODO sheetTypeSum"
{-
sheetTypeSum (Bonus{..}, achieved) = mempty { sumBonusPoints = Sum maxPoints, achievedBonus = Sum <$> achieved }
sheetTypeSum (Normal{..}, achieved) = mempty { sumNormalPoints = Sum maxPoints, achievedNormal = Sum <$> achieved }
sheetTypeSum (Pass{..}, achieved) = mempty { numPassSheets = Sum 1, achievedPasses = Sum . bool 0 1 . (passingPoints <=) <$> achieved}
sheetTypeSum (NotGraded, _ ) = mempty { numNotGraded = Sum 1 }
-}
data SheetGroup
= Arbitrary { maxParticipants :: Natural }

4
src/Utils/Lens.hs
View File

@ -24,6 +24,10 @@ makeLenses_ ''SheetCorrector
makeLenses_ ''SubmissionGroup
makeLenses_ ''SheetGrading
makeLenses_ ''SheetType
-- makeClassy_ ''Load

48
templates/correction-user.hamlet
View File

@ -11,28 +11,34 @@
<tr .table__row>
<th .table__th>_{MsgRatingTime}
<td .table__td>^{formatTimeW SelFormatDateTime time}
$maybe points <- submissionRatingPoints
$case sheetType
$of Bonus{..}
<tr .table__row>
<th .table__th>_{MsgAchievedBonusPoints}
<td .table__td>_{MsgAchievedOf points maxPoints}
$of Normal{..}
<tr .table__row>
<th .table__th>_{MsgAchievedNormalPoints}
<td .table__td>_{MsgAchievedOf points maxPoints}
$of Pass{..}
<tr .table__row>
<th .table__th>_{MsgPassedResult}
<td .table__td>
$if points >= passingPoints
_{MsgPassed}
$else
_{MsgNotPassed}
<tr .table__row>
<th .table__th>_{MsgAchievedPassPoints}
<td .table__td>_{MsgPassAchievedOf points passingPoints maxPoints}
$of NotGraded
$maybe grading <- preview _grading sheetType
$case grading
$of Points{..}
<tr .table__row>
<th .table__th>#{sheetTypeDesc}
<td .table__td>_{MsgAchievedOf points maxPoints}
$of PassPoints{..}
<tr .table__row>
<th .table__th>#{sheetTypeDesc}
<td .table__td>
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
<tr .table__row>
<th .table__th>_{MsgAchievedPassPoints}
<td .table__td>_{MsgPassAchievedOf points passingPoints maxPoints}
$of PassBinary
<tr .table__row>
<th .table__th>#{sheetTypeDesc}
<td .table__td>
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
$maybe comment <- ratingComment
<tr .table__row>
<th .table__th>_{MsgRatingComment}

47
templates/mail/submissionRated.hamlet
View File

@ -33,31 +33,30 @@ $newline never
_{MsgRatingTime}
<dd>
#{time}
<dt> #{sheetTypeDesc}
$maybe points <- submissionRatingPoints
$case sheetType
$of Bonus{..}
<dt>
_{MsgAchievedBonusPoints}
<dd>
_{MsgAchievedOf points maxPoints}
$of Normal{..}
<dt>
_{MsgAchievedNormalPoints}
<dd>
_{MsgAchievedOf points maxPoints}
$of Pass{..}
<dt>
_{MsgPassedResult}
<dd>
$if points >= passingPoints
_{MsgPassed}
$else
_{MsgNotPassed}
<dt>
_{MsgAchievedPassPoints}
<dd>
_{MsgPassAchievedOf points passingPoints maxPoints}
$of NotGraded
$maybe grading <- preview _grading sheetType
$case grading
$of Points{..}
<dd>
_{MsgAchievedOf points maxPoints}
$of PassPoints{..}
<dd>
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
<dt>
_{MsgAchievedPassPoints}
<dd>
_{MsgPassAchievedOf points passingPoints maxPoints}
$of PassBinary
<dd>
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
$maybe comment <- submissionRatingComment
<dt>
_{MsgRatingComment}

28
templates/widgets/rating.hamlet
View File

@ -2,15 +2,19 @@ $# Display Rating, expects
$# submissionRatingPoints :: Maybe points
$maybe points <- submissionRatingPoints
$case sheetType
$of Bonus{..}
_{MsgAchievedOf points maxPoints}
$of Normal{..}
_{MsgAchievedOf points maxPoints}
$of Pass{..}
$if points >= passingPoints
_{MsgPassed}
$else
_{MsgNotPassed}
$of NotGraded
#{display tickmarkS}
$maybe grading <- preview _grading sheetType
$case grading
$of Points{..}
_{MsgAchievedOf points maxPoints}
$of PassPoints{..}
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
$of PassBinary
$if fromMaybe False (gradingPassed grading points)
_{MsgPassed}
$else
_{MsgNotPassed}
$nothing
#{tickmarkS}