From d33956dfaabd67a2b2d9eea7d011ef612cf96bd4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 29 Jun 2018 16:13:36 +0200
Subject: [PATCH] Fix database representation of term for correct sorting

---
 fill-db.hs         |  6 ------
 src/Model/Types.hs | 22 +++++++++++++++++++---
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/fill-db.hs b/fill-db.hs
index 725718792..cc3dbe804 100755
--- a/fill-db.hs
+++ b/fill-db.hs
@@ -95,7 +95,6 @@ main = db $ do
     , courseTerm = TermKey summer2018
     , courseSchool = ifi
     , courseCapacity = Just 20
-    , courseHasRegistration = True
     , courseRegisterFrom = Just now
     , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now )
     , courseDeregisterUntil = Nothing
@@ -122,7 +121,6 @@ main = db $ do
     , courseTerm = TermKey summer2017
     , courseSchool = ifi
     , courseCapacity = Just 20
-    , courseHasRegistration = False
     , courseRegisterFrom = Nothing
     , courseRegisterTo = Nothing
     , courseDeregisterUntil = Nothing
@@ -141,7 +139,6 @@ main = db $ do
     , courseTerm = TermKey summer2018
     , courseSchool = ifi
     , courseCapacity = Just 20
-    , courseHasRegistration = True
     , courseRegisterFrom = Just now
     , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now )
     , courseDeregisterUntil = Nothing
@@ -160,7 +157,6 @@ main = db $ do
     , courseTerm = TermKey winter2017
     , courseSchool = ifi
     , courseCapacity = Just 30
-    , courseHasRegistration = False
     , courseRegisterFrom = Nothing
     , courseRegisterTo = Nothing
     , courseDeregisterUntil = Nothing
@@ -179,7 +175,6 @@ main = db $ do
     , courseTerm = TermKey summer2017
     , courseSchool = ifi
     , courseCapacity = Just 50
-    , courseHasRegistration = False
     , courseRegisterFrom = Nothing
     , courseRegisterTo = Nothing
     , courseDeregisterUntil = Nothing
@@ -198,7 +193,6 @@ main = db $ do
     , courseTerm = TermKey summer2018
     , courseSchool = ifi
     , courseCapacity = Just 50
-    , courseHasRegistration = False
     , courseRegisterFrom = Nothing
     , courseRegisterTo = Nothing
     , courseDeregisterUntil = Nothing
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index 8f18ed629..a269d1493 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -161,14 +161,30 @@ termFromText t
   , Right season <- seasonFromChar s
   = Right TermIdentifier{..}
   | otherwise = Left $ "Invalid TermIdentifier: “" <> t <> "”"
+
+termToRational :: TermIdentifier -> Rational
+termToRational TermIdentifier{..} = fromInteger year + seasonOffset
+  where
+    seasonOffset
+      | Summer <- season = 0
+      | Winter <- season = 0.5
+
+termFromRational :: Rational -> TermIdentifier
+termFromRational n = TermIdentifier{..}
+  where
+    year = floor n
+    remainder = n - (fromInteger $ floor n)
+    season
+      | remainder == 0 = Summer
+      | otherwise      = Winter
   
 instance PersistField TermIdentifier where
-  toPersistValue = PersistText . termToText
-  fromPersistValue (PersistText t) = termFromText t
+  toPersistValue = PersistRational . termToRational
+  fromPersistValue (PersistRational t) = Right $ termFromRational t
   fromPersistValue x = Left $ "Expected TermIdentifier, received: " <> tshow x
 
 instance PersistFieldSql TermIdentifier where
-  sqlType _ = SqlString
+  sqlType _ = SqlNumeric 5 1
 
 instance ToHttpApiData TermIdentifier where
   toUrlPiece = termToText