From c7312e8ec662eea25dd7f8d6ff36c28af890ec59 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <vaupel.sarah@campus.lmu.de>
Date: Wed, 3 Jul 2019 11:15:03 +0200
Subject: [PATCH] fix(displayable): fixed faulty display of db keys (SchoolId,
 TermId)

---
 src/Foundation.hs |  6 ------
 src/Model.hs      | 13 +++++++++----
 src/Utils.hs      |  9 ++++++---
 3 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 3c390cce8..dae8095fc 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -349,12 +349,6 @@ instance HasResolution a => ToMessage (Fixed a) where
 --   toMessage = toMessage . fromRational'
 --     where fromRational' = fromRational :: Rational -> Fixed E3
 
--- ToMessage instances for *selected* database IDs
-instance ToMessage TermId where
-  toMessage = tshow
-instance ToMessage SchoolId where
-  toMessage = tshow
-
 
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
diff --git a/src/Model.hs b/src/Model.hs
index 787bf9b77..c97b1a68e 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -16,7 +16,7 @@ import Cron.Types
 
 import Data.Aeson (Value)
 
-import Data.CaseInsensitive (CI)
+import Data.CaseInsensitive (CI, original)
 import Data.CaseInsensitive.Instances ()
 
 import Utils.Message (MessageStatus)
@@ -52,11 +52,16 @@ instance Ord User where
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
 
--- ToMarkup instances for displaying certain database primary keys
--- TODO: is there a better place for this?
+-- ToMarkup and ToMessage instances for displaying selected database primary keys
 
 instance ToMarkup (Key School) where
   toMarkup = toMarkup . unSchoolKey
 
+instance ToMessage (Key School) where
+  toMessage = original . unSchoolKey
+
 instance ToMarkup (Key Term) where
-  toMarkup = toMarkup . termToText . unTermKey
\ No newline at end of file
+  toMarkup = toMarkup . termToText . unTermKey
+
+instance ToMessage (Key Term) where
+  toMessage = termToText . unTermKey
\ No newline at end of file
diff --git a/src/Utils.hs b/src/Utils.hs
index 18b06229e..6096851e2 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -251,8 +251,11 @@ str2widget s = [whamlet|#{s}|]
 withFragment :: Monad m => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
 withFragment form html = flip fmap form $ over _2 (toWidget html >>)
 
+rationalToFixed :: forall a. HasResolution a => Rational -> Fixed a
+rationalToFixed = MkFixed . round . (* (fromIntegral $ resolution (Proxy :: HasResolution a => Proxy a)))
+
 rationalToFixed3 :: Rational -> Fixed E3
-rationalToFixed3 = fromRational
+rationalToFixed3 = rationalToFixed
 
 -- | Convert `part` and `whole` into percentage including symbol
 --   showing trailing zeroes and to decimal digits
@@ -270,8 +273,8 @@ textPercent' trailZero precision part whole
     | precision == 4 = showPercent (frac :: Micro)
     | otherwise      = showPercent (frac :: Pico)
   where
-    frac :: forall a . HasResolution a => Fixed a
-    frac = MkFixed $ round $ (* (fromInteger $ resolution (Proxy :: Proxy a)))  $ (100*) $ toRational part / toRational whole
+    frac :: forall a. HasResolution a => Fixed a
+    frac = rationalToFixed $ (100*) $ toRational part / toRational whole
 
     showPercent :: HasResolution a => Fixed a -> Text
     showPercent f = pack $ showFixed trailZero f <> "%"