put artist on rss feed
This commit is contained in:
parent
c1a54a89c5
commit
328ce7bf11
3 changed files with 22 additions and 21 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<rss version="2.0"
|
||||
xmlns:atom="http://www.w3.org/2005/Atom">
|
||||
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
|
||||
<channel>
|
||||
<title>$*title</title>
|
||||
<link>$link</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
|
||||
<atom:link href="$link/$@o" rel="self" />
|
||||
|]
|
||||
Just o -> [b|<atom:link href="$link/$@o" rel="self" />|]
|
||||
|
||||
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
|
||||
<item>
|
||||
<title>$*title</title>
|
||||
<link>$link</link>
|
||||
<guid>$link</guid>
|
||||
$desc'
|
||||
$descArtist'
|
||||
<pubDate>$date'</pubDate>
|
||||
</item>
|
||||
|]
|
||||
where
|
||||
dir = takeDirectory path
|
||||
link = [b|$*root/$@prefix/$@dir|]
|
||||
desc' =
|
||||
case desc of
|
||||
Nothing -> ""
|
||||
Just d -> [b|@6
|
||||
<description>
|
||||
<![CDATA[
|
||||
$10*d
|
||||
]]>
|
||||
</description>
|
||||
|]
|
||||
artist' = ifJust artist \case
|
||||
Artist {name, url = Nothing} -> [b|<p>by $*name|]
|
||||
Artist {name, url = Just url} -> [b|<p>by <a href=$*url>$*name</a>|]
|
||||
desc' = ifJust desc \d -> [b|$10*d|]
|
||||
descArtist' = if isJust desc || isJust artist then [b|@6
|
||||
<description>
|
||||
<![CDATA[
|
||||
$desc'
|
||||
$artist'
|
||||
]]>
|
||||
</description>
|
||||
|]
|
||||
else ""
|
||||
date' = formatDate date
|
||||
|
||||
formatDate :: Day -> Builder
|
||||
|
|
|
@ -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|]
|
||||
|
|
Loading…
Reference in a new issue