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

add resize: false for stuff like animated webps

Browse source
This commit is contained in:
rhiannon morris 2024-08-05 19:08:36 +02:00
parent 1307cce488
commit 929cc1dc3f
3 changed files with 24 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

27
make-pages/Info.hs
View file

@ -105,7 +105,8 @@ data Image =
path :: !FilePath,
download :: !(Maybe FilePath),
nsfw :: !Bool,
warning :: !(Maybe Text)
warning :: !(Maybe Text),
resize :: !Bool
}
deriving (Eq, Show)
@ -266,15 +267,16 @@ getThumb dir =
thumbFile :: FilePath -> FilePath
thumbFile = addSuffix "_small"
pageFile :: FilePath -> FilePath
pageFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_med" f
canResize :: Image -> Bool
canResize i = i.resize && takeExtension i.path /= ".gif"
bigFile :: FilePath -> FilePath
bigFile f
| takeExtension f == ".gif" = f
| otherwise = addSuffix "_big" f
pageFile :: Image -> FilePath
pageFile img =
if canResize img then addSuffix "_med" img.path else img.path
bigFile :: Image -> FilePath
bigFile img =
if canResize img then addSuffix "_big" img.path else img.path
addSuffix :: String -> FilePath -> FilePath
addSuffix suf path =
@ -361,15 +363,16 @@ unlabelledImage' label' y = asStr y <|> asObj y
asStr = YAML.withStr "path" \(Text.unpack -> path) ->
let label = fromMaybe (pathToLabel path) label' in
pure $ Image {label, path, download = Nothing,
nsfw = False, warning = Nothing}
nsfw = False, warning = Nothing, resize = True}
asObj = YAML.withMap "image info" \m -> do
checkKeys m ["path", "download", "nsfw", "warning"]
checkKeys m ["path", "download", "nsfw", "warning", "resize"]
path <- m .: "path"
download <- m .:? "download"
nsfw <- m .:? "nsfw" .!= False
warning <- m .:? "warning"
resize <- m .:? "resize" .!= True
let label = fromMaybe (pathToLabel path) label'
pure $ Image {label, path, download, nsfw, warning}
pure $ Image {label, path, download, nsfw, warning, resize}
pathToLabel = Text.pack . gapToSpace . takeBaseName
gapToSpace = map \case '-' -> ' '; '_' -> ' '; c -> c