SheetGradeSummary Refactor Attempt1

messages/uniworx/de.msg

@@ -69,7 +69,7 @@ CourseSemester: Semester
 CourseSchool: Institut
 CourseSchoolShort: Fach
 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
 CourseDeregisterUntilTip: Abmeldung darf auch ohne Begrenzung möglich sein
 CourseFilterSearch: Volltext-Suche

src/Handler/Corrections.hs

@@ -252,7 +252,6 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d
               E.orderBy [E.asc $ user E.^. UserSurname]
               E.limit 1
               return (user E.^. UserSurname)
-
         )
       ]
     , dbtFilter    = Map.fromList

src/Handler/Sheet.hs

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

src/Model/Types.hs

@@ -109,7 +109,7 @@ instance FromJSON a => FromJSON (E.Value a) where
   parseJSON = fmap E.Value . parseJSON
 
 
-
+type Count  = Sum Integer
 type Points = Centi
 
 toPoints :: Integral a => a -> Points -- deprecated
@@ -130,6 +130,8 @@ data SheetGrading
   | PassBinary -- non-zero means passed
   deriving (Eq, Read, Show, Generic)
 
+makeLenses_ ''SheetGrading
+
 deriveJSON defaultOptions
   { constructorTagModifier = camelToPathPiece
   , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel
@@ -143,11 +145,15 @@ gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints
 gradingPassed (PassBinary {}) pts = Just $ pts /= 0
 
 data SheetGradeSummary = SheetGradeSummary
-  { numSheets      :: Sum Int
+  { numSheets                             -- Total number of sheets, includes all
-  , numGradePasses :: Sum Int
+  , numGradePasses                        -- Number of sheets required to pass
-  , sumGradePoints :: Sum Points
+  , numPointSheets                        -- Number of sheets having points
-  , achievedPasses :: Maybe (Sum Int)
+  , numMarked      :: Count               -- Number of already marked sheets
-  , achievedPoints :: Maybe (Sum Points)
+  , numMarkedPoints:: Count               -- Number of already marked sheets
+  , numMarkedPasses:: Count               -- Number of already marked sheets
+  , sumGradePoints :: Sum Points          -- Total of achievable points
+  , achievedPasses :: Count               --
+  , achievedPoints :: Sum Points          --
   } deriving (Generic, Read, Show, Eq)
 
 instance Monoid SheetGradeSummary where
@@ -160,15 +166,18 @@ instance Semigroup SheetGradeSummary where
 makeLenses_ ''SheetGradeSummary
 
 sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
-sheetGradeSum gr (Just p) =
+sheetGradeSum gr (Just p) = sheetGradeSum gr Nothing
-  let baseSum = (sheetGradeSum gr Nothing) { achievedPasses = Sum . bool 0 1 <$> gradingPassed gr p }
+    { numMarked = 1
-  in case gr of PassBinary -> baseSum
+    , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p
-                _other     -> baseSum { achievedPoints = Just $ Sum $ p }
+    , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr
+    }
 sheetGradeSum (Points {..})    Nothing = mempty { numSheets      = Sum 1
+                                                , numPointSheets = Sum 1
                                                 , sumGradePoints = Sum maxPoints
                                                 }
 sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets      = Sum 1
                                                 , numGradePasses = Sum 1
+                                                , numPointSheets = Sum 1
                                                 , sumGradePoints = Sum maxPoints
                                                 }
 sheetGradeSum (PassBinary)     Nothing = mempty { numSheets      = Sum 1

templates/widgets/gradingSummary.hamlet

@@ -1,4 +1,8 @@
 $# Displays gradings Summary for various purposes
+$# Expects several variables:
+$#  hasPassing :: Maybe Int    -- Should Passing be displayed?
+$#  hasPoints  :: Maybe Points -- Should Points  be displayed?
+$#  summary    :: SheetGradeSummary -- summary to display
 $# --
 <div>
   <h3>_{title $ getSum $ numSheets $ sumSummaries}

templates/widgets/gradingSummaryRow.hamlet

@@ -1,7 +1,7 @@
 $# Displays one row of the grading summary
 $# Expects several variables:
 $#  hasPassing :: Maybe Int    -- Should Passing be displayed?
-$#  hasPoints  :: Maybe Poibts -- Should Points  be displayed?
+$#  hasPoints  :: Maybe Points -- Should Points  be displayed?
 $#  summary    :: SheetGradeSummary -- summary to display
 $#  sumHeader  :: UniWorXMessage    -- row header
 $#