--------------------------------------------------------------------
-- |
-- 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> Name
atomName Text
x forall a. Eq a => a -> a -> 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((Name
x forall a. Eq a => a -> a -> 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 = 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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Text]
elementText) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Text]
elementText) 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) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Text -> Name -> Bool
sameAtomAttr Text
x) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst 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 = 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 forall a. Eq a => a -> a -> Bool
== Name
ax Bool -> Bool -> Bool
|| (forall a. Maybe a -> Bool
isNothing (Name -> Maybe Text
nameNamespace Name
k) Bool -> Bool -> Bool
&& Name -> Text
nameLocalName Name
k 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 :: forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
p Element -> Maybe a
f [Element]
es = 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 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
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Element -> Name
elementName Element
e 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 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` 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
  forall (m :: * -> *) a. Monad m => a -> m a
return
    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 = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
      , feedContributors :: [Person]
feedContributors = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"contributor" Element -> Maybe Person
pPerson [Element]
es
      , feedCategories :: [Category]
feedCategories = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe Category
pCategory [Element]
es
      , feedGenerator :: Maybe Generator
feedGenerator = Element -> Generator
pGenerator 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 = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"link" Element -> Maybe Link
pLink [Element]
es
      , feedEntries :: [Entry]
feedEntries = 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 = forall {b}. [(Name, b)] -> [(Name, b)]
other_as (Element -> [(Name, [Content])]
elementAttributes Element
e)
      }
  where
    other_es :: [Element] -> [Element]
other_es = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_elts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName)
    other_as :: [(Name, b)] -> [(Name, b)]
other_as = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall {a}. [a]
known_attrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
      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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
TextString (Element -> Text
elementTexts Element
e))
    Just Text
"text" -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TextContent
TextString (Element -> Text
elementTexts Element
e))
    Just Text
"html" -> 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> TextContent
XHTMLString Element
c)
        [Element]
_ -> forall a. Maybe a
Nothing -- Multiple XHTML children.
    Maybe Text
_ -> 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"
  forall (m :: * -> *) a. Monad m => a -> m a
return
    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
  forall (m :: * -> *) a. Monad m => a -> m a
return
    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 {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
        { sourceAuthors :: [Person]
sourceAuthors = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
        , sourceCategories :: [Category]
sourceCategories = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"category" Element -> Maybe Category
pCategory [Element]
es
        , sourceGenerator :: Maybe Generator
sourceGenerator = Element -> Generator
pGenerator 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 = 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
  forall (m :: * -> *) a. Monad m => a -> m a
return
    Link
      { linkHref :: Text
linkHref = Text
uri
      , linkRel :: Maybe (Either Text Text)
linkRel = forall a b. b -> Either a b
Right 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 = 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Name]
known_attrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
    known_attrs :: [Name]
known_attrs = 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 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Text -> [Element] -> Maybe Text
pLeaf Text
"published" [Element]
es
  forall (m :: * -> *) a. Monad m => a -> m a
return
    Entry
      { entryId :: Text
entryId = Text
i
      , entryTitle :: TextContent
entryTitle = TextContent
t
      , entryUpdated :: Text
entryUpdated = Text
u
      , entryAuthors :: [Person]
entryAuthors = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"author" Element -> Maybe Person
pPerson [Element]
es
      , entryContributor :: [Person]
entryContributor = forall a. Text -> (Element -> Maybe a) -> [Element] -> [a]
pMany Text
"contributor" Element -> Maybe Person
pPerson [Element]
es
      , entryCategories :: [Category]
entryCategories = 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 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 = 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 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 = 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 = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall {a}. [a]
known_attrs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent (Element -> Text
elementTexts Element
e))
    Just Text
"text" -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent (Element -> Text
elementTexts Element
e))
    Just Text
"html" -> 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
        [] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> EntryContent
TextContent Text
"")
        [Element
c] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> EntryContent
XHTMLContent Element
c)
        [Element]
_ -> forall a. Maybe a
Nothing
    Just Text
ty ->
      case Text -> Element -> Maybe Text
pAttr Text
"src" Element
e of
        Maybe Text
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> [Node] -> EntryContent
MixedContent (forall a. a -> Maybe a
Just Text
ty) (Element -> [Node]
elementNodes Element
e))
        Just Text
uri -> forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Text -> EntryContent
ExternalContent (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 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
      forall (m :: * -> *) a. Monad m => a -> m a
return InReplyTotal {replyToTotal :: Integer
replyToTotal = Integer
x, replyToTotalOther :: [(Name, [Content])]
replyToTotalOther = Element -> [(Name, [Content])]
elementAttributes Element
n}
    Either String (Integer, Text)
_ -> 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 ->
      forall (m :: * -> *) a. Monad m => a -> m a
return
        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
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no parse"