fraport/fradrive-old
Archived
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 | PassBinary -- non-zero means passed
deriving (Eq, Read, Show, Generic) deriving (Eq, Read, Show, Generic)
makeLenses_ ''SheetGrading
deriveJSON defaultOptions deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece { constructorTagModifier = camelToPathPiece
, fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel , fieldLabelModifier = intercalate "-" . map toLower . dropEnd 1 . splitCamel
@ -139,14 +137,22 @@ deriveJSON defaultOptions
} ''SheetGrading } ''SheetGrading
derivePersistFieldJSON ''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 :: SheetGrading -> Points -> Maybe Bool
gradingPassed (Points {}) _ = Nothing gradingPassed gr pts = either pBinary pPoints <$> gr ^? _passingBound
gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints where pBinary _ = pts /= 0
gradingPassed (PassBinary {}) pts = Just $ pts /= 0 pPoints b = pts >= b
newtype SheetGradeSummary
data SheetGradeSummary = SheetGradeSummary data SheetGradeSummary = SheetGradeSummary
{ numSheets :: Count -- Total number of sheets, includes all { numSheets :: Count -- Total number of sheets, includes all
, numSheetsPasses :: Count -- Number of sheets required to pass , numSheetsPasses :: Count -- Number of sheets required to pass
@ -172,23 +178,23 @@ instance Semigroup SheetGradeSummary where
makeLenses_ ''SheetGradeSummary makeLenses_ ''SheetGradeSummary
sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
sheetGradeSum gr (Just p) = sheetGradeSum gr Nothing sheetGradeSum gr Nothing = mempty
{ numMarked = 1 { numSheets = 1
, achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p , numSheetsPasses = bool mempty 1 $ has _passingBound gr
, achievedPoints = bool mempty (Sum p) $ has _maxPoints gr , numSheetsPoints = bool mempty 1 $ has _maxPoints gr
} , sumSheetsPoints = maybe mempty Sum $ gr ^? _maxPoints
sheetGradeSum (Points {..}) Nothing = mempty { numSheets = Sum 1 }
, numPointSheets = Sum 1 sheetGradeSum gr (Just p) =
, sumGradePoints = Sum maxPoints let unmarked@SheetGradeSummary{..} = sheetGradeSum gr Nothing
} in unmarked
sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets = Sum 1 { numMarked = numSheets
, numGradePasses = Sum 1 , numMarkedPasses = numSheetsPasses
, numPointSheets = Sum 1 , numMarkedPoints = numSheetsPoints
, sumGradePoints = Sum maxPoints , sumMarkedPoints = sumSheetsPoints
} , achievedPasses = fromMaybe mempty $ bool 0 1 <$> gradingPassed gr p
sheetGradeSum (PassBinary) Nothing = mempty { numSheets = Sum 1 , achievedPoints = bool mempty (Sum p) $ has _maxPoints gr
, numGradePasses = Sum 1 }
}
data SheetType data SheetType
= Normal { grading :: SheetGrading } = Normal { grading :: SheetGrading }