--------------------------------------------------------------------
-- |
-- Module    : Text.Atom.Feed.Import
-- Copyright : (c) Galois, Inc. 2007-2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability:: portable
-- Description: Convert from XML to Atom
--
-- Convert from XML to Atom
--
--------------------------------------------------------------------
module Text.Atom.Feed.Import
  ( pNodes
  , pQNodes
  , pNode
  , pQNode
  , pLeaf
  , pQLeaf
  , pAttr
  , pAttrs
  , pQAttr
  , pMany
  , children
  , elementFeed
  , pTextContent
  , pPerson
  , pCategory
  , pGenerator
  , pSource
  , pLink
  , pEntry
  , pContent
  , pInReplyTotal
  , pInReplyTo
  ) where

import Prelude.Compat

import Control.Monad.Compat (guard, mplus)
import Data.List.Compat (find)
import Data.Maybe (isNothing, listToMaybe, mapMaybe)
import Data.Text (Text)
import Data.Text.Read
import Data.XML.Types as XML

import Text.Atom.Feed
import Text.Atom.Feed.Export (atomName, atomThreadName)

import qualified Data.Text as T

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
atomName 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 = ([Text] -> Text
T.concat ([Text] -> Text) -> (Element -> [Text]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Text]
elementText) (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 = ([Text] -> Text
T.concat ([Text] -> Text) -> (Element -> [Text]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Text]
elementText) (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 Element
e = (Name -> Element -> Maybe Text
`attributeText` Element
e) (Name -> Maybe Text) -> Maybe Name -> Maybe Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Name -> Bool) -> [Name] -> Maybe Name
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Name -> Bool
sameAtomAttr Text
x) (((Name, [Content]) -> Name) -> [(Name, [Content])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [Content]) -> Name
forall a b. (a, b) -> a
fst ([(Name, [Content])] -> [Name]) -> [(Name, [Content])] -> [Name]
forall a b. (a -> b) -> a -> b
$ Element -> [(Name, [Content])]
elementAttributes Element
e)

pAttrs :: Text -> XML.Element -> [Text]
pAttrs :: Text -> Element -> [Text]
pAttrs Text
x Element
e = [Text
t | ContentText Text
t <- [Content]
cnts]
  where
    cnts :: [Content]
cnts = [[Content]] -> [Content]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Content]
v | (Name
k, [Content]
v) <- Element -> [(Name, [Content])]
elementAttributes Element
e, Text -> Name -> Bool
sameAtomAttr Text
x Name
k]

sameAtomAttr :: Text -> Name -> Bool
sameAtomAttr :: Text -> Name -> Bool
sameAtomAttr Text
x Name
k = Name
k Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
ax Bool -> Bool -> Bool
|| (Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Name -> Maybe Text
nameNamespace Name
k) Bool -> Bool -> Bool
&& Name -> Text
nameLocalName Name
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
x)
  where
    ax :: Name
ax = Text -> Name
atomName Text
x

pQAttr :: Name -> XML.Element -> Maybe Text
pQAttr :: Name -> Element -> Maybe Text
pQAttr = Name -> Element -> Maybe Text
attributeText

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

elementTexts :: Element -> Text
elementTexts :: Element -> Text
elementTexts = [Text] -> Text
T.concat ([Text] -> Text) -> (Element -> [Text]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Text]
elementText

elementFeed :: XML.Element -> Maybe Feed
elementFeed :: Element -> Maybe Feed
elementFeed 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
atomName Text
"feed")
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
i <- Text -> [Element] -> Maybe Text
pLeaf Text
"id" [Element]
es
  TextContent
t <- Text -> [Element] -> Maybe TextContent
pTextContent Text
"title" [Element]
es Maybe TextContent -> Maybe TextContent -> Maybe TextContent
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` TextContent -> Maybe TextContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
TextString Text
"<no-title>")
  Text
u <- Text -> [Element] -> Maybe Text
pLeaf Text
"updated" [Element]
es
  Feed -> Maybe Feed
forall (m :: * -> *) a. Monad m => a -> m a
return
    Feed :: Text
-> TextContent
-> Text
-> [Person]
-> [Category]
-> [Person]
-> Maybe Generator
-> Maybe Text
-> [Link]
-> Maybe Text
-> Maybe TextContent
-> Maybe TextContent
-> [Entry]
-> [(Name, [Content])]
-> [Element]
-> Feed
Feed
      { feedId :: Text
feedId = Text
i
      , feedTitle :: TextContent
feedTitle = TextContent
t
      , feedSubtitle :: Maybe TextContent
feedSubtitle = Text -> [Element] -> Maybe TextContent
pTextContent Text
"subtitle" [Element]
es
      , feedUpdated :: Text
feedUpdated = Text
u
      , feedAuthors :: [Person]
feedAuthors = Text -> (Element -> Maybe Person) -> [Element] -> [Person]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
      , feedContributors :: [Person]
feedContributors = Text -> (Element -> Maybe Person) -> [Element] -> [Person]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"contributor" Element -> Maybe Person
pPerson [Element]
es
      , feedCategories :: [Category]
feedCategories = Text -> (Element -> Maybe Category) -> [Element] -> [Category]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe Category
pCategory [Element]
es
      , feedGenerator :: Maybe Generator
feedGenerator = Element -> Generator
pGenerator (Element -> Generator) -> Maybe Element -> Maybe Generator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> [Element] -> Maybe Element
pNode Text
"generator" [Element]
es
      , feedIcon :: Maybe Text
feedIcon = Text -> [Element] -> Maybe Text
pLeaf Text
"icon" [Element]
es
      , feedLogo :: Maybe Text
feedLogo = Text -> [Element] -> Maybe Text
pLeaf Text
"logo" [Element]
es
      , feedRights :: Maybe TextContent
feedRights = Text -> [Element] -> Maybe TextContent
pTextContent Text
"rights" [Element]
es
      , feedLinks :: [Link]
feedLinks = Text -> (Element -> Maybe Link) -> [Element] -> [Link]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"link" Element -> Maybe Link
pLink [Element]
es
      , feedEntries :: [Entry]
feedEntries = Text -> (Element -> Maybe Entry) -> [Element] -> [Entry]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"entry" Element -> Maybe Entry
pEntry [Element]
es
      , feedOther :: [Element]
feedOther = [Element] -> [Element]
other_es [Element]
es
      , feedAttrs :: [(Name, [Content])]
feedAttrs = [(Name, [Content])] -> [(Name, [Content])]
forall b. [(Name, b)] -> [(Name, b)]
other_as (Element -> [(Name, [Content])]
elementAttributes Element
e)
      }
  where
    other_es :: [Element] -> [Element]
other_es = (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_elts) (Name -> Bool) -> (Element -> Name) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName)
    other_as :: [(Name, b)] -> [(Name, b)]
other_as = ((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
forall a. [a]
known_attrs) (Name -> Bool) -> ((Name, b) -> Name) -> (Name, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> Name
forall a b. (a, b) -> a
fst)
    -- let's have them all (including xml:base and xml:lang + xmlns: stuff)
    known_attrs :: [a]
known_attrs = []
    known_elts :: [Name]
known_elts =
      (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map
        Text -> Name
atomName
        [ Text
"author"
        , Text
"category"
        , Text
"contributor"
        , Text
"generator"
        , Text
"icon"
        , Text
"id"
        , Text
"link"
        , Text
"logo"
        , Text
"rights"
        , Text
"subtitle"
        , Text
"title"
        , Text
"updated"
        , Text
"entry"
        ]

pTextContent :: Text -> [XML.Element] -> Maybe TextContent
pTextContent :: Text -> [Element] -> Maybe TextContent
pTextContent Text
tag [Element]
es = do
  Element
e <- Text -> [Element] -> Maybe Element
pNode Text
tag [Element]
es
  case Text -> Element -> Maybe Text
pAttr Text
"type" Element
e of
    Maybe Text
Nothing -> TextContent -> Maybe TextContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
TextString (Element -> Text
elementTexts Element
e))
    Just Text
"text" -> TextContent -> Maybe TextContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
TextString (Element -> Text
elementTexts Element
e))
    Just Text
"html" -> TextContent -> Maybe TextContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
HTMLString (Element -> Text
elementTexts Element
e))
    Just Text
"xhtml" ->
      case Element -> [Element]
children Element
e -- hmm...
            of
        [Element
c] -> TextContent -> Maybe TextContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> TextContent
XHTMLString Element
c)
        [Element]
_ -> Maybe TextContent
forall a. Maybe a
Nothing -- Multiple XHTML children.
    Maybe Text
_ -> Maybe TextContent
forall a. Maybe a
Nothing -- Unknown text content type.

pPerson :: XML.Element -> Maybe Person
pPerson :: Element -> Maybe Person
pPerson Element
e = do
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
name <- Text -> [Element] -> Maybe Text
pLeaf Text
"name" [Element]
es -- or missing "name"
  Person -> Maybe Person
forall (m :: * -> *) a. Monad m => a -> m a
return
    Person :: Text -> Maybe Text -> Maybe Text -> [Element] -> Person
Person
      { personName :: Text
personName = Text
name
      , personURI :: Maybe Text
personURI = Text -> [Element] -> Maybe Text
pLeaf Text
"uri" [Element]
es
      , personEmail :: Maybe Text
personEmail = Text -> [Element] -> Maybe Text
pLeaf Text
"email" [Element]
es
      , personOther :: [Element]
personOther = [] -- XXX?
      }

pCategory :: XML.Element -> Maybe Category
pCategory :: Element -> Maybe Category
pCategory Element
e = do
  Text
term <- Text -> Element -> Maybe Text
pAttr Text
"term" Element
e -- or missing "term" attribute
  Category -> Maybe Category
forall (m :: * -> *) a. Monad m => a -> m a
return
    Category :: Text -> Maybe Text -> Maybe Text -> [Element] -> Category
Category
      { catTerm :: Text
catTerm = Text
term
      , catScheme :: Maybe Text
catScheme = Text -> Element -> Maybe Text
pAttr Text
"scheme" Element
e
      , catLabel :: Maybe Text
catLabel = Text -> Element -> Maybe Text
pAttr Text
"label" Element
e
      , catOther :: [Element]
catOther = [] -- XXX?
      }

pGenerator :: XML.Element -> Generator
pGenerator :: Element -> Generator
pGenerator Element
e =
  Generator :: Maybe Text -> Maybe Text -> Text -> Generator
Generator {genURI :: Maybe Text
genURI = Text -> Element -> Maybe Text
pAttr Text
"href" Element
e, genVersion :: Maybe Text
genVersion = Text -> Element -> Maybe Text
pAttr Text
"version" Element
e, genText :: Text
genText = Element -> Text
elementTexts Element
e}

pSource :: XML.Element -> Source
pSource :: Element -> Source
pSource Element
e =
  let es :: [Element]
es = Element -> [Element]
children Element
e
   in Source :: [Person]
-> [Category]
-> Maybe Generator
-> Maybe Text
-> Maybe Text
-> [Link]
-> Maybe Text
-> Maybe TextContent
-> Maybe TextContent
-> Maybe TextContent
-> Maybe Text
-> [Element]
-> Source
Source
        { sourceAuthors :: [Person]
sourceAuthors = Text -> (Element -> Maybe Person) -> [Element] -> [Person]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
        , sourceCategories :: [Category]
sourceCategories = Text -> (Element -> Maybe Category) -> [Element] -> [Category]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe Category
pCategory [Element]
es
        , sourceGenerator :: Maybe Generator
sourceGenerator = Element -> Generator
pGenerator (Element -> Generator) -> Maybe Element -> Maybe Generator
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> [Element] -> Maybe Element
pNode Text
"generator" [Element]
es
        , sourceIcon :: Maybe Text
sourceIcon = Text -> [Element] -> Maybe Text
pLeaf Text
"icon" [Element]
es
        , sourceId :: Maybe Text
sourceId = Text -> [Element] -> Maybe Text
pLeaf Text
"id" [Element]
es
        , sourceLinks :: [Link]
sourceLinks = Text -> (Element -> Maybe Link) -> [Element] -> [Link]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"link" Element -> Maybe Link
pLink [Element]
es
        , sourceLogo :: Maybe Text
sourceLogo = Text -> [Element] -> Maybe Text
pLeaf Text
"logo" [Element]
es
        , sourceRights :: Maybe TextContent
sourceRights = Text -> [Element] -> Maybe TextContent
pTextContent Text
"rights" [Element]
es
        , sourceSubtitle :: Maybe TextContent
sourceSubtitle = Text -> [Element] -> Maybe TextContent
pTextContent Text
"subtitle" [Element]
es
        , sourceTitle :: Maybe TextContent
sourceTitle = Text -> [Element] -> Maybe TextContent
pTextContent Text
"title" [Element]
es
        , sourceUpdated :: Maybe Text
sourceUpdated = Text -> [Element] -> Maybe Text
pLeaf Text
"updated" [Element]
es
        , sourceOther :: [Element]
sourceOther = [] -- XXX ?
        }

pLink :: XML.Element -> Maybe Link
pLink :: Element -> Maybe Link
pLink Element
e = do
  Text
uri <- Text -> Element -> Maybe Text
pAttr Text
"href" Element
e
  Link -> Maybe Link
forall (m :: * -> *) a. Monad m => a -> m a
return
    Link :: Text
-> Maybe (Either Text Text)
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [(Name, [Content])]
-> [Element]
-> Link
Link
      { linkHref :: Text
linkHref = Text
uri
      , linkRel :: Maybe (Either Text Text)
linkRel = Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> Maybe Text -> Maybe (Either Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> Element -> Maybe Text
pAttr Text
"rel" Element
e
      , linkType :: Maybe Text
linkType = Text -> Element -> Maybe Text
pAttr Text
"type" Element
e
      , linkHrefLang :: Maybe Text
linkHrefLang = Text -> Element -> Maybe Text
pAttr Text
"hreflang" Element
e
      , linkTitle :: Maybe Text
linkTitle = Text -> Element -> Maybe Text
pAttr Text
"title" Element
e
      , linkLength :: Maybe Text
linkLength = Text -> Element -> Maybe Text
pAttr Text
"length" Element
e
      , linkAttrs :: [(Name, [Content])]
linkAttrs = [(Name, [Content])] -> [(Name, [Content])]
forall b. [(Name, b)] -> [(Name, b)]
other_as (Element -> [(Name, [Content])]
elementAttributes Element
e)
      , linkOther :: [Element]
linkOther = []
      }
  where
    other_as :: [(Name, b)] -> [(Name, b)]
other_as = ((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
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, b) -> Name) -> (Name, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> Name
forall a b. (a, b) -> a
fst)
    known_attrs :: [Name]
known_attrs = (Text -> Name) -> [Text] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Name
atomName [Text
"href", Text
"rel", Text
"type", Text
"hreflang", Text
"title", Text
"length"]

pEntry :: XML.Element -> Maybe Entry
pEntry :: Element -> Maybe Entry
pEntry Element
e = do
  let es :: [Element]
es = Element -> [Element]
children Element
e
  Text
i <- Text -> [Element] -> Maybe Text
pLeaf Text
"id" [Element]
es
  TextContent
t <- Text -> [Element] -> Maybe TextContent
pTextContent Text
"title" [Element]
es
  Text
u <- Text -> [Element] -> Maybe Text
pLeaf Text
"updated" [Element]
es Maybe Text -> Maybe Text -> Maybe Text
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> [Element] -> Maybe Text
pLeaf Text
"published" [Element]
es
  Entry -> Maybe Entry
forall (m :: * -> *) a. Monad m => a -> m a
return
    Entry :: Text
-> TextContent
-> Text
-> [Person]
-> [Category]
-> Maybe EntryContent
-> [Person]
-> [Link]
-> Maybe Text
-> Maybe TextContent
-> Maybe Source
-> Maybe TextContent
-> Maybe InReplyTo
-> Maybe InReplyTotal
-> [(Name, [Content])]
-> [Element]
-> Entry
Entry
      { entryId :: Text
entryId = Text
i
      , entryTitle :: TextContent
entryTitle = TextContent
t
      , entryUpdated :: Text
entryUpdated = Text
u
      , entryAuthors :: [Person]
entryAuthors = Text -> (Element -> Maybe Person) -> [Element] -> [Person]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
      , entryContributor :: [Person]
entryContributor = Text -> (Element -> Maybe Person) -> [Element] -> [Person]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"contributor" Element -> Maybe Person
pPerson [Element]
es
      , entryCategories :: [Category]
entryCategories = Text -> (Element -> Maybe Category) -> [Element] -> [Category]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe Category
pCategory [Element]
es
      , entryContent :: Maybe EntryContent
entryContent = Element -> Maybe EntryContent
pContent (Element -> Maybe EntryContent)
-> Maybe Element -> Maybe EntryContent
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> [Element] -> Maybe Element
pNode Text
"content" [Element]
es
      , entryLinks :: [Link]
entryLinks = Text -> (Element -> Maybe Link) -> [Element] -> [Link]
forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"link" Element -> Maybe Link
pLink [Element]
es
      , entryPublished :: Maybe Text
entryPublished = Text -> [Element] -> Maybe Text
pLeaf Text
"published" [Element]
es
      , entryRights :: Maybe TextContent
entryRights = Text -> [Element] -> Maybe TextContent
pTextContent Text
"rights" [Element]
es
      , entrySource :: Maybe Source
entrySource = Element -> Source
pSource (Element -> Source) -> Maybe Element -> Maybe Source
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Text -> [Element] -> Maybe Element
pNode Text
"source" [Element]
es
      , entrySummary :: Maybe TextContent
entrySummary = Text -> [Element] -> Maybe TextContent
pTextContent Text
"summary" [Element]
es
      , entryInReplyTo :: Maybe InReplyTo
entryInReplyTo = [Element] -> Maybe InReplyTo
pInReplyTo [Element]
es
      , entryInReplyTotal :: Maybe InReplyTotal
entryInReplyTotal = [Element] -> Maybe InReplyTotal
pInReplyTotal [Element]
es
      , entryAttrs :: [(Name, [Content])]
entryAttrs = [(Name, [Content])] -> [(Name, [Content])]
forall b. [(Name, b)] -> [(Name, b)]
other_as (Element -> [(Name, [Content])]
elementAttributes Element
e)
      , entryOther :: [Element]
entryOther = [] -- ?
      }
  where
    other_as :: [(Name, b)] -> [(Name, b)]
other_as = ((Name, b) -> Bool) -> [(Name, b)] -> [(Name, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
forall a. [a]
known_attrs) (Name -> Bool) -> ((Name, b) -> Name) -> (Name, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, b) -> Name
forall a b. (a, b) -> a
fst)
    -- let's have them all (including xml:base and xml:lang + xmlns: stuff)
    known_attrs :: [a]
known_attrs = []

pContent :: XML.Element -> Maybe EntryContent
pContent :: Element -> Maybe EntryContent
pContent Element
e =
  case Text -> Element -> Maybe Text
pAttr Text
"type" Element
e of
    Maybe Text
Nothing -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent (Element -> Text
elementTexts Element
e))
    Just Text
"text" -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent (Element -> Text
elementTexts Element
e))
    Just Text
"html" -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
HTMLContent (Element -> Text
elementTexts Element
e))
    Just Text
"xhtml" ->
      case Element -> [Element]
children Element
e of
        [] -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent Text
"")
        [Element
c] -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> EntryContent
XHTMLContent Element
c)
        [Element]
_ -> Maybe EntryContent
forall a. Maybe a
Nothing
    Just Text
ty ->
      case Text -> Element -> Maybe Text
pAttr Text
"src" Element
e of
        Maybe Text
Nothing -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> [Node] -> EntryContent
MixedContent (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ty) (Element -> [Node]
elementNodes Element
e))
        Just Text
uri -> EntryContent -> Maybe EntryContent
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Text -> EntryContent
ExternalContent (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ty) Text
uri)

pInReplyTotal :: [XML.Element] -> Maybe InReplyTotal
pInReplyTotal :: [Element] -> Maybe InReplyTotal
pInReplyTotal [Element]
es = do
  Text
t <- Name -> [Element] -> Maybe Text
pQLeaf (Text -> Name
atomThreadName Text
"total") [Element]
es
  case Reader Integer
forall a. Integral a => Reader a
decimal Text
t of
    Right (Integer
x, Text
_) -> do
      Element
n <- Name -> [Element] -> Maybe Element
pQNode (Text -> Name
atomThreadName Text
"total") [Element]
es
      InReplyTotal -> Maybe InReplyTotal
forall (m :: * -> *) a. Monad m => a -> m a
return InReplyTotal :: Integer -> [(Name, [Content])] -> InReplyTotal
InReplyTotal {replyToTotal :: Integer
replyToTotal = Integer
x, replyToTotalOther :: [(Name, [Content])]
replyToTotalOther = Element -> [(Name, [Content])]
elementAttributes Element
n}
    Either String (Integer, Text)
_ -> String -> Maybe InReplyTotal
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"

pInReplyTo :: [XML.Element] -> Maybe InReplyTo
pInReplyTo :: [Element] -> Maybe InReplyTo
pInReplyTo [Element]
es = do
  Element
t <- Name -> [Element] -> Maybe Element
pQNode (Text -> Name
atomThreadName Text
"reply-to") [Element]
es
  case Name -> Element -> Maybe Text
pQAttr (Text -> Name
atomThreadName Text
"ref") Element
t of
    Just Text
ref ->
      InReplyTo -> Maybe InReplyTo
forall (m :: * -> *) a. Monad m => a -> m a
return
        InReplyTo :: Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> [(Name, [Content])]
-> [Node]
-> InReplyTo
InReplyTo
          { replyToRef :: Text
replyToRef = Text
ref
          , replyToHRef :: Maybe Text
replyToHRef = Name -> Element -> Maybe Text
pQAttr (Text -> Name
atomThreadName Text
"href") Element
t
          , replyToType :: Maybe Text
replyToType = Name -> Element -> Maybe Text
pQAttr (Text -> Name
atomThreadName Text
"type") Element
t
          , replyToSource :: Maybe Text
replyToSource = Name -> Element -> Maybe Text
pQAttr (Text -> Name
atomThreadName Text
"source") Element
t
          , replyToOther :: [(Name, [Content])]
replyToOther = Element -> [(Name, [Content])]
elementAttributes Element
t -- ToDo: snip out matched ones.
          , replyToContent :: [Node]
replyToContent = Element -> [Node]
elementNodes Element
t
          }
    Maybe Text
_ -> String -> Maybe InReplyTo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"