Fixes unformatted UTCTime displays; DisplayAble no longer available for all Show Types

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
 

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

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

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{..}

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}