From 92b198afce72c7fdc16d1874954980e2df5f0ad7 Mon Sep 17 00:00:00 2001
From: Rhiannon Morris <rhi@rhiannon.website>
Date: Sat, 20 Mar 2021 16:38:20 +0100
Subject: [PATCH] tweaks in Date

---
 make-pages/Date.hs | 41 +++++++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 20 deletions(-)

diff --git a/make-pages/Date.hs b/make-pages/Date.hs
index ac21944..efe9775 100644
--- a/make-pages/Date.hs
+++ b/make-pages/Date.hs
@@ -12,6 +12,7 @@ import Text.ParserCombinators.ReadP (ReadP, readS_to_P, readP_to_S, (<++))
 import Data.Time hiding (Day)
 import Data.Char (isSpace)
 import Data.Function (on)
+import Data.Functor
 import Data.Maybe (fromMaybe)
 import Data.YAML (FromYAML (..))
 import qualified Data.YAML as YAML
@@ -24,12 +25,12 @@ import Data.Text.Lazy.Builder (Builder)
 import qualified Data.Text.Lazy.Builder as Builder
 
 
-data Date = Date {year, month :: Int, day :: Day}
+data Date = Date {year, month :: !Int, day :: !Day}
   deriving (Eq, Ord, Show)
 
 data Day =
-    Exact  Int
-  | Approx Int
+    Exact  !Int
+  | Approx !Int
   | Unknown
   deriving (Eq, Show)
 
@@ -50,14 +51,13 @@ formatLong (Date {year, month, day}) =
     Nothing         -> monthYear
     Just (nth -> d) -> mconcat [approx, weekday, " ", d, " ", monthYear]
  where
-  dayN = dayNum day
-  day' = fromMaybe 1 dayN
-  formatted str = Builder.fromString $
-    formatTime defaultTimeLocale str $
-    fromGregorian (toInteger year) month day'
-  monthYear = formatted "%B %Y"
-  weekday = formatted "%a"
-  approx = if exact day then "" else "approx. "
+  approx        = if exact day then "" else "approx. "
+  dayN          = dayNum day
+  day'          = fromMaybe 1 dayN
+  monthYear     = formatted "%B %Y"
+  weekday       = formatted "%a"
+  greg          = fromGregorian (toInteger year) month day'
+  formatted str = Builder.fromString $ formatTime defaultTimeLocale str greg
 
 formatShort :: Date -> Text
 formatShort (Date {month, day}) = toText $ day' <> month' where
@@ -72,8 +72,10 @@ formatRSS :: Date -> Text
 formatRSS = pack . format . toTime where
   format = formatTime defaultTimeLocale "%a, %d %b %_Y %T GMT"
   toTime (Date {year, month, day}) =
-    let year' = toInteger year; day' = fromMaybe 1 $ dayNum day in
     UTCTime (fromGregorian year' month day') 15600
+   where
+    year' = toInteger year
+    day'  = fromMaybe 1 $ dayNum day
 
 formatSlash :: Date -> Text
 formatSlash (Date {year, month, day}) =
@@ -82,8 +84,7 @@ formatSlash (Date {year, month, day}) =
 
 
 nth :: Int -> Builder
-nth n = bshow n <> suf
- where
+nth n = bshow n <> suf where
   suf | n >= 10, n <= 19 = "th"
       | n `mod` 10 == 1  = "st"
       | n `mod` 10 == 2  = "nd"
@@ -93,18 +94,18 @@ nth n = bshow n <> suf
 parseP :: ReadP Date
 parseP = do
   year <- readp
-  char_ '-'
+  dash
   month <- readp
   day <- option Unknown do
-    char_ '-'
+    dash
     d <- readp
-    approx <- option Exact (Approx <$ ReadP.char '?')
+    approx <- option Exact $ ReadP.char '?' $> Approx
     pure $ approx d
-  pure $ Date year month day
+  pure $ Date {year, month, day}
  where
   readp = readS_to_P reads
-  char_ c = () <$ ReadP.char c
-  option k p = p <++ pure k
+  dash = void $ ReadP.char '-'
+  option k p = p <++ return k
 
 parseS :: ReadS Date
 parseS = readP_to_S parseP