add resize: false for stuff like animated webps

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

View file

@ -32,7 +32,6 @@ dependSingle' yamlDir indexFile info prefix build nsfw =
maybe [] (toList . allImages) $ maybe [] (toList . allImages) $
if nsfw then Just $ info.images else sfwImages info if nsfw then Just $ info.images else sfwImages info
paths = map (.path) images
dls = mapMaybe (.download) images dls = mapMaybe (.download) images
extras = info.extras extras = info.extras
@ -40,8 +39,8 @@ dependSingle' yamlDir indexFile info prefix build nsfw =
page = dir </> "index.html" page = dir </> "index.html"
deps = unwords $ map (dir </>) $ deps = unwords $ map (dir </>) $
thumbFile (thumbnail info) : thumbFile (thumbnail info) :
map pageFile paths ++ map pageFile images ++
map bigFile paths ++ map bigFile images ++
dls ++ extras dls ++ extras
dependGallery :: GalleryInfo dependGallery :: GalleryInfo

View file

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

View file

@ -52,10 +52,8 @@ make' root siteName prefix nsfw _dataDir dir
let buttonBar = makeButtonBar title $ addIds images let buttonBar = makeButtonBar title $ addIds images
let image0 :| otherImages = allImages images let image0 :| otherImages = allImages images
let Image {path = path0, download = download0'} = image0 let download0 = fromMaybe (bigFile image0) image0.download
let path0' = pageFile image0
let download0 = fromMaybe (bigFile path0) download0'
let path0' = pageFile path0
let artistSection = makeArtist artist let artistSection = makeArtist artist
let descSection = makeDesc $ descFor nsfw info let descSection = makeDesc $ descFor nsfw info
@ -64,8 +62,8 @@ make' root siteName prefix nsfw _dataDir dir
let updates = sort $ updatesFor nsfw info let updates = sort $ updatesFor nsfw info
let updatesList = makeUpdates updates let updatesList = makeUpdates updates
let makePrefetch (Image {path}) = [b|<link rel=prefetch href=$path'>|] let makePrefetch img = [b|<link rel=preload as=image href=$path'>|]
where path' = bigFile path where path' = bigFile img
let prefetches = map makePrefetch otherImages let prefetches = map makePrefetch otherImages
let makeWarning w = [b|@0 let makeWarning w = [b|@0
@ -309,11 +307,11 @@ altButton img i = [b|@0
<label for="$i"$nsfwLabelClass>$label</label> <label for="$i"$nsfwLabelClass>$label</label>
|] |]
where where
Image {label, path, nsfw, warning, download} = img Image {label, nsfw, warning, download} = img
nsfwClass = if nsfw then [b| class=nsfw|] else "" nsfwClass = if nsfw then [b| class=nsfw|] else ""
nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else "" nsfwLabelClass = if nsfw then [b| class=nsfw-label|] else ""
path' = pageFile path path' = pageFile img
link = fromMaybe (bigFile path) download link = fromMaybe (bigFile img) download
warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|] warning' = ifJust warning \(escAttr -> w) -> [b| data-warning="$w"|]
makeTags :: FilePath -> [Strict.Text] -> Builder makeTags :: FilePath -> [Strict.Text] -> Builder