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

ToMarkup instances for StudyDegree and StudyTerms

Browse Source
This commit is contained in:
SJost 2019-02-28 18:28:42 +01:00
parent e446641666
commit cf3a0b3d35
2 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
src/Handler/Utils/Form.hs
View File

@ -215,6 +215,7 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
-- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user) -- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
-- (too many special cases, hence not used in course registration anymore)
studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId) studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
-- we need a join, so we cannot just use optionsPersistCryptoId -- we need a join, so we cannot just use optionsPersistCryptoId

20
src/Model.hs
View File

@ -19,6 +19,8 @@ import Data.Aeson (Value)
import Data.CaseInsensitive (CI) import Data.CaseInsensitive (CI)
import Data.CaseInsensitive.Instances () import Data.CaseInsensitive.Instances ()
import Text.Blaze (ToMarkup, toMarkup, Markup)
import Utils.Message (MessageClass) import Utils.Message (MessageClass)
import Settings.Cluster (ClusterSettingsKey) import Settings.Cluster (ClusterSettingsKey)
@ -41,3 +43,21 @@ deriving instance Binary (Key Term)
submissionRatingDone :: Submission -> Bool submissionRatingDone :: Submission -> Bool
submissionRatingDone Submission{..} = isJust submissionRatingTime 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