diff --git a/src/Model/Types.hs b/src/Model/Types.hs index b5d761046..3ad4a0868 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -85,6 +85,19 @@ data Load -- = ByTutorial { countsToLoad :: Bool } | ByProportion { load :: Rati deriving (Show, Read, Eq) derivePersistField "Load" +instance Semigroup Load where + (Load byTut prop) <> (Load byTut' prop') = Load byTut'' (prop + prop') + where + byTut'' + | Nothing <- byTut = byTut' + | Nothing <- byTut' = byTut + | Just a <- byTut + , Just b <- byTut' = Just $ a || b + +instance Monoid Load where + mempty = Load Nothing 0 + mappend = (<>) + {- Use (is _ByTutorial) instead of this unneeded definition: isByTutorial :: Load -> Bool isByTutorial (ByTutorial {}) = True