This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Model.hs
Sarah Vaupel a6348f9b9c refactor: Replaced DisplayAble by RenderMessage/ToMessage
Removed DisplayAble typeclass; replaced DisplayAble instances by
RenderMessage or ToMessage instances; removed unnecessary tshow calls in
de.msg

Closes #184
2019-07-01 11:48:43 +02:00

67 lines
2.2 KiB
Haskell

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Model
( module Model
, module Model.Types
, module Cron.Types
) where
import Import.NoModel
import Database.Persist.Quasi
import Database.Persist.TH.Directory
-- import Data.Time
-- import Data.ByteString
import Model.Types hiding (_maxPoints, _passingPoints)
import Cron.Types
import Data.Aeson (Value)
import Data.CaseInsensitive (CI)
import Data.CaseInsensitive.Instances ()
import Utils.Message (MessageStatus)
import Settings.Cluster (ClusterSettingsKey)
import Text.Blaze (ToMarkup(..))
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
-- at:
-- http://www.yesodweb.com/book/persistent/
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll'", mkSave "currentModel"]
$(persistDirectoryWith lowerCaseSettings "models")
-- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only; comments helpful for searching in code
deriving instance Eq (Unique Course) -- instance Eq TermSchoolCourseShort; instance Eq TermSchoolCourseName
deriving instance Eq (Unique Sheet) -- instance Eq CourseSheet
deriving instance Eq (Unique Material) -- instance Eq UniqueMaterial
deriving instance Eq (Unique Tutorial) -- instance Eq Tutorial
deriving instance Eq (Unique Exam)
instance Ord User where
compare User{userSurname=surnameA, userDisplayName=displayNameA, userEmail=emailA}
User{userSurname=surnameB, userDisplayName=displayNameB, userEmail=emailB}
= compare surnameA surnameB
<> compare displayNameA displayNameB
<> compare emailA emailB -- userEmail is unique, so this suffices
submissionRatingDone :: Submission -> Bool
submissionRatingDone Submission{..} = isJust submissionRatingTime
-- ToMarkup instances for displaying certain database primary keys
-- TODO: work in progress, populate with more instances
-- TODO: is there a better place for this?
instance ToMarkup (Key School) where
toMarkup = toMarkup . unSchoolKey
instance ToMarkup (Key Term) where
toMarkup = toMarkup . termToText . unTermKey
-- TODO: unfinished
-- instance ToMarkup (Key Submission) where
-- toMarkup = toMarkup . unSubmissionKey