From c684692cc2cba223094a692b1d485d21675c02d2 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Mon, 17 Sep 2018 15:35:14 +0200
Subject: [PATCH] Fixes unformatted UTCTime displays; DisplayAble no longer
 available for all Show Types

---
 src/Handler/Utils/DateTime.hs    |  9 +++++++--
 src/Model/Types.hs               |  6 ++++++
 src/Utils.hs                     | 13 +++++++++++++
 templates/correction-user.hamlet |  2 +-
 templates/profile.hamlet         |  4 ++--
 5 files changed, 29 insertions(+), 5 deletions(-)

diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs
index c9d465366..47d28686d 100644
--- a/src/Handler/Utils/DateTime.hs
+++ b/src/Handler/Utils/DateTime.hs
@@ -8,8 +8,7 @@
 module Handler.Utils.DateTime
   ( utcToLocalTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)
-  , formatTime'
-  , formatTime
+  , formatTime, formatTime', formatTimeW
   , getTimeLocale, getDateTimeFormat
   , validDateTimeFormats, dateTimeFormatOptions
   ) where
@@ -51,6 +50,12 @@ formatTime' fmtStr t = fmap fromString $ Time.formatTime <$> getTimeLocale <*> p
 formatTime :: (HasLocalTime t, MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> t -> m Text
 formatTime proj t = flip formatTime' t =<< (unDateTimeFormat <$> getDateTimeFormat proj)
 
+-- formatTimeH :: (HasLocalTime t) => SelDateTimeFormat -> t -> Handler Text
+-- formatTimeH = formatTime
+
+formatTimeW :: (HasLocalTime t) => SelDateTimeFormat -> t -> Widget
+formatTimeW s t = toWidget =<< formatTime s t
+
 getTimeLocale :: (MonadHandler m, HandlerSite m ~ UniWorX) => m TimeLocale
 getTimeLocale = getTimeLocale' <$> languages
 
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index a84f6ba7a..21f6d4abb 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -88,6 +88,8 @@ pToI = fromPoints
 fromPoints :: Integral a => Points -> a -- deprecated
 fromPoints = round
 
+instance DisplayAble Points
+
 data SheetType
   = Bonus  { maxPoints :: Points }
   | Normal { maxPoints :: Points }
@@ -237,6 +239,8 @@ seasonFromChar c
   where
     (~=) = (==) `on` CI.mk
 
+instance DisplayAble Season
+
 data TermIdentifier = TermIdentifier
   { year :: Integer -- ^ Using 'Integer' to model years is consistent with 'Data.Time.Calendar'
   , season :: Season
@@ -337,6 +341,8 @@ data StudyFieldType = FieldPrimary | FieldSecondary
   deriving (Eq, Ord, Enum, Show, Read, Bounded)
 derivePersistField "StudyFieldType"
 
+instance DisplayAble StudyFieldType
+
 data Theme
   = ThemeDefault
   | ThemeLavender
diff --git a/src/Utils.hs b/src/Utils.hs
index b0671d4af..1d1b1bcde 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, UndecidableInstances #-}
@@ -128,6 +129,9 @@ withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >>
 -- Convert anything to Text, and I don't care how
 class DisplayAble a where
   display :: a -> Text
+  -- Default definitions for type belonging to Show (allows empty instanc declarations)
+  default display :: Show a => a -> Text
+  display = pack . show
 
 instance DisplayAble Text where
   display = id
@@ -139,6 +143,10 @@ instance DisplayAble a => DisplayAble (Maybe a) where
   display Nothing  = ""
   display (Just x) = display x
 
+instance DisplayAble Int
+instance DisplayAble Int64
+instance DisplayAble Integer
+
 instance DisplayAble Rational where
   display r = showFFloat (Just 2) (rat2float r) ""
       & pack
@@ -154,10 +162,15 @@ instance DisplayAble a => DisplayAble (E.Value a) where
 instance DisplayAble a => DisplayAble (CI a) where
   display = display . CI.original
 
+{- We do not want DisplayAble for every Show-Class, we want to check that it looks good and explicitely add Instances only,
+   for example, UTCTime values were shown without proper rendering!
+
 -- The easy way out of UndecidableInstances (TypeFamilies would have been proper, but are much more complicated)
 instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where
   display = pack . show
 
+-}
+
 textPercent :: Double -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
 textPercent x = lz <> (pack $ show rx) <> "%"
  where
diff --git a/templates/correction-user.hamlet b/templates/correction-user.hamlet
index 5b1086511..d0b8976e2 100644
--- a/templates/correction-user.hamlet
+++ b/templates/correction-user.hamlet
@@ -10,7 +10,7 @@
     $maybe time <- submissionRatingTime
       <tr .table__row>
         <th .table__th>_{MsgRatingTime}
-        <td .table__td>#{display time}
+        <td .table__td>^{formatTimeW SelFormatDateTime time}
     $maybe points <- submissionRatingPoints
       $case sheetType
         $of Bonus{..}
diff --git a/templates/profile.hamlet b/templates/profile.hamlet
index 51cbc913c..44116dc60 100644
--- a/templates/profile.hamlet
+++ b/templates/profile.hamlet
@@ -59,10 +59,10 @@
       <dt .deflist__dt> Teilnehmer
       <dd .deflist__dd>
         <dl .deflist>
-          $forall (E.Value tid, E.Value ssh, E.Value csh, regSince) <- participant
+          $forall (E.Value tid, E.Value ssh, E.Value csh, E.Value regSince) <- participant
             <dt .deflist__dt>
                 <a href=@{CourseR tid ssh csh CShowR}>#{display tid}-#{display ssh}-#{display csh}
             <dd .deflist__dd>
-                seit #{display regSince}
+                seit ^{formatTimeW SelFormatDateTime regSince}
 
   ^{settingsForm}