allow multiple updates on one day

[the reason for this, rather than just one update listing everything, is
that i can have sfw and nsfw updates and only display the appropriate
one]
This commit is contained in:
Rhiannon Morris 2022-08-17 03:11:56 +02:00
parent 71915ed1ff
commit 2833487f62
2 changed files with 29 additions and 27 deletions

View File

@ -44,7 +44,7 @@ data Info =
-- e.g. multiple things on the same day might have a,b,c in @sortEx@ to
-- put them in the right order in the gallery
sortEx :: !Text,
updates :: ![Update],
updates :: ![(Date, [Update])],
-- | if false, don't show updated emblem even if @updates@ is non-empty
showUpdated :: !Bool,
-- | hide from gallery view
@ -109,7 +109,6 @@ data Link =
data Update =
Update {
date :: !Date,
desc :: !Text,
nsfw :: !Bool,
ignoreSort :: !Bool
@ -143,10 +142,10 @@ instance HasField "sfwLinks" Info [Link] where
instance HasField "nsfwLinks" Info [Link] where
getField = filter #nsfw . #links
instance HasField "sfwUpdates" Info [Update] where
getField = filter #sfw . #updates
instance HasField "nsfwUpdates" Info [Update] where
getField = filter #nsfw . #updates
instance HasField "sfwUpdates" Info [(Date, [Update])] where
getField = filter (not . null) . map (second (filter #sfw)) . #updates
instance HasField "nsfwUpdates" Info [(Date, [Update])] where
getField = filter (not . null) . map (second (filter #nsfw)) . #updates
instance HasField "thumb" Info (Maybe FilePath) where
getField (Info {thumb', images}) =
@ -158,15 +157,15 @@ instance HasField "notMine" Info Bool where getField = isJust . #artist
instance HasField "latestDate" Info (Bool -> Date) where
getField info@(Info {date=date}) nsfw =
maximum $ date : mapMaybe relDate (updatesFor nsfw info)
where relDate (Update {date, ignoreSort}) = date <$ guard (not ignoreSort)
where relDate (date, us) = date <$ guard (not $ any #ignoreSort us)
instance HasField "latestYear" Info (Bool -> Int) where
getField info nsfw = #year $ #latestDate info nsfw
instance HasField "updated" Info (Bool -> Bool) where
getField (Info {updates, showUpdated}) nsfw = showUpdated && updated
where updated = if nsfw then not $ null updates else any #sfw updates
getField (Info {updates, showUpdated}) nsfw = showUpdated && updated where
updated = if nsfw then not $ null updates else any (any #sfw . snd) updates
defDescKey :: Text
defDescKey = "about"
@ -212,7 +211,7 @@ imagesFor nsfw = if nsfw then #images else #sfwImages
linksFor :: Bool -> Info -> [Link]
linksFor nsfw = if nsfw then #links else #sfwLinks
updatesFor :: Bool -> Info -> [Update]
updatesFor :: Bool -> Info -> [(Date, [Update])]
updatesFor nsfw = if nsfw then #updates else #sfwUpdates
compareFor :: Bool -> Info -> Info -> Ordering
@ -346,21 +345,23 @@ instance FromYAML Link where
pure $ Link {title, url, nsfw}
updateList :: Maybe (YAML.Node YAML.Pos) -> YAML.Parser [Update]
updateList :: Maybe (YAML.Node YAML.Pos) -> YAML.Parser [(Date, [Update])]
updateList =
maybe (pure []) $ YAML.withMap "updates" $ traverse asEither . Map.toList
maybe (pure []) $ YAML.withMap "updates" $ traverse bodies . Map.toList
where
asEither (date', rest) = do
date <- parseYAML date'
asDesc date rest <|> asObj date rest
asDesc date = YAML.withStr "desc" \desc ->
pure $ Update {date, desc, nsfw = False, ignoreSort = False}
asObj date = YAML.withMap "update info" \m -> do
bodies (date', rest) = (,) <$> parseYAML date' <*> body rest
body b =
return <$> body1 b
<|> YAML.withSeq "update list" (traverse body1) b
body1 b = asDesc b <|> asObj b
asDesc = YAML.withStr "desc" \desc ->
pure $ Update {desc, nsfw = False, ignoreSort = False}
asObj = YAML.withMap "update info" \m -> do
checkKeys m ["desc", "nsfw", "ignore-sort"]
desc <- m .: "desc"
nsfw <- m .:? "nsfw" .!= False
ignoreSort <- m .:? "ignore-sort" .!= False
pure $ Update {date, desc, nsfw, ignoreSort}
pure $ Update {desc, nsfw, ignoreSort}
data GalleryInfo =

View File

@ -8,7 +8,7 @@ import qualified NsfwWarning
import Control.Exception
import Control.Monad
import Data.List (sort)
import Data.List (sort, intersperse)
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
@ -86,7 +86,7 @@ make' root prefix nsfw _dataDir dir info@(Info {date, title, artist, bg}) = do
Nothing -> "by niss"
let thumb = getThumb "" info
let updateDate = ifJust (last' updates) \(Update {date = d}) ->
let updateDate = ifJust (last' updates) \(d, _) ->
let updated = formatLong d in
[b|<br> <span class=updated>updated $updated</span>|]
@ -286,7 +286,7 @@ extLink (Link {title, url}) = [b|@8
</a>
|]
makeUpdates :: [Update] -> Builder
makeUpdates :: [(Date, [Update])] -> Builder
makeUpdates ups =
if null ups then "" else [b|@4
<section id=updates class=info-section>
@ -296,11 +296,12 @@ makeUpdates ups =
</dl>
</section>
|]
where updateList = map makeUpdate ups
where updateList = map (uncurry makeUpdate) ups
makeUpdate :: Update -> Builder
makeUpdate (Update {date, desc}) = [b|@8
makeUpdate :: Date -> [Update] -> Builder
makeUpdate date ups = [b|@8
<dt>$date'
<dd>$desc
|]
where date' = formatSlash date
|] where
date' = formatSlash date
desc = mconcat $ map fromText $ intersperse "; " $ map #desc ups