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

allow single image (non-list) for images field

Browse source
This commit is contained in:
Rhiannon Morris 2020-07-18 11:29:07 +02:00
parent 9b9f955e65
commit e7af795f7f
1 changed files with 20 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
make-pages/Info.hs
View file

@ -95,7 +95,7 @@ instance FromYAML Info where
<*> m .:? "tags" .!= []
<*> m .:? "nsfw-tags" .!= []
<*> m .:? "description"
<*> m .: "images"
<*> (m .: "images" >>= imageList)
<*> m .:? "background"
<*> m .:? "thumb"
<*> m .:? "links" .!= []
@ -106,18 +106,26 @@ instance FromYAML Artist where
withUrl = YAML.withMap "full info" \m ->
Artist <$> m .: "name" <*> m .:? "url"
imageList :: YAML.Node YAML.Pos -> YAML.Parser [Image]
imageList y = pure <$> unlabelledImage y <|> parseYAML y
instance FromYAML Image where
parseYAML y = do
Pair label rest <- parseYAML y
asStr label rest <|> asObj label rest
where
asStr label = YAML.withStr "path" \(Text.unpack -> path) ->
pure $ Image {label, path, nsfw = False, warning = Nothing}
asObj label = YAML.withMap "image info" \m -> do
path <- m .: "path"
nsfw <- m .:? "nsfw" .!= False
warning <- m .:? "warning"
pure $ Image {label, path, nsfw, warning}
parseYAML y = unlabelledImage y <|> labelled y where
labelled y' = do
Pair label rest <- parseYAML y'
i <- unlabelledImage rest
pure $ i {label}
unlabelledImage :: YAML.Node YAML.Pos -> YAML.Parser Image
unlabelledImage y = asStr y <|> asObj y
where
asStr = YAML.withStr "path" \(Text.unpack -> path) ->
pure $ Image {label = "", path, nsfw = False, warning = Nothing}
asObj = YAML.withMap "image info" \m -> do
path <- m .: "path"
nsfw <- m .:? "nsfw" .!= False
warning <- m .:? "warning"
pure $ Image {label = "", path, nsfw, warning}
instance FromYAML Link where
parseYAML y = do