module Text.RSS.Export
( qualNode
, qualName
, xmlRSS
, textRSS
, xmlChannel
, xmlItem
, xmlSource
, xmlEnclosure
, xmlCategory
, xmlGuid
, xmlImage
, xmlCloud
, xmlTextInput
, xmlSkipHours
, xmlSkipDays
, xmlAttr
, xmlLeaf
, mb
) where
import Prelude.Compat
import qualified Data.Text.Util as U
import Data.XML.Compat
import Data.XML.Types as XML
import Text.RSS.Syntax
import Data.Text (Text, pack)
import qualified Data.Text.Lazy as TL
qualName :: Text -> XML.Name
qualName :: Text -> Name
qualName Text
n = Text -> Maybe Text -> Maybe Text -> Name
Name Text
n Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
qualNode :: Text -> [XML.Node] -> XML.Element
qualNode :: Text -> [Node] -> Element
qualNode Text
n = Name -> [(Name, [Content])] -> [Node] -> Element
Element (Text -> Maybe Text -> Maybe Text -> Name
Name Text
n Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing) []
xmlRSS :: RSS -> XML.Element
RSS
r =
(Text -> [Node] -> Element
qualNode Text
"rss" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Node
NodeElement (RSSChannel -> Element
xmlChannel (RSS -> RSSChannel
rssChannel RSS
r) Element -> [Element] -> [Element]
forall a. a -> [a] -> [a]
: RSS -> [Element]
rssOther RSS
r))
{elementAttributes = mkAttr "version" (rssVersion r) : rssAttrs r}
textRSS :: RSS -> Maybe TL.Text
= (RSS -> Element) -> RSS -> Maybe Text
forall a. (a -> Element) -> a -> Maybe Text
U.renderFeed RSS -> Element
xmlRSS
xmlChannel :: RSSChannel -> XML.Element
xmlChannel :: RSSChannel -> Element
xmlChannel RSSChannel
ch =
Text -> [Node] -> Element
qualNode Text
"channel" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
(Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map
Element -> Node
NodeElement
([ Text -> Text -> Element
xmlLeaf Text
"title" (RSSChannel -> Text
rssTitle RSSChannel
ch)
, Text -> Text -> Element
xmlLeaf Text
"link" (RSSChannel -> Text
rssLink RSSChannel
ch)
, Text -> Text -> Element
xmlLeaf Text
"description" (RSSChannel -> Text
rssDescription RSSChannel
ch)
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSItem -> Element) -> [RSSItem] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map RSSItem -> Element
xmlItem (RSSChannel -> [RSSItem]
rssItems RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"language") (RSSChannel -> Maybe Text
rssLanguage RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"copyright") (RSSChannel -> Maybe Text
rssCopyright RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"managingEditor") (RSSChannel -> Maybe Text
rssEditor RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"webMaster") (RSSChannel -> Maybe Text
rssWebMaster RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"pubDate") (RSSChannel -> Maybe Text
rssPubDate RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"lastBuildDate") (RSSChannel -> Maybe Text
rssLastUpdate RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSCategory -> Element) -> [RSSCategory] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map RSSCategory -> Element
xmlCategory (RSSChannel -> [RSSCategory]
rssCategories RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"generator") (RSSChannel -> Maybe Text
rssGenerator RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"docs") (RSSChannel -> Maybe Text
rssDocs RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSCloud -> Element) -> Maybe RSSCloud -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSCloud -> Element
xmlCloud (RSSChannel -> Maybe RSSCloud
rssCloud RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Integer -> Element) -> Maybe Integer -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"ttl" (Text -> Element) -> (Integer -> Text) -> Integer -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (RSSChannel -> Maybe Integer
rssTTL RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSImage -> Element) -> Maybe RSSImage -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSImage -> Element
xmlImage (RSSChannel -> Maybe RSSImage
rssImage RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"rating") (RSSChannel -> Maybe Text
rssRating RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSTextInput -> Element) -> Maybe RSSTextInput -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSTextInput -> Element
xmlTextInput (RSSChannel -> Maybe RSSTextInput
rssTextInput RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
([Integer] -> Element) -> Maybe [Integer] -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb [Integer] -> Element
xmlSkipHours (RSSChannel -> Maybe [Integer]
rssSkipHours RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ ([Text] -> Element) -> Maybe [Text] -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb [Text] -> Element
xmlSkipDays (RSSChannel -> Maybe [Text]
rssSkipDays RSSChannel
ch) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ RSSChannel -> [Element]
rssChannelOther RSSChannel
ch)
xmlItem :: RSSItem -> XML.Element
xmlItem :: RSSItem -> Element
xmlItem RSSItem
it =
(Text -> [Node] -> Element
qualNode Text
"item" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
(Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map
Element -> Node
NodeElement
((Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"title") (RSSItem -> Maybe Text
rssItemTitle RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"link") (RSSItem -> Maybe Text
rssItemLink RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"description") (RSSItem -> Maybe Text
rssItemDescription RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"author") (RSSItem -> Maybe Text
rssItemAuthor RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSCategory -> Element) -> [RSSCategory] -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map RSSCategory -> Element
xmlCategory (RSSItem -> [RSSCategory]
rssItemCategories RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"comments") (RSSItem -> Maybe Text
rssItemComments RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSEnclosure -> Element) -> Maybe RSSEnclosure -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSEnclosure -> Element
xmlEnclosure (RSSItem -> Maybe RSSEnclosure
rssItemEnclosure RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSGuid -> Element) -> Maybe RSSGuid -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSGuid -> Element
xmlGuid (RSSItem -> Maybe RSSGuid
rssItemGuid RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"pubDate") (RSSItem -> Maybe Text
rssItemPubDate RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(RSSSource -> Element) -> Maybe RSSSource -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb RSSSource -> Element
xmlSource (RSSItem -> Maybe RSSSource
rssItemSource RSSItem
it) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ RSSItem -> [Element]
rssItemOther RSSItem
it))
{elementAttributes = rssItemAttrs it}
xmlSource :: RSSSource -> XML.Element
xmlSource :: RSSSource -> Element
xmlSource RSSSource
s =
(Text -> Text -> Element
xmlLeaf Text
"source" (RSSSource -> Text
rssSourceTitle RSSSource
s))
{elementAttributes = mkAttr "url" (rssSourceURL s) : rssSourceAttrs s}
xmlEnclosure :: RSSEnclosure -> XML.Element
xmlEnclosure :: RSSEnclosure -> Element
xmlEnclosure RSSEnclosure
e =
(Text -> Text -> Element
xmlLeaf Text
"enclosure" Text
"")
{ elementAttributes =
mkAttr "url" (rssEnclosureURL e) :
mkAttr "type" (rssEnclosureType e) :
mb (mkAttr "length" . pack . show) (rssEnclosureLength e) ++ rssEnclosureAttrs e
}
xmlCategory :: RSSCategory -> XML.Element
xmlCategory :: RSSCategory -> Element
xmlCategory RSSCategory
c =
(Text -> Text -> Element
xmlLeaf Text
"category" (RSSCategory -> Text
rssCategoryValue RSSCategory
c))
{ elementAttributes =
maybe id (\Text
n -> (Text -> Text -> (Name, [Content])
mkAttr Text
"domain" Text
n (Name, [Content]) -> [(Name, [Content])] -> [(Name, [Content])]
forall a. a -> [a] -> [a]
:)) (rssCategoryDomain c) (rssCategoryAttrs c)
}
xmlGuid :: RSSGuid -> XML.Element
xmlGuid :: RSSGuid -> Element
xmlGuid RSSGuid
g =
(Text -> Text -> Element
xmlLeaf Text
"guid" (RSSGuid -> Text
rssGuidValue RSSGuid
g))
{ elementAttributes =
maybe
id
(\Bool
n -> (Text -> Text -> (Name, [Content])
mkAttr Text
"isPermaLink" (Bool -> Text
forall {a}. IsString a => Bool -> a
toBool Bool
n) (Name, [Content]) -> [(Name, [Content])] -> [(Name, [Content])]
forall a. a -> [a] -> [a]
:))
(rssGuidPermanentURL g)
(rssGuidAttrs g)
}
where
toBool :: Bool -> a
toBool Bool
False = a
"false"
toBool Bool
_ = a
"true"
xmlImage :: RSSImage -> XML.Element
xmlImage :: RSSImage -> Element
xmlImage RSSImage
im =
Text -> [Node] -> Element
qualNode Text
"image" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
(Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map
Element -> Node
NodeElement
([ Text -> Text -> Element
xmlLeaf Text
"url" (RSSImage -> Text
rssImageURL RSSImage
im)
, Text -> Text -> Element
xmlLeaf Text
"title" (RSSImage -> Text
rssImageTitle RSSImage
im)
, Text -> Text -> Element
xmlLeaf Text
"link" (RSSImage -> Text
rssImageLink RSSImage
im)
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Integer -> Element) -> Maybe Integer -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"width" (Text -> Element) -> (Integer -> Text) -> Integer -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (RSSImage -> Maybe Integer
rssImageWidth RSSImage
im) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Integer -> Element) -> Maybe Integer -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"height" (Text -> Element) -> (Integer -> Text) -> Integer -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (RSSImage -> Maybe Integer
rssImageHeight RSSImage
im) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
(Text -> Element) -> Maybe Text -> [Element]
forall a b. (a -> b) -> Maybe a -> [b]
mb (Text -> Text -> Element
xmlLeaf Text
"description") (RSSImage -> Maybe Text
rssImageDesc RSSImage
im) [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++ RSSImage -> [Element]
rssImageOther RSSImage
im)
xmlCloud :: RSSCloud -> XML.Element
xmlCloud :: RSSCloud -> Element
xmlCloud RSSCloud
cl =
(Text -> Text -> Element
xmlLeaf Text
"cloud" Text
"")
{ elementAttributes =
mb (mkAttr "domain") (rssCloudDomain cl) ++
mb (mkAttr "port") (rssCloudPort cl) ++
mb (mkAttr "path") (rssCloudPath cl) ++
mb (mkAttr "registerProcedure") (rssCloudRegisterProcedure cl) ++
mb (mkAttr "protocol") (rssCloudProtocol cl) ++ rssCloudAttrs cl
}
xmlTextInput :: RSSTextInput -> XML.Element
xmlTextInput :: RSSTextInput -> Element
xmlTextInput RSSTextInput
ti =
(Text -> [Node] -> Element
qualNode Text
"textInput" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$
(Element -> Node) -> [Element] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map
Element -> Node
NodeElement
([ Text -> Text -> Element
xmlLeaf Text
"title" (RSSTextInput -> Text
rssTextInputTitle RSSTextInput
ti)
, Text -> Text -> Element
xmlLeaf Text
"description" (RSSTextInput -> Text
rssTextInputDesc RSSTextInput
ti)
, Text -> Text -> Element
xmlLeaf Text
"name" (RSSTextInput -> Text
rssTextInputName RSSTextInput
ti)
, Text -> Text -> Element
xmlLeaf Text
"link" (RSSTextInput -> Text
rssTextInputLink RSSTextInput
ti)
] [Element] -> [Element] -> [Element]
forall a. [a] -> [a] -> [a]
++
RSSTextInput -> [Element]
rssTextInputOther RSSTextInput
ti))
{elementAttributes = rssTextInputAttrs ti}
xmlSkipHours :: [Integer] -> XML.Element
xmlSkipHours :: [Integer] -> Element
xmlSkipHours [Integer]
hs =
Text -> [Node] -> Element
qualNode Text
"skipHours" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ (Integer -> Node) -> [Integer] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node) -> (Integer -> Element) -> Integer -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Integer
n -> Text -> Text -> Element
xmlLeaf Text
"hour" (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n))) [Integer]
hs
xmlSkipDays :: [Text] -> XML.Element
xmlSkipDays :: [Text] -> Element
xmlSkipDays [Text]
hs = Text -> [Node] -> Element
qualNode Text
"skipDays" ([Node] -> Element) -> [Node] -> Element
forall a b. (a -> b) -> a -> b
$ (Text -> Node) -> [Text] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node) -> (Text -> Element) -> Text -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Element
xmlLeaf Text
"day") [Text]
hs
xmlAttr :: Text -> Text -> Attr
xmlAttr :: Text -> Text -> (Name, [Content])
xmlAttr Text
k = Name -> Text -> (Name, [Content])
mkNAttr (Text -> Name
qualName Text
k)
xmlLeaf :: Text -> Text -> XML.Element
xmlLeaf :: Text -> Text -> Element
xmlLeaf Text
tg Text
txt =
Element
{ elementAttributes :: [(Name, [Content])]
elementAttributes = []
, elementName :: Name
elementName = Text -> Maybe Text -> Maybe Text -> Name
Name Text
tg Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
, elementNodes :: [Node]
elementNodes = [Content -> Node
NodeContent (Text -> Content
ContentText Text
txt)]
}
mb :: (a -> b) -> Maybe a -> [b]
mb :: forall a b. (a -> b) -> Maybe a -> [b]
mb a -> b
_ Maybe a
Nothing = []
mb a -> b
f (Just a
x) = [a -> b
f a
x]