diff --git a/.vscode/tasks.json b/.vscode/tasks.json
index c5f9eaf8e..51fa5f4bf 100644
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@@ -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
}
}
]
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index f27bdb02b..4b7c8a3b0 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -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
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 10de66a02..cd09b4ad8 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -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
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index c1961857e..9e2285d40 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -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
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 6150a1d54..0a25a30a6 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -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
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 8a019b66d..cc3d146fc 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -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
diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs
index b2b0d8a1e..b5438b299 100644
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@@ -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)
, "============================================="
diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
index fd7543f47..204ac5392 100644
--- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs
+++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
@@ -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
diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs
index b66bbb471..5c5cd0900 100644
--- a/src/Jobs/Handler/SendTestEmail.hs
+++ b/src/Jobs/Handler/SendTestEmail.hs
@@ -2,7 +2,7 @@ module Jobs.Handler.SendTestEmail
( dispatchJobSendTestEmail
) where
-import Import hiding ((.=))
+import Import
import Handler.Utils.DateTime
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index bdc362560..92bc5c8d3 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -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]
+ )
]
diff --git a/src/Model/Migration/Types.hs b/src/Model/Migration/Types.hs
new file mode 100644
index 000000000..c3885f3ff
--- /dev/null
+++ b/src/Model/Migration/Types.hs
@@ -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
\ No newline at end of file
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 0b10e1fb0..acd08a9a6 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -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 }
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index d99d3c4a4..00b2e77d6 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -24,6 +24,10 @@ makeLenses_ ''SheetCorrector
makeLenses_ ''SubmissionGroup
+makeLenses_ ''SheetGrading
+
+makeLenses_ ''SheetType
+
-- makeClassy_ ''Load
diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet
index a3036193f..8c0b21a71 100644
--- a/templates/correction-user.hamlet
+++ b/templates/correction-user.hamlet
@@ -11,28 +11,34 @@
| _{MsgRatingTime}
| ^{formatTimeW SelFormatDateTime time}
+
$maybe points <- submissionRatingPoints
- $case sheetType
- $of Bonus{..}
- |
- | _{MsgAchievedBonusPoints}
- | _{MsgAchievedOf points maxPoints}
- $of Normal{..}
- |
- | _{MsgAchievedNormalPoints}
- | _{MsgAchievedOf points maxPoints}
- $of Pass{..}
- |
- | _{MsgPassedResult}
- |
- $if points >= passingPoints
- _{MsgPassed}
- $else
- _{MsgNotPassed}
- |
- | _{MsgAchievedPassPoints}
- | _{MsgPassAchievedOf points passingPoints maxPoints}
- $of NotGraded
+ $maybe grading <- preview _grading sheetType
+ $case grading
+ $of Points{..}
+ |
+ | #{sheetTypeDesc}
+ | _{MsgAchievedOf points maxPoints}
+ $of PassPoints{..}
+ |
+ | #{sheetTypeDesc}
+ |
+ $if fromMaybe False (gradingPassed grading points)
+ _{MsgPassed}
+ $else
+ _{MsgNotPassed}
+ |
+ | _{MsgAchievedPassPoints}
+ | _{MsgPassAchievedOf points passingPoints maxPoints}
+ $of PassBinary
+ |
+ | #{sheetTypeDesc}
+ |
+ $if fromMaybe False (gradingPassed grading points)
+ _{MsgPassed}
+ $else
+ _{MsgNotPassed}
+
$maybe comment <- ratingComment
|
| _{MsgRatingComment}
diff --git a/templates/mail/submissionRated.hamlet b/templates/mail/submissionRated.hamlet
index d808e4927..77b7ba80c 100644
--- a/templates/mail/submissionRated.hamlet
+++ b/templates/mail/submissionRated.hamlet
@@ -33,31 +33,30 @@ $newline never
_{MsgRatingTime}
#{time}
+ #{sheetTypeDesc}
$maybe points <- submissionRatingPoints
- $case sheetType
- $of Bonus{..}
-
- _{MsgAchievedBonusPoints}
-
- _{MsgAchievedOf points maxPoints}
- $of Normal{..}
-
- _{MsgAchievedNormalPoints}
-
- _{MsgAchievedOf points maxPoints}
- $of Pass{..}
-
- _{MsgPassedResult}
-
- $if points >= passingPoints
- _{MsgPassed}
- $else
- _{MsgNotPassed}
-
- _{MsgAchievedPassPoints}
-
- _{MsgPassAchievedOf points passingPoints maxPoints}
- $of NotGraded
+ $maybe grading <- preview _grading sheetType
+ $case grading
+ $of Points{..}
+
+ _{MsgAchievedOf points maxPoints}
+ $of PassPoints{..}
+
+ $if fromMaybe False (gradingPassed grading points)
+ _{MsgPassed}
+ $else
+ _{MsgNotPassed}
+
+ _{MsgAchievedPassPoints}
+
+ _{MsgPassAchievedOf points passingPoints maxPoints}
+ $of PassBinary
+
+ $if fromMaybe False (gradingPassed grading points)
+ _{MsgPassed}
+ $else
+ _{MsgNotPassed}
+
$maybe comment <- submissionRatingComment
_{MsgRatingComment}
diff --git a/templates/widgets/rating.hamlet b/templates/widgets/rating.hamlet
index 177119151..2b3d021e1 100644
--- a/templates/widgets/rating.hamlet
+++ b/templates/widgets/rating.hamlet
@@ -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}
|