From 9ba09c999835ebc50830e97f7d9a2414e4003d5a Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Wed, 19 Dec 2018 13:52:26 +0100
Subject: [PATCH] Type SheetGradeSummery decided upon

---
 src/Model/Types.hs | 54 +++++++++++++++++++++++++---------------------
 1 file changed, 30 insertions(+), 24 deletions(-)

diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index fde3ced5c..56743ac54 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -130,8 +130,6 @@ 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
@@ -139,14 +137,22 @@ deriveJSON defaultOptions
   } ''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 (Points {}) _ = Nothing
-gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints
-gradingPassed (PassBinary {}) pts = Just $ pts /= 0
+gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
+    where pBinary _ = pts /= 0
+          pPoints b = pts >= b
 
 
-newtype SheetGradeSummary
-
 data SheetGradeSummary = SheetGradeSummary
   { numSheets       :: Count               -- Total number of sheets, includes all
   , numSheetsPasses :: Count               -- Number of sheets required to pass
@@ -172,23 +178,23 @@ instance Semigroup SheetGradeSummary where
 makeLenses_ ''SheetGradeSummary
 
 sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
-sheetGradeSum gr (Just p) = sheetGradeSum gr Nothing
-    { numMarked = 1
-    , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr 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
-                                                , numGradePasses = Sum 1
-                                                }
+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) =
+  let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
+  in  unmarked
+        { numMarked       = numSheets
+        , numMarkedPasses = numSheetsPasses
+        , numMarkedPoints = numSheetsPoints
+        , sumMarkedPoints = sumSheetsPoints
+        , achievedPasses  = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p
+        , achievedPoints  = bool mempty (Sum p) $ has _maxPoints gr
+        }
+
 
 data SheetType
   = Normal        { grading :: SheetGrading }