remove BuilderQQ from Date
This commit is contained in:
parent
2485e3e234
commit
b8970b6436
1 changed files with 40 additions and 30 deletions
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue