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
|
--------------------------------------------------------------------
-- |
-- Module : Text.Feed.Translate
-- Copyright : (c) Galois, Inc. 2008
-- License : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@galois.com>
-- Stability : provisional
-- Portability:
--
--
-- Translating between RSS formats; work in progress.
--
module Text.Feed.Translate
( translateItemTo -- :: FeedKind -> Item -> Item
, withAtomEntry -- :: (Atom.Entry -> Atom.Entry) -> Item -> Item
, withRSSItem -- :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item
, withRSS1Item -- :: (RSS1.Item -> RSS1.Item) -> Item -> Item
) where
import Text.Feed.Types as Feed
import Text.Feed.Constructor
import Text.RSS.Syntax as RSS
import qualified Text.RSS1.Syntax as RSS1
import Text.Atom.Feed as Atom
import Data.Maybe ( fromMaybe )
-- functions for performing format-specific transformations.
-- If the item isn't in the of-interest format, no transformation
-- is performed (i.e., no on-the-fly translation into the requested
-- format is performed; the caller is responsible
--
withAtomEntry :: (Atom.Entry -> Atom.Entry) -> Item -> Item
withAtomEntry f it =
case it of
Feed.AtomItem e -> Feed.AtomItem (f e)
_ -> it
withRSSItem :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item
withRSSItem f it =
case it of
Feed.RSSItem e -> Feed.RSSItem (f e)
_ -> it
withRSS1Item :: (RSS1.Item -> RSS1.Item) -> Item -> Item
withRSS1Item f it =
case it of
Feed.RSS1Item e -> Feed.RSS1Item (f e)
_ -> it
translateItemTo :: FeedKind -> Item -> Item
translateItemTo fk it =
case fk of
AtomKind -> toAtomItem it
RSSKind v -> toRSSItem v it
RDFKind v -> toRDFItem v it
toRSSItem :: Maybe String -> Item -> Item
toRSSItem = error "toRSSItem: unimplemented"
toRDFItem :: Maybe String -> Item -> Item
toRDFItem = error "toRDFItem: unimplemented"
toAtomItem :: Item -> Item
toAtomItem it =
case it of
AtomItem{} -> it
RSS1Item{} -> error "toAtomItem: unimplemented (from RSS1 item rep.)"
XMLItem{} -> error "toAtomItem: unimplemented (from shallow XML rep.)"
Feed.RSSItem ri -> foldl (\ oi f -> f oi) outIt pipeline_rss_atom
where
outIt =
(flip withAtomEntry) (newItem AtomKind)
(\ e -> e{ Atom.entryOther = RSS.rssItemOther ri
, Atom.entryAttrs = RSS.rssItemAttrs ri
})
pipeline_rss_atom =
[ mb withItemTitle (rssItemTitle ri)
, mb withItemLink (rssItemLink ri)
, mb withItemDescription (rssItemDescription ri)
, mb withItemAuthor (rssItemAuthor ri)
, ls withItemCategories (rssItemCategories ri)
, mb withItemId' (rssItemGuid ri)
, mb withItemCommentLink (rssItemComments ri)
, mb withItemEnclosure' (rssItemEnclosure ri)
, mb withItemPubDate (rssItemPubDate ri)
]
withItemEnclosure' e =
withItemEnclosure (rssEnclosureURL e)
(Just $ rssEnclosureType e)
(rssEnclosureLength e)
withItemId' g = withItemId (fromMaybe True (rssGuidPermanentURL g)) (rssGuidValue g)
mb _ Nothing = id
mb f (Just v) = f v
ls _ [] = id
-- hack, only used for cats, so specialize:
ls f xs = f (map (\ c -> (rssCategoryValue c, rssCategoryDomain c)) xs)
{-
pipeline_rss_atom =
[ withItemTitle (rssItemTitle ri)
, withItemLink (rssLink ri)
, withDescription (rssDescription ri)
, \ inp -> mb (\ la -> inp{feedLanguage=...}) (rssLanguage ri)
, \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})
(rssEditor ri)
, \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})
(rssWebMaster ri)
, \ inp -> mb (\ pu -> withPubDate)
(rssPubDate ri)
, \ inp -> mb withLastUpdate
(rssLastUpdate ri)
, \ inp -> withCategories (map (\c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c))
(rssCategories ri)) inp
, \ inp -> mb withGenerator
(rssGenerator ri)
, rssDocs
, rssCloud
, rssTTL
, rssImage
, rssRating
, rssTextInput
, rssSkipHours
, rssSkipDays
}
in
-}
|
