-------------------------------------------------------------------- -- | -- Module : Text.RSS1.Import -- Copyright : (c) Galois, Inc. 2008, -- (c) Sigbjorn Finne 2009- -- License : BSD3 -- -- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: portable -- -------------------------------------------------------------------- module Text.RSS1.Import ( elementToFeed ) where import Text.RSS1.Syntax import Text.RSS1.Utils import Text.XML.Light as XML import Text.DublinCore.Types import Data.Maybe (mapMaybe, fromMaybe) import Control.Monad (guard,mplus) --- elementToFeed :: XML.Element -> Maybe Feed elementToFeed e = do guard (elName e == rdfName "RDF") ver <- pAttr (Nothing,Nothing) "xmlns" e `mplus` rss10NS ch <- pNode "channel" e >>= elementToChannel let mbImg = pNode "image" e >>= elementToImage let is = fromMaybe [] $ fmap elementToItems $ pNode "items" e let mbTI = pNode "textinput" e >>= elementToTextInput let ch1 = ch{channelItemURIs = is} let its = pMany (rss10NS,Nothing) "item" elementToItem e let es_rest = removeKnownElts e let as_rest = removeKnownAttrs 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 e = seqLeaves e elementToTextInput :: XML.Element -> Maybe TextInputInfo elementToTextInput e = do let es = children e uri <- pAttr (rdfNS,rdfPrefix) "about" 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 = mapMaybe elementToDC es return $ TextInputInfo { textInputURI = uri , textInputTitle = ti , textInputDesc = desc , textInputName = na , textInputLink = li , textInputDC = dcs , textInputOther = es , textInputAttrs = elAttribs e } elementToItem :: XML.Element -> Maybe Item elementToItem e = do guard (elName e == qualName (rss10NS,Nothing) "item") let es = children e uri <- pAttr (rdfNS,rdfPrefix) "about" e ti <- pQLeaf (rss10NS,Nothing) "title" e li <- pQLeaf (rss10NS,Nothing) "link" e let desc= pQLeaf (rss10NS,Nothing) "description" e let dcs = mapMaybe elementToDC es let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e) let cs = mapMaybe elementToContent es let es_other = removeKnownElts e let as_other = removeKnownAttrs 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 e = do let es = children e let as = elAttribs e uri <- pAttr (rdfNS,rdfPrefix) "about" e ti <- pLeaf "title" e ur <- pLeaf "url" e li <- pLeaf "link" e let dcs = mapMaybe elementToDC es return Image { imageURI = uri , imageTitle = ti , imageURL = ur , imageLink = li , imageDC = dcs , imageOther = es , imageAttrs = as } elementToChannel :: XML.Element -> Maybe Channel elementToChannel e = do let es = children e uri <- pAttr (rdfNS,rdfPrefix) "about" e ti <- pLeaf "title" e li <- pLeaf "link" e de <- pLeaf "description" e let mbImg = pLeaf "image" e let is = case fmap seqLeaves $ pNode "items" e of Nothing -> [] Just ss -> ss let tinp = pLeaf "textinput" e let dcs = mapMaybe elementToDC es let tos = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e) let cs = mapMaybe elementToContent es let es_other = removeKnownElts e let as_other = removeKnownAttrs e let def_chan = Channel { channelURI = uri , channelTitle = ti , channelLink = li , channelDesc = de , channelImageURI = mbImg , channelItemURIs = is , channelTextInputURI = tinp , channelDC = dcs , channelUpdatePeriod = Nothing , channelUpdateFreq = Nothing , channelUpdateBase = Nothing , channelContent = cs , channelTopics = tos , channelOther = es_other , channelAttrs = as_other } return (addSyndication e def_chan) addSyndication :: XML.Element -> Channel -> Channel addSyndication e ch = ch{ channelUpdatePeriod = fmap toUpdatePeriod $ pQLeaf (synNS,synPrefix) "updatePeriod" e , channelUpdateFreq = fmap read $ pQLeaf (synNS,synPrefix) "updateFrequency" e , channelUpdateBase = pQLeaf (synNS,synPrefix) "updateBase" e } where toUpdatePeriod x = case x of "hourly" -> Update_Hourly "daily" -> Update_Daily "weekly" -> Update_Weekly "monthly" -> Update_Monthly "yearly" -> Update_Yearly _ -> Update_Hourly -- ToDo: whine elementToDC :: XML.Element -> Maybe DCItem elementToDC e = do guard (qURI (elName e) == dcNS) let dcItem x = DCItem{dcElt=x,dcText=strContent e} return $ dcItem $ case qName $ elName e of "title" -> DC_Title "creator" -> DC_Creator "subject" -> DC_Subject "description" -> DC_Description "publisher" -> DC_Publisher "contributor" -> DC_Contributor "date" -> DC_Date "type" -> DC_Type "format" -> DC_Format "identifier" -> DC_Identifier "source" -> DC_Source "language" -> DC_Language "relation" -> DC_Relation "coverage" -> DC_Coverage "rights" -> DC_Rights oth -> DC_Other oth elementToTaxonomyTopic :: XML.Element -> Maybe TaxonomyTopic elementToTaxonomyTopic e = do guard (elName e == qualName (taxNS,taxPrefix) "topic") let es = children e uri <- pAttr (rdfNS,rdfPrefix) "about" e li <- pQLeaf (taxNS,taxPrefix) "link" e return TaxonomyTopic { taxonomyURI = uri , taxonomyLink = li , taxonomyTitle = pLeaf "title" e , taxonomyDesc = pLeaf "description" e , taxonomyTopics = fromMaybe [] (fmap bagLeaves $ pQNode (qualName (taxNS,taxPrefix) "topics") e) , taxonomyDC = mapMaybe elementToDC es , taxonomyOther = es } elementToContent :: XML.Element -> Maybe ContentInfo elementToContent e = do guard (elName e == qualName (conNS,conPrefix) "items") return ContentInfo { contentURI = pAttr (rdfNS,rdfPrefix) "about" e , contentFormat = pQLeaf (conNS,conPrefix) "format" e , contentEncoding = pQLeaf (conNS,conPrefix) "encoding" e , contentValue = pQLeaf (rdfNS,rdfPrefix) "value" e } bagLeaves :: XML.Element -> [URIString] bagLeaves be = mapMaybe (\ e -> do guard (elName e == qualName (rdfNS,rdfPrefix) "li") pAttr (rdfNS,rdfPrefix) "resource" e `mplus` fmap strContent (pQNode (qualName (rdfNS,rdfPrefix) "li") e)) (fromMaybe [] $ fmap children $ pQNode (qualName (rdfNS,rdfPrefix) "Bag") be) {- bagElements :: XML.Element -> [XML.Element] bagElements be = mapMaybe (\ e -> do guard (elName e == rdfName "li") return e) (fromMaybe [] $ fmap children $ pQNode (rdfName "Bag") be) -} seqLeaves :: XML.Element -> [URIString] seqLeaves se = mapMaybe (\ e -> do guard (elName e == rdfName "li") return (strContent e)) (fromMaybe [] $ fmap children $ pQNode (rdfName "Seq") se)