make default image label from filename
This commit is contained in:
parent
aef07f0f6f
commit
8a39a5a46b
1 changed files with 5 additions and 2 deletions
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue