--------------------------------------------------------------------
-- |
-- Module    : Text.RSS.Import
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
--
-- Converting from XML to RSS
--
--------------------------------------------------------------------
module Text.RSS.Import
  ( pNodes
  , pQNodes
  , pNode
  , pQNode
  , pLeaf
  , pQLeaf
  , pAttr
  , pMany
  , children
  , qualName
  , dcName
  , elementToRSS
  , elementToChannel
  , elementToImage
  , elementToCategory
  , elementToCloud
  , elementToItem
  , elementToSource
  , elementToEnclosure
  , elementToGuid
  , elementToTextInput
  , elementToSkipHours
  , elementToSkipDays
  , readInt
  , readBool
  ) where

import Prelude.Compat

import Data.XML.Compat
import Data.XML.Types as XML

import Text.RSS.Syntax
import Text.RSS1.Utils (dcNS, dcPrefix)

import Control.Monad.Compat (guard, mplus)
import Data.Char (isSpace)
import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
import Data.Text (Text, dropWhile)
import Data.Text.Util

pNodes :: Text -> [XML.Element] -> [XML.Element]
pNodes :: Text -> [Element] -> [Element]
pNodes Text
x = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Name
qualName Text
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName)

pQNodes :: Name -> [XML.Element] -> [XML.Element]
pQNodes :: Name -> [Element] -> [Element]
pQNodes Name
x = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name
x Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
==) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName)

pNode :: Text -> [XML.Element] -> Maybe XML.Element
pNode :: Text -> [Element] -> Maybe Element
pNode Text
x [Element]
es = [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe (Text -> [Element] -> [Element]
pNodes Text
x [Element]
es)

pQNode :: Name -> [XML.Element] -> Maybe XML.Element
pQNode :: Name -> [Element] -> Maybe Element
pQNode Name
x [Element]
es = [Element] -> Maybe Element
forall a. [a] -> Maybe a
listToMaybe (Name -> [Element] -> [Element]
pQNodes Name
x [Element]
es)

pLeaf :: Text -> [XML.Element] -> Maybe Text
pLeaf :: Text -> [Element] -> Maybe Text
pLeaf Text
x [Element]
es = Element -> Text
strContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> [Element] -> Maybe Element
pNode Text
x [Element]
es

pQLeaf :: Name -> [XML.Element] -> Maybe Text
pQLeaf :: Name -> [Element] -> Maybe Text
pQLeaf Name
x [Element]
es = Element -> Text
strContent (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> [Element] -> Maybe Element
pQNode Name
x [Element]
es

pAttr :: Text -> XML.Element -> Maybe Text
pAttr :: Text -> Element -> Maybe Text
pAttr Text
x = Name -> Element -> Maybe Text
attributeText (Text -> Name
qualName Text
x)

pMany :: Text -> (XML.Element -> Maybe a) -> [XML.Element] -> [a]
pMany :: Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
p Element -> Maybe a
f [Element]
es = (Element -> Maybe a) -> [Element] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe a
f (Text -> [Element] -> [Element]
pNodes Text
p [Element]
es)

children :: XML.Element -> [XML.Element]
children :: Element -> [Element]
children = Element -> [Element]
elementChildren

qualName :: Text -> Name
qualName :: Text -> Name
qualName Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

dcName :: Text -> Name
dcName :: Text -> Name
dcName Text
x = Text -> Maybe Text -> Maybe Text -> Name
Name Text
x (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dcNS) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
dcPrefix)

elementToRSS :: XML.Element -> Maybe RSS
elementToRSS :: Element -> Maybe RSS
elementToRSS 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
qualName Text
"rss")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  Text
v <- Text -> Element -> Maybe Text
pAttr Text
"version" Element
e
  RSSChannel
ch <- Text -> [Element] -> Maybe Element
pNode Text
"channel" [Element]
es Maybe Element -> (Element -> Maybe RSSChannel) -> Maybe RSSChannel
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSChannel
elementToChannel
  RSS -> Maybe RSS
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSS :: Text -> [(Name, [Content])] -> RSSChannel -> [Element] -> RSS
RSS
      { rssVersion :: Text
rssVersion = Text
v
      , rssAttrs :: [(Name, [Content])]
rssAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_attrs) (Name -> Bool)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
forall a b. (a, b) -> a
fst) [(Name, [Content])]
as
      , rssChannel :: RSSChannel
rssChannel = RSSChannel
ch
      , rssOther :: [Element]
rssOther = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Element
e1 -> Element -> Name
elementName Element
e1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Name
qualName Text
"channel") [Element]
es
      }
  where
    known_attrs :: [Name]
known_attrs = [Name
"version"]

elementToChannel :: XML.Element -> Maybe RSSChannel
elementToChannel :: Element -> Maybe RSSChannel
elementToChannel 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
qualName Text
"channel")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
title <- Text -> [Element] -> Maybe Text
pLeaf Text
"title" [Element]
es
  Text
link <- Text -> [Element] -> Maybe Text
pLeaf Text
"link" [Element]
es
  RSSChannel -> Maybe RSSChannel
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSChannel :: Text
-> Text
-> Text
-> [RSSItem]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [RSSCategory]
-> Maybe Text
-> Maybe Text
-> Maybe RSSCloud
-> Maybe Integer
-> Maybe RSSImage
-> Maybe Text
-> Maybe RSSTextInput
-> Maybe [Integer]
-> Maybe [Text]
-> [Element]
-> RSSChannel
RSSChannel
      { rssTitle :: Text
rssTitle = Text
title
      , rssLink :: Text
rssLink = Text
link
        -- being liberal, <description/> is a required channel element.
      , rssDescription :: Text
rssDescription = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
title (Text -> [Element] -> Maybe Text
pLeaf Text
"description" [Element]
es)
      , rssItems :: [RSSItem]
rssItems = Text -> (Element -> Maybe RSSItem) -> [Element] -> [RSSItem]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"item" Element -> Maybe RSSItem
elementToItem [Element]
es
      , rssLanguage :: Maybe Text
rssLanguage = Text -> [Element] -> Maybe Text
pLeaf Text
"language" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"lang") [Element]
es
      , rssCopyright :: Maybe Text
rssCopyright = Text -> [Element] -> Maybe Text
pLeaf Text
"copyright" [Element]
es
      , rssEditor :: Maybe Text
rssEditor = Text -> [Element] -> Maybe Text
pLeaf Text
"managingEditor" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"creator") [Element]
es
      , rssWebMaster :: Maybe Text
rssWebMaster = Text -> [Element] -> Maybe Text
pLeaf Text
"webMaster" [Element]
es
      , rssPubDate :: Maybe Text
rssPubDate = Text -> [Element] -> Maybe Text
pLeaf Text
"pubDate" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"date") [Element]
es
      , rssLastUpdate :: Maybe Text
rssLastUpdate = Text -> [Element] -> Maybe Text
pLeaf Text
"lastBuildDate" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"date") [Element]
es
      , rssCategories :: [RSSCategory]
rssCategories = Text
-> (Element -> Maybe RSSCategory) -> [Element] -> [RSSCategory]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe RSSCategory
elementToCategory [Element]
es
      , rssGenerator :: Maybe Text
rssGenerator = Text -> [Element] -> Maybe Text
pLeaf Text
"generator" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"source") [Element]
es
      , rssDocs :: Maybe Text
rssDocs = Text -> [Element] -> Maybe Text
pLeaf Text
"docs" [Element]
es
      , rssCloud :: Maybe RSSCloud
rssCloud = Text -> [Element] -> Maybe Element
pNode Text
"cloud" [Element]
es Maybe Element -> (Element -> Maybe RSSCloud) -> Maybe RSSCloud
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSCloud
elementToCloud
      , rssTTL :: Maybe Integer
rssTTL = Text -> [Element] -> Maybe Text
pLeaf Text
"ttl" [Element]
es Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
readInt
      , rssImage :: Maybe RSSImage
rssImage = Text -> [Element] -> Maybe Element
pNode Text
"image" [Element]
es Maybe Element -> (Element -> Maybe RSSImage) -> Maybe RSSImage
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSImage
elementToImage
      , rssRating :: Maybe Text
rssRating = Text -> [Element] -> Maybe Text
pLeaf Text
"rating" [Element]
es
      , rssTextInput :: Maybe RSSTextInput
rssTextInput = Text -> [Element] -> Maybe Element
pNode Text
"textInput" [Element]
es Maybe Element
-> (Element -> Maybe RSSTextInput) -> Maybe RSSTextInput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSTextInput
elementToTextInput
      , rssSkipHours :: Maybe [Integer]
rssSkipHours = Text -> [Element] -> Maybe Element
pNode Text
"skipHours" [Element]
es Maybe Element -> (Element -> Maybe [Integer]) -> Maybe [Integer]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe [Integer]
elementToSkipHours
      , rssSkipDays :: Maybe [Text]
rssSkipDays = Text -> [Element] -> Maybe Element
pNode Text
"skipDays" [Element]
es Maybe Element -> (Element -> Maybe [Text]) -> Maybe [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe [Text]
elementToSkipDays
      , rssChannelOther :: [Element]
rssChannelOther = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_channel_elts) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) [Element]
es
      }
  where
    known_channel_elts :: [Name]
known_channel_elts =
      (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map
        Text -> Name
qualName
        [ Text
"title"
        , Text
"link"
        , Text
"description"
        , Text
"item"
        , Text
"language"
        , Text
"copyright"
        , Text
"managingEditor"
        , Text
"webMaster"
        , Text
"pubDate"
        , Text
"lastBuildDate"
        , Text
"category"
        , Text
"generator"
        , Text
"docs"
        , Text
"cloud"
        , Text
"ttl"
        , Text
"image"
        , Text
"rating"
        , Text
"textInput"
        , Text
"skipHours"
        , Text
"skipDays"
        ]

elementToImage :: XML.Element -> Maybe RSSImage
elementToImage :: Element -> Maybe RSSImage
elementToImage 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
qualName Text
"image")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
url <- Text -> [Element] -> Maybe Text
pLeaf Text
"url" [Element]
es
  Text
title <- Text -> [Element] -> Maybe Text
pLeaf Text
"title" [Element]
es
  Text
link <- Text -> [Element] -> Maybe Text
pLeaf Text
"link" [Element]
es
  RSSImage -> Maybe RSSImage
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSImage :: Text
-> Text
-> Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> [Element]
-> RSSImage
RSSImage
      { rssImageURL :: Text
rssImageURL = Text
url
      , rssImageTitle :: Text
rssImageTitle = Text
title
      , rssImageLink :: Text
rssImageLink = Text
link
      , rssImageWidth :: Maybe Integer
rssImageWidth = Text -> [Element] -> Maybe Text
pLeaf Text
"width" [Element]
es Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
readInt
      , rssImageHeight :: Maybe Integer
rssImageHeight = Text -> [Element] -> Maybe Text
pLeaf Text
"height" [Element]
es Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
readInt
      , rssImageDesc :: Maybe Text
rssImageDesc = Text -> [Element] -> Maybe Text
pLeaf Text
"description" [Element]
es
      , rssImageOther :: [Element]
rssImageOther = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_image_elts) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) [Element]
es
      }
  where
    known_image_elts :: [Name]
known_image_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
qualName [Text
"url", Text
"title", Text
"link", Text
"width", Text
"height", Text
"description"]

elementToCategory :: XML.Element -> Maybe RSSCategory
elementToCategory :: Element -> Maybe RSSCategory
elementToCategory 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
qualName Text
"category")
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  RSSCategory -> Maybe RSSCategory
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSCategory :: Maybe Text -> [(Name, [Content])] -> Text -> RSSCategory
RSSCategory
      { rssCategoryDomain :: Maybe Text
rssCategoryDomain = Text -> Element -> Maybe Text
pAttr Text
"domain" Element
e
      , rssCategoryAttrs :: [(Name, [Content])]
rssCategoryAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known_attrs) (Text -> Bool)
-> ((Name, [Content]) -> Text) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
attrKey) [(Name, [Content])]
as
      , rssCategoryValue :: Text
rssCategoryValue = Element -> Text
strContent Element
e
      }
  where
    known_attrs :: [Text]
known_attrs = [Text
"domain"]

elementToCloud :: XML.Element -> Maybe RSSCloud
elementToCloud :: Element -> Maybe RSSCloud
elementToCloud 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
qualName Text
"cloud")
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  RSSCloud -> Maybe RSSCloud
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSCloud :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [(Name, [Content])]
-> RSSCloud
RSSCloud
      { rssCloudDomain :: Maybe Text
rssCloudDomain = Text -> Element -> Maybe Text
pAttr Text
"domain" Element
e
      , rssCloudPort :: Maybe Text
rssCloudPort = Text -> Element -> Maybe Text
pAttr Text
"port" Element
e
      , rssCloudPath :: Maybe Text
rssCloudPath = Text -> Element -> Maybe Text
pAttr Text
"path" Element
e
      , rssCloudRegisterProcedure :: Maybe Text
rssCloudRegisterProcedure = Text -> Element -> Maybe Text
pAttr Text
"registerProcedure" Element
e
      , rssCloudProtocol :: Maybe Text
rssCloudProtocol = Text -> Element -> Maybe Text
pAttr Text
"protocol" Element
e
      , rssCloudAttrs :: [(Name, [Content])]
rssCloudAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known_attrs) (Text -> Bool)
-> ((Name, [Content]) -> Text) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
attrKey) [(Name, [Content])]
as
      }
  where
    known_attrs :: [Text]
known_attrs = [Text
"domain", Text
"port", Text
"path", Text
"registerProcedure", Text
"protocol"]

elementToItem :: XML.Element -> Maybe RSSItem
elementToItem :: Element -> Maybe RSSItem
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
== Text -> Name
qualName Text
"item")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  RSSItem -> Maybe RSSItem
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSItem :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [RSSCategory]
-> Maybe Text
-> Maybe Text
-> Maybe RSSEnclosure
-> Maybe RSSGuid
-> Maybe Text
-> Maybe RSSSource
-> [(Name, [Content])]
-> [Element]
-> RSSItem
RSSItem
      { rssItemTitle :: Maybe Text
rssItemTitle = Text -> [Element] -> Maybe Text
pLeaf Text
"title" [Element]
es
      , rssItemLink :: Maybe Text
rssItemLink = Text -> [Element] -> Maybe Text
pLeaf Text
"link" [Element]
es
      , rssItemDescription :: Maybe Text
rssItemDescription = Text -> [Element] -> Maybe Text
pLeaf Text
"description" [Element]
es
      , rssItemAuthor :: Maybe Text
rssItemAuthor = Text -> [Element] -> Maybe Text
pLeaf Text
"author" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"creator") [Element]
es
      , rssItemCategories :: [RSSCategory]
rssItemCategories = Text
-> (Element -> Maybe RSSCategory) -> [Element] -> [RSSCategory]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe RSSCategory
elementToCategory [Element]
es
      , rssItemComments :: Maybe Text
rssItemComments = Text -> [Element] -> Maybe Text
pLeaf Text
"comments" [Element]
es
      , rssItemContent :: Maybe Text
rssItemContent = Text -> [Element] -> Maybe Text
pLeaf Text
"content" [Element]
es
      , rssItemEnclosure :: Maybe RSSEnclosure
rssItemEnclosure = Text -> [Element] -> Maybe Element
pNode Text
"enclosure" [Element]
es Maybe Element
-> (Element -> Maybe RSSEnclosure) -> Maybe RSSEnclosure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSEnclosure
elementToEnclosure
      , rssItemGuid :: Maybe RSSGuid
rssItemGuid = Text -> [Element] -> Maybe Element
pNode Text
"guid" [Element]
es Maybe Element -> (Element -> Maybe RSSGuid) -> Maybe RSSGuid
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSGuid
elementToGuid
      , rssItemPubDate :: Maybe Text
rssItemPubDate = Text -> [Element] -> Maybe Text
pLeaf Text
"pubDate" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
dcName Text
"date") [Element]
es
      , rssItemSource :: Maybe RSSSource
rssItemSource = Text -> [Element] -> Maybe Element
pNode Text
"source" [Element]
es Maybe Element -> (Element -> Maybe RSSSource) -> Maybe RSSSource
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe RSSSource
elementToSource
      , rssItemAttrs :: [(Name, [Content])]
rssItemAttrs = Element -> [(Name, [Content])]
elementAttributes Element
e
      , rssItemOther :: [Element]
rssItemOther = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_item_elts) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) [Element]
es
      }
  where
    known_item_elts :: [Name]
known_item_elts =
      (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map
        Text -> Name
qualName
        [ Text
"title"
        , Text
"link"
        , Text
"description"
        , Text
"author"
        , Text
"category"
        , Text
"comments"
        , Text
"enclosure"
        , Text
"guid"
        , Text
"pubDate"
        , Text
"source"
        ]

elementToSource :: XML.Element -> Maybe RSSSource
elementToSource :: Element -> Maybe RSSSource
elementToSource 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
qualName Text
"source")
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  Text
url <- Text -> Element -> Maybe Text
pAttr Text
"url" Element
e
  RSSSource -> Maybe RSSSource
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSSource :: Text -> [(Name, [Content])] -> Text -> RSSSource
RSSSource
      { rssSourceURL :: Text
rssSourceURL = Text
url
      , rssSourceAttrs :: [(Name, [Content])]
rssSourceAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known_attrs) (Text -> Bool)
-> ((Name, [Content]) -> Text) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
attrKey) [(Name, [Content])]
as
      , rssSourceTitle :: Text
rssSourceTitle = Element -> Text
strContent Element
e
      }
  where
    known_attrs :: [Text]
known_attrs = [Text
"url"]

elementToEnclosure :: XML.Element -> Maybe RSSEnclosure
elementToEnclosure :: Element -> Maybe RSSEnclosure
elementToEnclosure 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
qualName Text
"enclosure")
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  Text
url <- Text -> Element -> Maybe Text
pAttr Text
"url" Element
e
  Text
ty <- Text -> Element -> Maybe Text
pAttr Text
"type" Element
e
  RSSEnclosure -> Maybe RSSEnclosure
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSEnclosure :: Text
-> Maybe Integer -> Text -> [(Name, [Content])] -> RSSEnclosure
RSSEnclosure
      { rssEnclosureURL :: Text
rssEnclosureURL = Text
url
      , rssEnclosureType :: Text
rssEnclosureType = Text
ty
      , rssEnclosureLength :: Maybe Integer
rssEnclosureLength = Text -> Element -> Maybe Text
pAttr Text
"length" Element
e Maybe Text -> (Text -> Maybe Integer) -> Maybe Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Integer
readInt
      , rssEnclosureAttrs :: [(Name, [Content])]
rssEnclosureAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known_attrs) (Text -> Bool)
-> ((Name, [Content]) -> Text) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
attrKey) [(Name, [Content])]
as
      }
  where
    known_attrs :: [Text]
known_attrs = [Text
"url", Text
"type", Text
"length"]

elementToGuid :: XML.Element -> Maybe RSSGuid
elementToGuid :: Element -> Maybe RSSGuid
elementToGuid 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
qualName Text
"guid")
  let as :: [(Name, [Content])]
as = Element -> [(Name, [Content])]
elementAttributes Element
e
  RSSGuid -> Maybe RSSGuid
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSGuid :: Maybe Bool -> [(Name, [Content])] -> Text -> RSSGuid
RSSGuid
      { rssGuidPermanentURL :: Maybe Bool
rssGuidPermanentURL = Text -> Element -> Maybe Text
pAttr Text
"isPermaLink" Element
e Maybe Text -> (Text -> Maybe Bool) -> Maybe Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Bool
readBool
      , rssGuidAttrs :: [(Name, [Content])]
rssGuidAttrs = ((Name, [Content]) -> Bool)
-> [(Name, [Content])] -> [(Name, [Content])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
known_attrs) (Text -> Bool)
-> ((Name, [Content]) -> Text) -> (Name, [Content]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text)
-> ((Name, [Content]) -> Name) -> (Name, [Content]) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, [Content]) -> Name
attrKey) [(Name, [Content])]
as
      , rssGuidValue :: Text
rssGuidValue = Element -> Text
strContent Element
e
      }
  where
    known_attrs :: [Text]
known_attrs = [Text
"isPermaLink"]

elementToTextInput :: XML.Element -> Maybe RSSTextInput
elementToTextInput :: Element -> Maybe RSSTextInput
elementToTextInput 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
qualName Text
"textInput")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
title <- Text -> [Element] -> Maybe Text
pLeaf Text
"title" [Element]
es
  Text
desc <- Text -> [Element] -> Maybe Text
pLeaf Text
"description" [Element]
es
  Text
name <- Text -> [Element] -> Maybe Text
pLeaf Text
"name" [Element]
es
  Text
link <- Text -> [Element] -> Maybe Text
pLeaf Text
"link" [Element]
es
  RSSTextInput -> Maybe RSSTextInput
forall (m :: * -> *) a. Monad m => a -> m a
return
    RSSTextInput :: Text
-> Text
-> Text
-> Text
-> [(Name, [Content])]
-> [Element]
-> RSSTextInput
RSSTextInput
      { rssTextInputTitle :: Text
rssTextInputTitle = Text
title
      , rssTextInputDesc :: Text
rssTextInputDesc = Text
desc
      , rssTextInputName :: Text
rssTextInputName = Text
name
      , rssTextInputLink :: Text
rssTextInputLink = Text
link
      , rssTextInputAttrs :: [(Name, [Content])]
rssTextInputAttrs = Element -> [(Name, [Content])]
elementAttributes Element
e
      , rssTextInputOther :: [Element]
rssTextInputOther = (Element -> Bool) -> [Element] -> [Element]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_ti_elts) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName) [Element]
es
      }
  where
    known_ti_elts :: [Name]
known_ti_elts = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
qualName [Text
"title", Text
"description", Text
"name", Text
"link"]

elementToSkipHours :: XML.Element -> Maybe [Integer]
elementToSkipHours :: Element -> Maybe [Integer]
elementToSkipHours 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
qualName Text
"skipHours")
     -- don't bother checking that this is below limit ( <= 24)
  [Integer] -> Maybe [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> (Element -> Maybe Integer) -> [Element] -> [Integer]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"hour" (Text -> Maybe Integer
readInt (Text -> Maybe Integer)
-> (Element -> Text) -> Element -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent) (Element -> [Element]
children Element
e))

elementToSkipDays :: XML.Element -> Maybe [Text]
elementToSkipDays :: Element -> Maybe [Text]
elementToSkipDays 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
qualName Text
"skipDays")
     -- don't bother checking that this is below limit ( <= 7)
  [Text] -> Maybe [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> (Element -> Maybe Text) -> [Element] -> [Text]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"day" (Text -> Maybe Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Maybe Text) -> (Element -> Text) -> Element -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
strContent) (Element -> [Element]
children Element
e))

----
readBool :: Text -> Maybe Bool
readBool :: Text -> Maybe Bool
readBool Text
s =
  case (Char -> Bool) -> Text -> Text
Data.Text.dropWhile Char -> Bool
isSpace Text
s of
    Text
"true" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
    Text
"false" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
    Text
_ -> Maybe Bool
forall a. Maybe a
Nothing