63 lines
2.0 KiB
Haskell
63 lines
2.0 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
|
|
module Model
|
|
( module Model
|
|
, module Model.Types
|
|
, module Cron.Types
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod
|
|
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 Text.Blaze (ToMarkup, toMarkup, Markup)
|
|
|
|
import Utils.Message (MessageClass)
|
|
import Settings.Cluster (ClusterSettingsKey)
|
|
|
|
import Data.Binary (Binary)
|
|
|
|
-- 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
|
|
deriving instance Eq (Unique Course)
|
|
deriving instance Eq (Unique Sheet)
|
|
|
|
-- Primary keys mentioned in dbtable row-keys must be Binary
|
|
-- Automatically generated (i.e. numeric) ids are already taken care of
|
|
deriving instance Binary (Key Term)
|
|
|
|
submissionRatingDone :: Submission -> Bool
|
|
submissionRatingDone Submission{..} = isJust submissionRatingTime
|
|
|
|
-- Do these instances belong here?
|
|
instance ToMarkup StudyDegree where
|
|
toMarkup StudyDegree{..} = toMarkup $
|
|
fromMaybe (tshow studyDegreeKey) (studyDegreeName <|> studyDegreeShorthand)
|
|
|
|
shortStudyDegree :: StudyDegree -> Markup
|
|
shortStudyDegree StudyDegree{..} = toMarkup $
|
|
fromMaybe (tshow studyDegreeKey) studyDegreeShorthand
|
|
|
|
instance ToMarkup StudyTerms where
|
|
toMarkup StudyTerms{..} = toMarkup $
|
|
fromMaybe (tshow studyTermsKey) (studyTermsName <|> studyTermsShorthand)
|
|
|
|
shortStudyTerms :: StudyTerms -> Markup
|
|
shortStudyTerms StudyTerms{..} = toMarkup $
|
|
fromMaybe (tshow studyTermsKey) studyTermsShorthand
|