1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
--------------------------------------------------------------------
-- |
-- Module : Text.RSS.Export
-- Copyright : (c) Galois, Inc. 2008
-- License : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Description: Convert from RSS to XML
--
--------------------------------------------------------------------
module Text.RSS.Export where
import Text.XML.Light as XML
import Text.RSS.Syntax
import Data.List
import Data.Maybe
qualNode :: String -> [XML.Content] -> XML.Element
qualNode n cs =
blank_element
{ elName = qualName n
, elContent = cs
}
qualName :: String -> QName
qualName n = QName{qName=n,qURI=Nothing,qPrefix=Nothing}
---
xmlRSS :: RSS -> XML.Element
xmlRSS r =
(qualNode "rss" $ map Elem $
( [ xmlChannel (rssChannel r) ]
++ rssOther r))
{ elAttribs = (Attr (qualName "version") (rssVersion r)):rssAttrs r }
xmlChannel :: RSSChannel -> XML.Element
xmlChannel ch =
(qualNode "channel" $ map Elem $
( [ xmlLeaf "title" (rssTitle ch)
, xmlLeaf "link" (rssLink ch)
, xmlLeaf "description" (rssDescription ch)
]
++ map xmlItem (rssItems ch)
++ mb (xmlLeaf "language") (rssLanguage ch)
++ mb (xmlLeaf "copyright") (rssCopyright ch)
++ mb (xmlLeaf "managingEditor") (rssEditor ch)
++ mb (xmlLeaf "webMaster") (rssWebMaster ch)
++ mb (xmlLeaf "pubDate") (rssPubDate ch)
++ mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch)
++ map xmlCategory (rssCategories ch)
++ mb (xmlLeaf "generator") (rssGenerator ch)
++ mb (xmlLeaf "docs") (rssDocs ch)
++ mb xmlCloud (rssCloud ch)
++ mb ((xmlLeaf "ttl") . show) (rssTTL ch)
++ mb xmlImage (rssImage ch)
++ mb (xmlLeaf "rating") (rssRating ch)
++ mb xmlTextInput (rssTextInput ch)
++ mb xmlSkipHours (rssSkipHours ch)
++ mb xmlSkipDays (rssSkipDays ch)
++ rssChannelOther ch))
xmlItem :: RSSItem -> XML.Element
xmlItem it =
(qualNode "item" $ map Elem $
( mb (xmlLeaf "title") (rssItemTitle it)
++ mb (xmlLeaf "link") (rssItemLink it)
++ mb (xmlLeaf "description") (rssItemDescription it)
++ mb (xmlLeaf "author") (rssItemAuthor it)
++ map xmlCategory (rssItemCategories it)
++ mb (xmlLeaf "comments") (rssItemComments it)
++ mb xmlEnclosure (rssItemEnclosure it)
++ mb xmlGuid (rssItemGuid it)
++ mb (xmlLeaf "pubDate") (rssItemPubDate it)
++ mb xmlSource (rssItemSource it)
++ rssItemOther it))
{ elAttribs = rssItemAttrs it }
xmlSource :: RSSSource -> XML.Element
xmlSource s =
(xmlLeaf "source" (rssSourceTitle s))
{ elAttribs = (Attr (qualName "url") (rssSourceURL s)) :
rssSourceAttrs s }
xmlEnclosure :: RSSEnclosure -> XML.Element
xmlEnclosure e =
(xmlLeaf "enclosure" "")
{ elAttribs =
(Attr (qualName "url") (rssEnclosureURL e)) :
(Attr (qualName "length") (show $ rssEnclosureLength e)) :
(Attr (qualName "type") (rssEnclosureType e)) :
rssEnclosureAttrs e }
xmlCategory :: RSSCategory -> XML.Element
xmlCategory c =
(xmlLeaf "category" (rssCategoryValue c))
{ elAttribs =
(fromMaybe id (fmap (\ n -> ((Attr (qualName "domain") n):))
(rssCategoryDomain c))) $
(rssCategoryAttrs c) }
xmlGuid :: RSSGuid -> XML.Element
xmlGuid g =
(xmlLeaf "guid" (rssGuidValue g))
{ elAttribs =
(fromMaybe id (fmap (\ n -> ((Attr (qualName "isPermaLink") (toBool n)):))
(rssGuidPermanentURL g))) $
(rssGuidAttrs g) }
where
toBool False = "false"
toBool _ = "true"
xmlImage :: RSSImage -> XML.Element
xmlImage im =
(qualNode "image" $ map Elem $
( [ xmlLeaf "url" (rssImageURL im)
, xmlLeaf "title" (rssImageTitle im)
, xmlLeaf "link" (rssImageLink im)
]
++ mb ((xmlLeaf "width") . show) (rssImageWidth im)
++ mb ((xmlLeaf "height") . show) (rssImageHeight im)
++ mb (xmlLeaf "description") (rssImageDesc im)
++ rssImageOther im))
xmlCloud :: RSSCloud -> XML.Element
xmlCloud cl =
(xmlLeaf "cloud" "")
{ elAttribs =
( mb (Attr (qualName "domain")) (rssCloudDomain cl)
++ mb (Attr (qualName "port")) (rssCloudPort cl)
++ mb (Attr (qualName "path")) (rssCloudPath cl)
++ mb (Attr (qualName "register")) (rssCloudRegister cl)
++ mb (Attr (qualName "protocol")) (rssCloudProtocol cl)
++ rssCloudAttrs cl) }
xmlTextInput :: RSSTextInput -> XML.Element
xmlTextInput ti =
(qualNode "textInput" $ map Elem $
( [ xmlLeaf "title" (rssTextInputTitle ti)
, xmlLeaf "description" (rssTextInputDesc ti)
, xmlLeaf "name" (rssTextInputName ti)
, xmlLeaf "link" (rssTextInputLink ti)
] ++ rssTextInputOther ti))
{ elAttribs = rssTextInputAttrs ti }
xmlSkipHours :: [Integer] -> XML.Element
xmlSkipHours hs =
(qualNode "skipHours" $ map Elem $
(map (\ n -> xmlLeaf "hour" (show n)) hs))
xmlSkipDays :: [String] -> XML.Element
xmlSkipDays hs =
(qualNode "skipDayss" $ map Elem $
(map (\ n -> xmlLeaf "day" n) hs))
--
xmlAttr :: String -> String -> XML.Attr
xmlAttr k v = Attr (qualName k) v
xmlLeaf :: String -> String -> XML.Element
xmlLeaf tg txt =
blank_element{ elName = qualName tg
, elContent = [ Text blank_cdata { cdData = txt } ]
}
---
mb :: (a -> b) -> Maybe a -> [b]
mb _ Nothing = []
mb f (Just x) = [f x]
|
