--------------------------------------------------------------------
-- |
-- Module    : Text.RSS1.Import
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
--------------------------------------------------------------------
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 -- ToDo: whine

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)

{-
bagElements :: XML.Element -> [XML.Element]
bagElements be =
  mapMaybe
    (\ e -> do
      guard (elementName e == rdfName "li")
      return e)
    (fromMaybe [] $ fmap children $ pQNode (rdfName "Bag") 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)