diff --git a/make-pages/Info.hs b/make-pages/Info.hs
index 3452bfc..a719889 100644
--- a/make-pages/Info.hs
+++ b/make-pages/Info.hs
@@ -2,16 +2,14 @@
module Info
(Info (..), Image (..), Link (..),
-- ** Reexports
- Day (..), Text, Vector)
+ Day (..), Text)
where
-import Data.YAML (FromYAML (..), (.:))
+import Data.YAML (FromYAML (..), (.:), (.:?), (.!=))
import qualified Data.YAML as YAML
import Data.Time.Calendar (Day (..))
import Data.Text (Text)
import qualified Data.Text as Text
-import Data.Vector (Vector)
-import qualified Data.Vector as Vector
import qualified Data.Map.Strict as Map
import Control.Applicative
import Text.Read (readMaybe)
@@ -20,12 +18,12 @@ import Text.Read (readMaybe)
data Info =
Info {
date :: !Day,
- title :: !Text,
- tags :: !(Vector Text),
- description :: !Text,
- images :: !(Vector Image),
+ title :: !(Maybe Text),
+ tags :: ![Text],
+ description :: !(Maybe Text),
+ images :: ![Image],
thumb :: !Text,
- links :: !(Vector Link)
+ links :: ![Link]
}
deriving (Eq, Show)
@@ -48,13 +46,13 @@ data Link =
instance FromYAML Info where
parseYAML = YAML.withMap "info" \m ->
- Info <$> m .: "date"
- <*> m .: "title"
- <*> m .: "tags"
- <*> m .: "description"
- <*> m .: "images"
- <*> m .: "thumb"
- <*> m .: "links"
+ Info <$> m .: "date"
+ <*> m .:? "title"
+ <*> m .:? "tags" .!= []
+ <*> m .:? "description"
+ <*> m .: "images"
+ <*> m .: "thumb"
+ <*> m .:? "links" .!= []
instance FromYAML Image where
parseYAML = labelledOptNsfw Image "path" "path"
@@ -95,7 +93,8 @@ parseOptNsfw :: FromYAML a
-> YAML.Node YAML.Pos -> YAML.Parser (OptNsfw a)
parseOptNsfw name field y = yes y <|> no y where
yes = YAML.withMap (name <> " & nsfw") \m ->
- WithNsfw <$> m .: field <*> m .: "nsfw"
+ WithNsfw <$> m .: field
+ <*> m .:? "nsfw" .!= False
no = fmap NoNsfw . parseYAML
@@ -104,6 +103,3 @@ instance FromYAML Day where
case readMaybe $ Text.unpack str of
Just d -> pure d
Nothing -> fail $ "couldn't parse date " ++ show str
-
-instance FromYAML a => FromYAML (Vector a) where
- parseYAML = YAML.withSeq "seq" $ fmap Vector.fromList . traverse parseYAML
diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs
index 9a66d91..1ba8b82 100644
--- a/make-pages/SinglePage.hs
+++ b/make-pages/SinglePage.hs
@@ -1,12 +1,24 @@
module SinglePage (make) where
import Info hiding (Text)
+import Control.Exception
import qualified Data.Text as Strict
import qualified Data.Text.Lazy as Lazy
import Data.Text.Lazy.Builder
import Data.Time (formatTime, defaultTimeLocale)
+import Data.Maybe (fromMaybe)
import qualified Data.Char as Char
-import qualified Data.Vector as Vector
+import qualified Data.List as List
+
+
+-- | only nsfw images are present for a non-nsfw page
+data NoEligibleImages = NoEligibleImages {title :: !Strict.Text}
+ deriving stock Eq deriving anyclass Exception
+
+instance Show NoEligibleImages where
+ show (NoEligibleImages {title}) =
+ Strict.unpack title <> ": no images selected\n" <>
+ " (probably a nsfw-only work without --nsfw set)"
make :: Bool -> Info -> Lazy.Text
@@ -18,25 +30,31 @@ make' includeNsfw (Info {date, title, tags, description, images, links}) =
"\n" <>
"\n" <>
"\n\n" <>
- "" <> esc title <> "\n\n" <>
+ ifJust title (\t -> "" <> esc t <> "\n\n") <>
"\n" <>
- " " <> esc title <> "
\n" <>
+ ifJust title (\t -> " " <> esc t <> "
\n") <>
" " <> formatDate date <> "
\n" <>
- buttonBar includeNsfw images <>
+ buttonBar title' includeNsfw images <>
"\n\n" <>
"\n" <>
" ![](\"")
path0 <> "\">\n" <>
- " \n" <>
- indent 4 description <>
- " \n\n" <>
+ ifJust description (\d ->
+ " \n" <>
+ "
description
\n" <>
+ indent 4 d <>
+ " \n") <>
extLinks includeNsfw links <>
"\n\n" <>
"\n"
where
- path0 = let Image {path} = Vector.head images in fromText path
+ path0' = let Image {path} = head images in path
+ path0 = fromText path0'
+ title' = fromMaybe path0' title
+ifJust :: Monoid b => Maybe a -> (a -> b) -> b
+ifJust x f = maybe mempty f x
esc :: Strict.Text -> Builder
esc = foldMap esc1 . Strict.unpack where
@@ -50,21 +68,23 @@ esc = foldMap esc1 . Strict.unpack where
formatDate :: Day -> Builder
formatDate = fromString . formatTime defaultTimeLocale "%e %#B %Y"
-buttonBar :: Bool -> Vector Image -> Builder
-buttonBar includeNsfw images =
- let images' = if includeNsfw then images
- else Vector.filter (\Image {nsfw} -> not nsfw) images in
- if null images' then
- error "not including nsfw but there are no sfw images!"
- else if length images' == 1 then
+buttonBar :: Strict.Text -> Bool -> [Image] -> Builder
+buttonBar title includeNsfw allImages =
+ if null images then
+ throw $ NoEligibleImages title
+ else if length images == 1 then
mempty
else
" \n"
+ where
+ images | includeNsfw = allImages
+ | otherwise = filter (\Image {nsfw} -> not nsfw) allImages
+ iimages = zip [0..] images
altButton :: Int -> Image -> Builder
altButton i (Image {label, path, nsfw}) =
@@ -93,16 +113,18 @@ indent n txt = spaces <> go (Strict.unpack txt) where
go (c:cs) = singleton c <> go cs
spaces = fromString $ replicate n ' '
-extLinks :: Bool -> Vector Link -> Builder
+extLinks :: Bool -> [Link] -> Builder
extLinks includeNsfw links =
let links' =
if includeNsfw then links
- else Vector.filter (\Link {nsfw} -> not nsfw) links in
+ else filter (\Link {nsfw} -> not nsfw) links in
if null links' then mempty else
- " links
\n" <>
- " \n" <>
- foldMap extLink links' <>
- "
\n"
+ " \n" <>
+ "
links
\n" <>
+ "
\n" <>
+ foldMap extLink links' <>
+ "
\n" <>
+ "