diff --git a/make-pages/BuilderQQ.hs b/make-pages/BuilderQQ.hs index 95db76c..97019ea 100644 --- a/make-pages/BuilderQQ.hs +++ b/make-pages/BuilderQQ.hs @@ -2,7 +2,7 @@ module BuilderQQ (b, Builder, toLazyText, fromText, fromString, fromChar, - textMap) + textMap, ifJust) where import Data.Char (isLower, isSpace, isDigit, isAlphaNum) @@ -186,3 +186,6 @@ fromChar = singleton textMap :: (Char -> Builder) -> Text -> Builder textMap f = Text.foldl' (\buf c -> buf <> f c) mempty + +ifJust :: Monoid b => Maybe a -> (a -> b) -> b +ifJust x f = maybe mempty f x diff --git a/make-pages/RSS.hs b/make-pages/RSS.hs index a3219aa..23fb768 100644 --- a/make-pages/RSS.hs +++ b/make-pages/RSS.hs @@ -5,6 +5,7 @@ import BuilderQQ import Records () import Data.List (sortOn) +import Data.Maybe (isJust) import Data.Ord (Down (..)) import qualified Data.Text as Strict import qualified Data.Text.Lazy as Lazy @@ -26,8 +27,7 @@ make' :: Strict.Text -> Strict.Text -> Strict.Text -> FilePath -> Maybe FilePath -> [(FilePath, Info)] -> Builder make' root title desc prefix output infos = [b|@0 - + $*title $link @@ -43,33 +43,34 @@ make' root title desc prefix output infos = [b|@0 items = map (uncurry $ makeItem root prefix) $ sortOn (Down . #second) infos selflink = case output of Nothing -> "" - Just o -> [b|@4 - - |] + Just o -> [b||] makeItem :: Strict.Text -> FilePath -> FilePath -> Info -> Builder -makeItem root prefix path (Info {title, desc, date}) = [b|@4 +makeItem root prefix path (Info {title, desc, date, artist}) = [b|@4 $*title $link $link - $desc' + $descArtist' $date' |] where dir = takeDirectory path link = [b|$*root/$@prefix/$@dir|] - desc' = - case desc of - Nothing -> "" - Just d -> [b|@6 - - - - |] + artist' = ifJust artist \case + Artist {name, url = Nothing} -> [b|

by $*name|] + Artist {name, url = Just url} -> [b|

by $*name|] + desc' = ifJust desc \d -> [b|$10*d|] + descArtist' = if isJust desc || isJust artist then [b|@6 + + + + |] + else "" date' = formatDate date formatDate :: Day -> Builder diff --git a/make-pages/SinglePage.hs b/make-pages/SinglePage.hs index 6065e05..b1e551a 100644 --- a/make-pages/SinglePage.hs +++ b/make-pages/SinglePage.hs @@ -117,9 +117,6 @@ makeDesc nsfw desc nsfwDesc = [b|@4 desc' = fromMaybe "" desc nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc -ifJust :: Monoid b => Maybe a -> (a -> b) -> b -ifJust x f = maybe mempty f x - formatDate :: Day -> Builder formatDate d = let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]