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

add image descriptions/alt text

Browse source
This commit is contained in:
rhiannon morris 2024-10-21 14:24:17 +02:00
parent 9d0b1a5eb3
commit 18629cb220
5 changed files with 29 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

19
make-pages/Info.hs
View file

@ -105,6 +105,7 @@ data Image =
label :: !Text,
path :: !FilePath,
download :: !(Maybe FilePath),
desc :: !Text,
nsfw :: !Bool,
warning :: !(Maybe Text),
resize :: !Bool
@ -369,17 +370,18 @@ unlabelledImage' label' y = asStr y <|> asObj y
where
asStr = YAML.withStr "path" \(Text.unpack -> path) ->
let label = fromMaybe (pathToLabel path) label' in
pure $ Image {label, path, download = Nothing,
pure $ Image {label, path, download = Nothing, desc = "",
nsfw = False, warning = Nothing, resize = True}
asObj = YAML.withMap "image info" \m -> do
checkKeys m ["path", "download", "nsfw", "warning", "resize"]
checkKeys m ["path", "download", "desc", "nsfw", "warning", "resize"]
path <- m .: "path"
download <- m .:? "download"
desc <- m .:? "desc" .!= ""
nsfw <- m .:? "nsfw" .!= False
warning <- m .:? "warning"
resize <- m .:? "resize" .!= True
let label = fromMaybe (pathToLabel path) label'
pure $ Image {label, path, download, nsfw, warning, resize}
pure $ Image {label, path, download, nsfw, warning, desc, resize}
pathToLabel = Text.pack . gapToSpace . takeBaseName
gapToSpace = map \case '-' -> ' '; '_' -> ' '; c -> c
@ -407,14 +409,13 @@ instance FromYAML Link where
updateList :: Maybe (YAML.Node YAML.Pos) ->
YAML.Parser [(Date, NonEmpty Update)]
updateList =
maybe (pure []) $ YAML.withMap "updates" $
nonEmptys <=< traverse bodies . Map.toList
maybe (pure []) $ YAML.withMap "updates" $ traverse bodies . Map.toList
where
bodies (date', rest) = (,) <$> parseYAML date' <*> body rest
body b =
return <$> body1 b
<|> YAML.withSeq "update list" (traverse body1) b
body b = return <$> body1 b <|> YAML.withSeq "update list" (bodyN b) b
body1 b = asDesc b <|> asObj b
bodyN y =
maybe (YAML.typeMismatch "non-empty list" y) (traverse body1) . nonEmpty
asDesc = YAML.withStr "desc" \desc ->
pure $ Update {desc, nsfw = False, ignoreSort = False}
asObj = YAML.withMap "update info" \m -> do
@ -423,8 +424,6 @@ updateList =
nsfw <- m .:? "nsfw" .!= False
ignoreSort <- m .:? "ignore-sort" .!= False
pure $ Update {desc, nsfw, ignoreSort}
nonEmptys = traverse $ traverse $
maybe (fail "expected non-empty list") pure . nonEmpty
data GalleryInfo =