add download field for svgs etc

This commit is contained in:
Rhiannon Morris 2020-07-22 01:48:29 +02:00
parent 6f3941e816
commit e09e56d5df
3 changed files with 18 additions and 12 deletions

View file

@ -7,7 +7,7 @@ where
import BuilderQQ import BuilderQQ
import Info hiding (Text) import Info hiding (Text)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text.Lazy (Text) import Data.Text.Lazy (Text)
import System.FilePath import System.FilePath
@ -26,8 +26,9 @@ dependSingle' yamlDir info prefix build nsfw =
let dir = build </> prefix </> yamlDir let dir = build </> prefix </> yamlDir
images = if nsfw then #images info else #sfwImages info images = if nsfw then #images info else #sfwImages info
paths = map #path images paths = map #path images
dls = mapMaybe #download images
index = dir </> "index.html" index = dir </> "index.html"
deps = thumbFile (thumbnail info) : map pageFile paths ++ paths deps = thumbFile (thumbnail info) : map pageFile paths ++ paths ++ dls
deps' = unwords $ map (dir </>) deps deps' = unwords $ map (dir </>) deps
in in
[b|$@index: $@deps' $$(MAKEPAGES)|] [b|$@index: $@deps' $$(MAKEPAGES)|]

View file

@ -48,10 +48,11 @@ data Artist =
data Image = data Image =
Image { Image {
label :: !Text, label :: !Text,
path :: !FilePath, path :: !FilePath,
nsfw :: !Bool, download :: !(Maybe FilePath),
warning :: !(Maybe Text) nsfw :: !Bool,
warning :: !(Maybe Text)
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -123,12 +124,14 @@ 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, nsfw = False, warning = Nothing} pure $ Image {label = "", path, download = 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"
nsfw <- m .:? "nsfw" .!= False download <- m .:? "download"
warning <- m .:? "warning" nsfw <- m .:? "nsfw" .!= False
pure $ Image {label = "", path, nsfw, warning} warning <- m .:? "warning"
pure $ Image {label = "", path, download, nsfw, warning}
instance FromYAML Link where instance FromYAML Link where
parseYAML y = do parseYAML y = do

View file

@ -6,6 +6,7 @@ import BuilderQQ
import Records () import Records ()
import Control.Exception import Control.Exception
import Data.Maybe (fromMaybe)
import qualified Data.Text as Strict import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy import qualified Data.Text.Lazy as Lazy
import Data.Time (formatTime, defaultTimeLocale) import Data.Time (formatTime, defaultTimeLocale)
@ -51,7 +52,7 @@ make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
<main> <main>
<figure id=mainfig> <figure id=mainfig>
$warning' $warning'
<a id=mainlink href="$@path0"> <a id=mainlink href="$@download0">
<img id=mainimg src="$@path0'"> <img id=mainimg src="$@path0'">
</a> </a>
</figure> </figure>
@ -79,6 +80,7 @@ make' nsfw dir (Info {date, title, artist, tags, nsfwTags,
buttonBar = makeButtonBar title nsfw images buttonBar = makeButtonBar title nsfw images
image0 = head images image0 = head images
path0 = #path image0 path0 = #path image0
download0 = fromMaybe path0 (#download image0)
path0' = pageFile path0 path0' = pageFile path0
descSection = ifJust description makeDesc descSection = ifJust description makeDesc