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
|
module BuilderQQ
|
||||||
(b,
|
(b,
|
||||||
Builder, toLazyText, fromText, fromString, fromChar,
|
Builder, toLazyText, fromText, fromString, fromChar,
|
||||||
textMap)
|
textMap, ifJust)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Data.Char (isLower, isSpace, isDigit, isAlphaNum)
|
import Data.Char (isLower, isSpace, isDigit, isAlphaNum)
|
||||||
|
@ -186,3 +186,6 @@ fromChar = singleton
|
||||||
|
|
||||||
textMap :: (Char -> Builder) -> Text -> Builder
|
textMap :: (Char -> Builder) -> Text -> Builder
|
||||||
textMap f = Text.foldl' (\buf c -> buf <> f c) mempty
|
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 Records ()
|
||||||
|
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
|
import Data.Maybe (isJust)
|
||||||
import Data.Ord (Down (..))
|
import Data.Ord (Down (..))
|
||||||
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
|
||||||
|
@ -26,8 +27,7 @@ make' :: Strict.Text -> Strict.Text -> Strict.Text
|
||||||
-> FilePath -> Maybe FilePath -> [(FilePath, Info)] -> Builder
|
-> FilePath -> Maybe FilePath -> [(FilePath, Info)] -> Builder
|
||||||
make' root title desc prefix output infos = [b|@0
|
make' root title desc prefix output infos = [b|@0
|
||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<rss version="2.0"
|
<rss version="2.0" xmlns:atom="http://www.w3.org/2005/Atom">
|
||||||
xmlns:atom="http://www.w3.org/2005/Atom">
|
|
||||||
<channel>
|
<channel>
|
||||||
<title>$*title</title>
|
<title>$*title</title>
|
||||||
<link>$link</link>
|
<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
|
items = map (uncurry $ makeItem root prefix) $ sortOn (Down . #second) infos
|
||||||
selflink = case output of
|
selflink = case output of
|
||||||
Nothing -> ""
|
Nothing -> ""
|
||||||
Just o -> [b|@4
|
Just o -> [b|<atom:link href="$link/$@o" rel="self" />|]
|
||||||
<atom:link href="$link/$@o" rel="self" />
|
|
||||||
|]
|
|
||||||
|
|
||||||
makeItem :: Strict.Text -> FilePath -> FilePath -> Info -> Builder
|
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>
|
<item>
|
||||||
<title>$*title</title>
|
<title>$*title</title>
|
||||||
<link>$link</link>
|
<link>$link</link>
|
||||||
<guid>$link</guid>
|
<guid>$link</guid>
|
||||||
$desc'
|
$descArtist'
|
||||||
<pubDate>$date'</pubDate>
|
<pubDate>$date'</pubDate>
|
||||||
</item>
|
</item>
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
dir = takeDirectory path
|
dir = takeDirectory path
|
||||||
link = [b|$*root/$@prefix/$@dir|]
|
link = [b|$*root/$@prefix/$@dir|]
|
||||||
desc' =
|
artist' = ifJust artist \case
|
||||||
case desc of
|
Artist {name, url = Nothing} -> [b|<p>by $*name|]
|
||||||
Nothing -> ""
|
Artist {name, url = Just url} -> [b|<p>by <a href=$*url>$*name</a>|]
|
||||||
Just d -> [b|@6
|
desc' = ifJust desc \d -> [b|$10*d|]
|
||||||
|
descArtist' = if isJust desc || isJust artist then [b|@6
|
||||||
<description>
|
<description>
|
||||||
<![CDATA[
|
<![CDATA[
|
||||||
$10*d
|
$desc'
|
||||||
|
$artist'
|
||||||
]]>
|
]]>
|
||||||
</description>
|
</description>
|
||||||
|]
|
|]
|
||||||
|
else ""
|
||||||
date' = formatDate date
|
date' = formatDate date
|
||||||
|
|
||||||
formatDate :: Day -> Builder
|
formatDate :: Day -> Builder
|
||||||
|
|
|
@ -117,9 +117,6 @@ makeDesc nsfw desc nsfwDesc = [b|@4
|
||||||
desc' = fromMaybe "" desc
|
desc' = fromMaybe "" desc
|
||||||
nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc
|
nsfwDesc' = fromMaybe "" $ guard nsfw *> nsfwDesc
|
||||||
|
|
||||||
ifJust :: Monoid b => Maybe a -> (a -> b) -> b
|
|
||||||
ifJust x f = maybe mempty f x
|
|
||||||
|
|
||||||
formatDate :: Day -> Builder
|
formatDate :: Day -> Builder
|
||||||
formatDate d =
|
formatDate d =
|
||||||
let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]
|
let str = formatTime defaultTimeLocale "%e %#B %Y" d in [b|$@str|]
|
||||||
|
|
Loading…
Reference in a new issue