remove BuilderQQ from Date

This commit is contained in:
Rhiannon Morris 2021-03-20 16:19:56 +01:00
parent 2485e3e234
commit b8970b6436
1 changed files with 40 additions and 30 deletions

View File

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