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

.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
             }
         }
     ]

messages/uniworx/de.msg

@@ -351,18 +351,27 @@ MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n
 MailEditNotifications: Benachrichtigungen ein-/ausschalten
 MailSubjectSupport: Supportanfrage
 
-SheetTypeBonus: Bonus
+SheetGrading: Bewertung
-SheetTypeNormal: Normal
+SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte
-SheetTypePass: Bestehen
+SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
-SheetTypeNotGraded: Keine Wertung
+SheetGradingPassBinary:  Bestanden/Nicht Bestanden
 
-SheetTypeBonus' maxPoints@Points: #{tshow maxPoints} Bonuspunkte
+SheetGradingPoints': Punkte
-SheetTypeNormal' maxPoints@Points: #{tshow maxPoints} Punkte
+SheetGradingPassPoints': Bestehen nach Punkten
-SheetTypePass' maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
+SheetGradingPassBinary': Bestanden/Nicht bestanden
-SheetTypeNotGraded': Nicht gewertet
 
-SheetTypeMaxPoints: Maximalpunktzahl
+SheetTypeBonus grading@SheetGrading: Bonus
-SheetTypePassingPoints: Notwendig zum Bestehen
+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

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

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

src/Handler/Sheet.hs

@@ -44,11 +44,11 @@ import qualified Data.Map as Map
 
 import Data.Monoid (Sum(..), Any(..))
 
-import Control.Lens
+-- import Control.Lens
--- import Utils.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
+                case preview (_grading . _maxPoints) sType of
-                  NotGraded -> mempty
+                  (Nothing) -> mempty
-                  _ | maxPoints sType > 0 ->
+                  (Just maxPoints) ->
-                        let percent = sPoints / maxPoints sType
+                        let percent = sPoints / maxPoints
-                        in textCell $ textPercent $ realToFrac percent
+                        in textCell $ textPercent $ realToFrac percent    
-                  _other -> mempty
               _other -> mempty
       ]
     psValidator = def

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
+embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)  
-  renderMessage f ls = \case
+
-    Bonus' -> render MsgSheetTypeBonus
-    Normal' -> render MsgSheetTypeNormal
-    Pass' -> render MsgSheetTypePass
-    NotGraded' -> render MsgSheetTypeNotGraded
-    where
-      render = renderMessage f ls
 
 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
+sheetGradingAFormReq :: FieldSettings UniWorX -> Maybe SheetGrading -> AForm Handler SheetGrading
-sheetTypeAFormReq FieldSettings{..} template = formToAForm $ do
+sheetGradingAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
-  let
+  where 
-    selOptions = Map.fromList
+    selOptions = Map.fromList 
-      [ ( Bonus', Bonus <$> maxPointsReq )
+      [ ( Points', Points <$> maxPointsReq )
-      , ( Normal', Normal <$> maxPointsReq )
+      , ( PassPoints', PassPoints <$> maxPointsReq <*> passPointsReq )
-      , ( Pass', Pass
+      , ( PassBinary', pure PassBinary)
-          <$> maxPointsReq
-          <*> apreq pointsField (fslpI MsgSheetTypePassingPoints "Punkte" & noValidate) (preview _passingPoints =<< template)
-        )
-      , ( NotGraded', pure NotGraded )
       ]
-  (res, selView) <- multiAction selOptions (classify' <$> template)
+    classify' :: SheetGrading -> SheetGrading' 
-
+    classify' = \case 
-  fvId <- maybe newIdent return fsId
+      Points {} -> Points'
-  MsgRenderer mr <- getMsgRenderer
+      PassPoints {} -> PassPoints'
-
+      PassBinary {} -> PassBinary'
-  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)
     
+    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'
+      Bonus  {} -> Bonus'
-      Normal _ -> Normal'
+      Normal {} -> Normal'
-      Pass _ _ -> Pass'
+      Informational {} -> Informational'
       NotGraded -> NotGraded'
 
 sheetGroupAFormReq :: FieldSettings UniWorX -> Maybe SheetGroup -> AForm Handler SheetGroup

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)
     , "============================================="

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

src/Jobs/Handler/SendTestEmail.hs

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

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]                
+    )
   ]
 
 

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

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
+data SheetGrading
-  | Normal { maxPoints :: Points } -- Erhöht das Maximum, wird gutgeschrieben
+  = Points     { maxPoints :: Points }
---  | Informational { maxPoints :: Points } -- Erhöht nicht das Maximum Keine Gutschrift
+  | PassPoints { maxPoints, passingPoints :: Points }
-  | Pass   { 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
+deriveJSON defaultOptions
-  display (Bonus {..}) = tshow maxPoints <> " Bonuspunkte"
+  { constructorTagModifier = intercalate "-" . map toLower . splitCamel
-  display (Normal{..}) = tshow maxPoints <> " Punkte"
+  , fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
-  display (Pass  {..}) = "Bestanden ab " <> tshow (pToI passingPoints) <> " von " <> tshow maxPoints
+  , sumEncoding = TaggedObject "type" "data"  
-  display (NotGraded)  = "Unbewertet"
+  } ''SheetType
-
-deriveJSON defaultOptions ''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 }

src/Utils/Lens.hs

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

templates/correction-user.hamlet

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

templates/mail/submissionRated.hamlet

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

templates/widgets/rating.hamlet

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