make default image label from filename

This commit is contained in:
Rhiannon Morris 2020-08-01 03:02:49 +02:00
parent aef07f0f6f
commit 8a39a5a46b

View file

@ -22,6 +22,7 @@ import qualified Data.Text as Text
import Data.Time.Calendar (Day (..), toGregorian) import Data.Time.Calendar (Day (..), toGregorian)
import Data.YAML (FromYAML (..), (.:), (.:?), (.!=)) import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML import qualified Data.YAML as YAML
import System.FilePath (takeBaseName)
import Text.Read (readMaybe) import Text.Read (readMaybe)
@ -126,14 +127,16 @@ unlabelledImage :: YAML.Node YAML.Pos -> YAML.Parser Image
unlabelledImage y = asStr y <|> asObj y unlabelledImage y = asStr y <|> asObj y
where where
asStr = YAML.withStr "path" \(Text.unpack -> path) -> asStr = YAML.withStr "path" \(Text.unpack -> path) ->
pure $ Image {label = "", path, download = Nothing, pure $ Image {label = pathToLabel path, path, download = Nothing,
nsfw = False, warning = Nothing} nsfw = False, warning = Nothing}
asObj = YAML.withMap "image info" \m -> do asObj = YAML.withMap "image info" \m -> do
path <- m .: "path" path <- m .: "path"
download <- m .:? "download" download <- m .:? "download"
nsfw <- m .:? "nsfw" .!= False nsfw <- m .:? "nsfw" .!= False
warning <- m .:? "warning" warning <- m .:? "warning"
pure $ Image {label = "", path, download, nsfw, warning} pure $ Image {label = pathToLabel path, path, download, nsfw, warning}
pathToLabel = Text.pack . dashToSpace . takeBaseName
dashToSpace = map \case '-' -> ' '; c -> c
instance FromYAML Link where instance FromYAML Link where
parseYAML y = do parseYAML y = do