From cf3a0b3d352d04df1b0bc3e60fdbcaf08d2b2812 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 28 Feb 2019 18:28:42 +0100
Subject: [PATCH] ToMarkup instances for StudyDegree and StudyTerms

---
 src/Handler/Utils/Form.hs |  1 +
 src/Model.hs              | 20 ++++++++++++++++++++
 2 files changed, 21 insertions(+)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 708b2bb40..1736f844f 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -215,6 +215,7 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 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)
+-- (too many special cases, hence not used in course registration anymore)
 studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
 studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
     -- we need a join, so we cannot just use optionsPersistCryptoId
diff --git a/src/Model.hs b/src/Model.hs
index 54acc1b28..f070b082b 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -19,6 +19,8 @@ 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)
 
@@ -41,3 +43,21 @@ 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