rhi/gallery
1
0
Fork 0
Code Issues 5 Pull requests 1 Releases Wiki Activity

tweaks in Date

Browse source
This commit is contained in:
Rhiannon Morris 2021-03-20 16:38:20 +01:00
parent b8970b6436
commit 92b198afce
1 changed files with 21 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
make-pages/Date.hs
View file

@ -12,6 +12,7 @@ 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 Data.Function (on) import Data.Function (on)
import Data.Functor
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.YAML (FromYAML (..)) import Data.YAML (FromYAML (..))
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
@ -24,12 +25,12 @@ import Data.Text.Lazy.Builder (Builder)
import qualified Data.Text.Lazy.Builder as 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)
data Day = data Day =
Exact Int Exact !Int
| Approx Int | Approx !Int
| Unknown | Unknown
deriving (Eq, Show) deriving (Eq, Show)
@ -50,14 +51,13 @@ formatLong (Date {year, month, day}) =
Nothing -> monthYear Nothing -> monthYear
Just (nth -> d) -> mconcat [approx, weekday, " ", d, " ", monthYear] Just (nth -> d) -> mconcat [approx, weekday, " ", d, " ", monthYear]
where where
dayN = dayNum day approx = if exact day then "" else "approx. "
day' = fromMaybe 1 dayN dayN = dayNum day
formatted str = Builder.fromString $ day' = fromMaybe 1 dayN
formatTime defaultTimeLocale str $ monthYear = formatted "%B %Y"
fromGregorian (toInteger year) month day' weekday = formatted "%a"
monthYear = formatted "%B %Y" greg = fromGregorian (toInteger year) month day'
weekday = formatted "%a" formatted str = Builder.fromString $ formatTime defaultTimeLocale str greg
approx = if exact day then "" else "approx. "
formatShort :: Date -> Text formatShort :: Date -> Text
formatShort (Date {month, day}) = toText $ day' <> month' where formatShort (Date {month, day}) = toText $ day' <> month' where
@ -72,8 +72,10 @@ formatRSS :: Date -> Text
formatRSS = pack . 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
UTCTime (fromGregorian year' month day') 15600 UTCTime (fromGregorian year' month day') 15600
where
year' = toInteger year
day' = fromMaybe 1 $ dayNum day
formatSlash :: Date -> Text formatSlash :: Date -> Text
formatSlash (Date {year, month, day}) = formatSlash (Date {year, month, day}) =
@ -82,8 +84,7 @@ formatSlash (Date {year, month, day}) =
nth :: Int -> Builder nth :: Int -> Builder
nth n = bshow n <> suf nth n = bshow n <> suf where
where
suf | n >= 10, n <= 19 = "th" suf | n >= 10, n <= 19 = "th"
| n `mod` 10 == 1 = "st" | n `mod` 10 == 1 = "st"
| n `mod` 10 == 2 = "nd" | n `mod` 10 == 2 = "nd"
@ -93,18 +94,18 @@ nth n = bshow n <> suf
parseP :: ReadP Date parseP :: ReadP Date
parseP = do parseP = do
year <- readp year <- readp
char_ '-' dash
month <- readp month <- readp
day <- option Unknown do day <- option Unknown do
char_ '-' dash
d <- readp d <- readp
approx <- option Exact (Approx <$ ReadP.char '?') approx <- option Exact $ ReadP.char '?' $> Approx
pure $ approx d pure $ approx d
pure $ Date year month day pure $ Date {year, month, day}
where where
readp = readS_to_P reads 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 :: ReadS Date
parseS = readP_to_S parseP parseS = readP_to_S parseP