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 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|<span class=q>?</span>|]
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