tweaks in Date

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
+    Exact  !Int
-  | Approx 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
+  approx        = if exact day then "" else "approx. "
   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. "
+  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
+nth n = bshow n <> suf where
- 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
+  dash = void $ ReadP.char '-'
-  option k p = p <++ pure k
+  option k p = p <++ return k
 
 parseS :: ReadS Date
 parseS = readP_to_S parseP