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

Type SheetGradeSummery decided upon

Browse Source
This commit is contained in:
SJost 2018-12-19 13:52:26 +01:00
parent a507c0884f
commit 9ba09c9998
1 changed files with 30 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
src/Model/Types.hs
View File

@ -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 }