add support for approx dates

This commit is contained in:
Rhiannon Morris 2020-09-25 23:08:44 +02:00
parent 1cfb65eae9
commit 8d4ff29e56
8 changed files with 141 additions and 65 deletions

View file

@ -1,5 +1,6 @@
module SinglePage (make) where
import Date
import Info
import BuilderQQ
import Records ()
@ -9,7 +10,6 @@ import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Time as Time
import System.FilePath (joinPath, splitPath, (</>))
import qualified System.Process as Proc
import Text.Read (readMaybe)
@ -43,7 +43,7 @@ make' root prefix nsfw dataDir dir
let artistTag = ifJust artist makeArtist
let formattedDate = formatDate date
let formattedDate = formatLong date
let buttonBar = makeButtonBar title images
let (image0@(Image {path = path0, download = download0'}),
@ -79,7 +79,7 @@ make' root prefix nsfw dataDir dir
Nothing -> "by niss"
let thumb = getThumb "" info
let updateDate = ifJust (Map.lookupMax updates) \(formatDate -> u, _) ->
let updateDate = ifJust (Map.lookupMax updates) \(formatLong -> u, _) ->
[b|<br> <span class=updated>updated $u</span>|]
pure [b|@0
@ -227,7 +227,7 @@ extLink (Link {title, url}) = [b|@8
</a>
|]
makeUpdates :: [(Day, Text)] -> Builder
makeUpdates :: [(Date, Text)] -> Builder
makeUpdates ups =
if null ups then "" else [b|@4
<section id=updates class=info-section>
@ -239,31 +239,12 @@ makeUpdates ups =
|]
where updateList = map (uncurry makeUpdate) ups
makeUpdate :: Day -> Text -> Builder
makeUpdate :: Date -> Text -> Builder
makeUpdate date txt = [b|@8
<dt>$date'
<dd>$txt
|]
where date' = Time.formatTime Time.defaultTimeLocale "%-d/%-m/%Y" date
formatDate :: Day -> Builder
formatDate date = [b|$week $day $month $year|] where
(year, month', day') = Time.toGregorian date
week' = Time.dayOfWeek date
day = nth day'
month = Strict.words "january february march april may june july \
\august september october november december"
!! (month' - 1)
week = Strict.words "mon tue wed thu fri sat sun" !! (fromEnum week' - 1)
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|]
where date' = formatSlash date
data Size = Size {width, height :: !Int} deriving (Eq, Show)