diff --git a/make-pages/Date.hs b/make-pages/Date.hs index 7b040a7..ac21944 100644 --- a/make-pages/Date.hs +++ b/make-pages/Date.hs @@ -11,7 +11,6 @@ import qualified Text.ParserCombinators.ReadP as ReadP import Text.ParserCombinators.ReadP (ReadP, readS_to_P, readP_to_S, (<++)) import Data.Time hiding (Day) import Data.Char (isSpace) -import BuilderQQ import Data.Function (on) import Data.Maybe (fromMaybe) import Data.YAML (FromYAML (..)) @@ -19,7 +18,11 @@ import qualified Data.YAML as YAML import Text.Ginger (GVal, ToGVal (..), (~>)) import qualified Text.Ginger as Ginger import qualified Text.Ginger.Html as Ginger -import Data.Text (unpack) +import Data.Text (Text, pack, unpack) +import Data.Text.Lazy (toStrict) +import Data.Text.Lazy.Builder (Builder) +import qualified Data.Text.Lazy.Builder as Builder + data Date = Date {year, month :: Int, day :: Day} deriving (Eq, Ord, Show) @@ -41,50 +44,51 @@ exact :: Day -> Bool exact (Exact _) = True exact _ = False -formatLong :: Date -> Builder +formatLong :: Date -> Text formatLong (Date {year, month, day}) = - case dayN of + toText case dayN of Nothing -> monthYear - Just (nth -> d) -> [b|$approx$weekday $d $monthYear|] + Just (nth -> d) -> mconcat [approx, weekday, " ", d, " ", monthYear] where dayN = dayNum day day' = fromMaybe 1 dayN - formatted str = fromString $ + 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 [b|approx. $&|] + approx = if exact day then "" else "approx. " -formatShort :: Date -> Builder -formatShort (Date {month, day}) = [b|$day'$month'|] where +formatShort :: Date -> Text +formatShort (Date {month, day}) = toText $ day' <> month' where day' = case day of - Exact d -> [b|$d $&|] - Approx d -> [b|$d? $&|] - Unknown -> "" - month' = formatTime defaultTimeLocale "%b" $ fromGregorian 1 month 1 + Exact d -> bshow d <> " " + Approx d -> bshow d <> "? " + Unknown -> mempty + month' = Builder.fromString $ + formatTime defaultTimeLocale "%b" $ fromGregorian 1 month 1 -formatRSS :: Date -> Builder -formatRSS = fromString . format . toTime where +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 -formatSlash :: Date -> Builder -formatSlash (Date {year, month, day}) = case dayNum day of - Nothing -> [b|$year/$month|] - Just d -> [b|$year/$month/$d$q|] - where q = if exact day then "" else [b|?|] +formatSlash :: Date -> Text +formatSlash (Date {year, month, day}) = + toText $ mconcat [bshow year, "/", bshow month, "/", bshow day', bshow ex] + where day' = dayNum day; ex = exact day nth :: Int -> Builder -nth n = [b|$n$suf|] where - suf | n >= 10, n <= 19 = [b|th|] - | n `mod` 10 == 1 = [b|st|] - | n `mod` 10 == 2 = [b|nd|] - | n `mod` 10 == 3 = [b|rd|] - | otherwise = [b|th|] +nth n = bshow n <> suf + where + suf | n >= 10, n <= 19 = "th" + | n `mod` 10 == 1 = "st" + | n `mod` 10 == 2 = "nd" + | n `mod` 10 == 3 = "rd" + | otherwise = "th" parseP :: ReadP Date parseP = do @@ -126,7 +130,13 @@ instance ToGVal m Date where Exact x -> toGVal x Approx x -> toGVal $ show x <> "?" Unknown -> "?" - long = toStrictText $ formatLong d - short = toStrictText $ formatShort d - rss = toStrictText $ formatRSS d - slash = toStrictText $ formatSlash d + long = formatLong d + short = formatShort d + rss = formatRSS d + slash = formatSlash d + +toText :: Builder -> Text +toText = toStrict . Builder.toLazyText + +bshow :: Show a => a -> Builder +bshow = Builder.fromString . show