allow single image (non-list) for images field

This commit is contained in:
Rhiannon Morris 2020-07-18 11:29:07 +02:00
parent 9b9f955e65
commit e7af795f7f

View file

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