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.YAML (FromYAML (..), (.:), (.:?), (.!=))
|
||||
import qualified Data.YAML as YAML
|
||||
import System.FilePath (takeBaseName)
|
||||
import Text.Read (readMaybe)
|
||||
|
||||
|
||||
|
@ -126,14 +127,16 @@ 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, download = Nothing,
|
||||
pure $ Image {label = pathToLabel path, path, download = Nothing,
|
||||
nsfw = False, warning = Nothing}
|
||||
asObj = YAML.withMap "image info" \m -> do
|
||||
path <- m .: "path"
|
||||
download <- m .:? "download"
|
||||
nsfw <- m .:? "nsfw" .!= False
|
||||
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
|
||||
parseYAML y = do
|
||||
|
|
Loading…
Reference in a new issue