module Text.RSS1.Import
( elementToFeed
) where
import Prelude.Compat
import Data.XML.Compat
import Data.XML.Types as XML
import Text.DublinCore.Types
import Text.RSS1.Syntax
import Text.RSS1.Utils
import Control.Monad.Compat (guard, mplus)
import Data.Maybe (mapMaybe)
import Data.Text.Util
elementToFeed :: XML.Element -> Maybe Feed
elementToFeed :: Element -> Maybe Feed
elementToFeed Element
e = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
rdfName Text
"RDF")
ver <- (Maybe Text, Maybe Text) -> Text -> Element -> Maybe Text
pAttr (Maybe Text
forall a. Maybe a
Nothing, Maybe Text
forall a. Maybe a
Nothing) Text
"xmlns" Element
e Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS
ch <- pNode "channel" e >>= elementToChannel
let mbImg = Text -> Element -> Maybe Element
pNode Text
"image" Element
e Maybe Element -> (Element -> Maybe Image) -> Maybe Image
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Image
elementToImage
let is = [Text] -> (Element -> [Text]) -> Maybe Element -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Text]
elementToItems (Maybe Element -> [Text]) -> Maybe Element -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Maybe Element
pNode Text
"items" Element
e
let mbTI = Text -> Element -> Maybe Element
pNode Text
"textinput" Element
e Maybe Element
-> (Element -> Maybe TextInputInfo) -> Maybe TextInputInfo
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe TextInputInfo
elementToTextInput
let ch1 = Channel
ch {channelItemURIs = is}
let its = (Maybe Text, Maybe Text)
-> Text -> (Element -> Maybe Item) -> Element -> [Item]
forall a.
(Maybe Text, Maybe Text)
-> Text -> (Element -> Maybe a) -> Element -> [a]
pMany (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS, Maybe Text
forall a. Maybe a
Nothing) Text
"item" Element -> Maybe Item
elementToItem Element
e
let es_rest = Element -> [Element]
removeKnownElts Element
e
let as_rest = Element -> [Attr]
removeKnownAttrs Element
e
return
Feed
{ feedVersion = ver
, feedChannel = ch1
, feedImage = mbImg
, feedItems = its
, feedTextInput = mbTI
, feedTopics =
mapMaybe elementToTaxonomyTopic $ pQNodes (qualName' (taxNS, taxPrefix) "topic") e
, feedOther = es_rest
, feedAttrs = as_rest
}
elementToItems :: XML.Element -> [URIString]
elementToItems :: Element -> [Text]
elementToItems = Element -> [Text]
seqLeaves
elementToTextInput :: XML.Element -> Maybe TextInputInfo
elementToTextInput :: Element -> Maybe TextInputInfo
elementToTextInput Element
e = do
let es :: [Element]
es = Element -> [Element]
children Element
e
uri <- (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
ti <- pQLeaf (rss10NS, Nothing) "title" e
desc <- pQLeaf (rss10NS, Nothing) "description" e
na <- pQLeaf (rss10NS, Nothing) "name" e
li <- pQLeaf (rss10NS, Nothing) "link" e
let dcs = (Element -> Maybe DCItem) -> [Element] -> [DCItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe DCItem
elementToDC [Element]
es
return
TextInputInfo
{ textInputURI = uri
, textInputTitle = ti
, textInputDesc = desc
, textInputName = na
, textInputLink = li
, textInputDC = dcs
, textInputOther = es
, textInputAttrs = elementAttributes e
}
elementToItem :: XML.Element -> Maybe Item
elementToItem :: Element -> Maybe Item
elementToItem Element
e = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Text, Maybe Text) -> Text -> Name
qualName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rss10NS, Maybe Text
forall a. Maybe a
Nothing) Text
"item")
let es :: [Element]
es = Element -> [Element]
children Element
e
uri <- (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
ti <- pQLeaf (rss10NS, Nothing) "title" e
li <- pQLeaf (rss10NS, Nothing) "link" e
let desc = (Text, Maybe Text) -> Text -> Element -> Maybe Text
pQLeaf (Text
rss10NS, Maybe Text
forall a. Maybe a
Nothing) Text
"description" Element
e
let dcs = (Element -> Maybe DCItem) -> [Element] -> [DCItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe DCItem
elementToDC [Element]
es
let tos = [Text] -> (Element -> [Text]) -> Maybe Element -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Text]
bagLeaves (Maybe Element -> [Text]) -> Maybe Element -> [Text]
forall a b. (a -> b) -> a -> b
$ Name -> Element -> Maybe Element
pQNode ((Text, Text) -> Text -> Name
qualName' (Text
taxNS, Text
taxPrefix) Text
"topics") Element
e
let cs = (Element -> Maybe ContentInfo) -> [Element] -> [ContentInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe ContentInfo
elementToContent [Element]
es
let es_other = Element -> [Element]
removeKnownElts Element
e
let as_other = Element -> [Attr]
removeKnownAttrs Element
e
return
Item
{ itemURI = uri
, itemTitle = ti
, itemLink = li
, itemDesc = desc
, itemDC = dcs
, itemTopics = tos
, itemContent = cs
, itemOther = es_other
, itemAttrs = as_other
}
elementToImage :: XML.Element -> Maybe Image
elementToImage :: Element -> Maybe Image
elementToImage Element
e = do
let es :: [Element]
es = Element -> [Element]
children Element
e
let as :: [Attr]
as = Element -> [Attr]
elementAttributes Element
e
uri <- (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
ti <- pLeaf "title" e
ur <- pLeaf "url" e
li <- pLeaf "link" e
let dcs = (Element -> Maybe DCItem) -> [Element] -> [DCItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe DCItem
elementToDC [Element]
es
return
Image
{ imageURI = uri
, imageTitle = ti
, imageURL = ur
, imageLink = li
, imageDC = dcs
, imageOther = es
, imageAttrs = as
}
elementToChannel :: XML.Element -> Maybe Channel
elementToChannel :: Element -> Maybe Channel
elementToChannel Element
e = do
let es :: [Element]
es = Element -> [Element]
children Element
e
uri <- (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
ti <- pLeaf "title" e
li <- pLeaf "link" e
de <- pLeaf "description" e
let mbImg = Text -> Element -> Maybe Text
pLeaf Text
"image" Element
e
let is = [Text] -> (Element -> [Text]) -> Maybe Element -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Text]
seqLeaves (Maybe Element -> [Text]) -> Maybe Element -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Element -> Maybe Element
pNode Text
"items" Element
e
let tinp = Text -> Element -> Maybe Text
pLeaf Text
"textinput" Element
e
let dcs = (Element -> Maybe DCItem) -> [Element] -> [DCItem]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe DCItem
elementToDC [Element]
es
let tos = [Text] -> (Element -> [Text]) -> Maybe Element -> [Text]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Text]
bagLeaves (Maybe Element -> [Text]) -> Maybe Element -> [Text]
forall a b. (a -> b) -> a -> b
$ Name -> Element -> Maybe Element
pQNode ((Text, Text) -> Text -> Name
qualName' (Text
taxNS, Text
taxPrefix) Text
"topics") Element
e
let cs = (Element -> Maybe ContentInfo) -> [Element] -> [ContentInfo]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe ContentInfo
elementToContent [Element]
es
let es_other = Element -> [Element]
removeKnownElts Element
e
let as_other = Element -> [Attr]
removeKnownAttrs Element
e
let def_chan =
Channel
{ channelURI :: Text
channelURI = Text
uri
, channelTitle :: Text
channelTitle = Text
ti
, channelLink :: Text
channelLink = Text
li
, channelDesc :: Text
channelDesc = Text
de
, channelImageURI :: Maybe Text
channelImageURI = Maybe Text
mbImg
, channelItemURIs :: [Text]
channelItemURIs = [Text]
is
, channelTextInputURI :: Maybe Text
channelTextInputURI = Maybe Text
tinp
, channelDC :: [DCItem]
channelDC = [DCItem]
dcs
, channelUpdatePeriod :: Maybe UpdatePeriod
channelUpdatePeriod = Maybe UpdatePeriod
forall a. Maybe a
Nothing
, channelUpdateFreq :: Maybe Integer
channelUpdateFreq = Maybe Integer
forall a. Maybe a
Nothing
, channelUpdateBase :: Maybe Text
channelUpdateBase = Maybe Text
forall a. Maybe a
Nothing
, channelContent :: [ContentInfo]
channelContent = [ContentInfo]
cs
, channelTopics :: [Text]
channelTopics = [Text]
tos
, channelOther :: [Element]
channelOther = [Element]
es_other
, channelAttrs :: [Attr]
channelAttrs = [Attr]
as_other
}
return (addSyndication e def_chan)
addSyndication :: XML.Element -> Channel -> Channel
addSyndication :: Element -> Channel -> Channel
addSyndication Element
e Channel
ch =
Channel
ch
{ channelUpdatePeriod = toUpdatePeriod <$> pQLeaf' (synNS, synPrefix) "updatePeriod" e
, channelUpdateFreq = readInt =<< pQLeaf' (synNS, synPrefix) "updateFrequency" e
, channelUpdateBase = pQLeaf' (synNS, synPrefix) "updateBase" e
}
where
toUpdatePeriod :: a -> UpdatePeriod
toUpdatePeriod a
x =
case a
x of
a
"hourly" -> UpdatePeriod
Update_Hourly
a
"daily" -> UpdatePeriod
Update_Daily
a
"weekly" -> UpdatePeriod
Update_Weekly
a
"monthly" -> UpdatePeriod
Update_Monthly
a
"yearly" -> UpdatePeriod
Update_Yearly
a
_ -> UpdatePeriod
Update_Hourly
elementToDC :: XML.Element -> Maybe DCItem
elementToDC :: Element -> Maybe DCItem
elementToDC Element
e = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Name -> Maybe Text
nameNamespace (Element -> Name
elementName Element
e) Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dcNS)
let dcItem :: DCInfo -> DCItem
dcItem DCInfo
x = DCItem {dcElt :: DCInfo
dcElt = DCInfo
x, dcText :: Text
dcText = Element -> Text
strContent Element
e}
DCItem -> Maybe DCItem
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (DCItem -> Maybe DCItem) -> DCItem -> Maybe DCItem
forall a b. (a -> b) -> a -> b
$
DCInfo -> DCItem
dcItem (DCInfo -> DCItem) -> DCInfo -> DCItem
forall a b. (a -> b) -> a -> b
$
case Name -> Text
nameLocalName (Name -> Text) -> Name -> Text
forall a b. (a -> b) -> a -> b
$ Element -> Name
elementName Element
e of
Text
"title" -> DCInfo
DC_Title
Text
"creator" -> DCInfo
DC_Creator
Text
"subject" -> DCInfo
DC_Subject
Text
"description" -> DCInfo
DC_Description
Text
"publisher" -> DCInfo
DC_Publisher
Text
"contributor" -> DCInfo
DC_Contributor
Text
"date" -> DCInfo
DC_Date
Text
"type" -> DCInfo
DC_Type
Text
"format" -> DCInfo
DC_Format
Text
"identifier" -> DCInfo
DC_Identifier
Text
"source" -> DCInfo
DC_Source
Text
"language" -> DCInfo
DC_Language
Text
"relation" -> DCInfo
DC_Relation
Text
"coverage" -> DCInfo
DC_Coverage
Text
"rights" -> DCInfo
DC_Rights
Text
oth -> Text -> DCInfo
DC_Other Text
oth
elementToTaxonomyTopic :: XML.Element -> Maybe TaxonomyTopic
elementToTaxonomyTopic :: Element -> Maybe TaxonomyTopic
elementToTaxonomyTopic Element
e = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Text -> Name
qualName' (Text
taxNS, Text
taxPrefix) Text
"topic")
let es :: [Element]
es = Element -> [Element]
children Element
e
uri <- (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
li <- pQLeaf' (taxNS, taxPrefix) "link" e
return
TaxonomyTopic
{ taxonomyURI = uri
, taxonomyLink = li
, taxonomyTitle = pLeaf "title" e
, taxonomyDesc = pLeaf "description" e
, taxonomyTopics = maybe [] bagLeaves $ pQNode (qualName' (taxNS, taxPrefix) "topics") e
, taxonomyDC = mapMaybe elementToDC es
, taxonomyOther = es
}
elementToContent :: XML.Element -> Maybe ContentInfo
elementToContent :: Element -> Maybe ContentInfo
elementToContent Element
e = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Text -> Name
qualName' (Text
conNS, Text
conPrefix) Text
"items")
ContentInfo -> Maybe ContentInfo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
ContentInfo
{ contentURI :: Maybe Text
contentURI = (Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"about" Element
e
, contentFormat :: Maybe Text
contentFormat = (Text, Text) -> Text -> Element -> Maybe Text
pQLeaf' (Text
conNS, Text
conPrefix) Text
"format" Element
e
, contentEncoding :: Maybe Text
contentEncoding = (Text, Text) -> Text -> Element -> Maybe Text
pQLeaf' (Text
conNS, Text
conPrefix) Text
"encoding" Element
e
, contentValue :: Maybe Text
contentValue = (Text, Text) -> Text -> Element -> Maybe Text
pQLeaf' (Text
rdfNS, Text
rdfPrefix) Text
"value" Element
e
}
bagLeaves :: XML.Element -> [URIString]
bagLeaves :: Element -> [Text]
bagLeaves Element
be =
(Element -> Maybe Text) -> [Element] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\Element
e -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== (Text, Text) -> Text -> Name
qualName' (Text
rdfNS, Text
rdfPrefix) Text
"li")
(Text, Text) -> Text -> Element -> Maybe Text
pAttr' (Text
rdfNS, Text
rdfPrefix) Text
"resource" Element
e Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
(Element -> Text) -> Maybe Element -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Text
strContent (Name -> Element -> Maybe Element
pQNode ((Text, Text) -> Text -> Name
qualName' (Text
rdfNS, Text
rdfPrefix) Text
"li") Element
e))
([Element] -> (Element -> [Element]) -> Maybe Element -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Element]
children (Maybe Element -> [Element]) -> Maybe Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Name -> Element -> Maybe Element
pQNode ((Text, Text) -> Text -> Name
qualName' (Text
rdfNS, Text
rdfPrefix) Text
"Bag") Element
be)
seqLeaves :: XML.Element -> [URIString]
seqLeaves :: Element -> [Text]
seqLeaves Element
se =
(Element -> Maybe Text) -> [Element] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
(\Element
e -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
rdfName Text
"li")
Text -> Maybe Text
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> Text
strContent Element
e))
([Element] -> (Element -> [Element]) -> Maybe Element -> [Element]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Element -> [Element]
children (Maybe Element -> [Element]) -> Maybe Element -> [Element]
forall a b. (a -> b) -> a -> b
$ Name -> Element -> Maybe Element
pQNode (Text -> Name
rdfName Text
"Seq") Element
se)