-- |
-- Module      : Amazonka.Data.XML
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.XML where

import Amazonka.Data.ByteString
import Amazonka.Data.Text
import Amazonka.Prelude
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Conduit as Conduit
import qualified Data.Conduit.Lazy as Conduit.Lazy
import qualified Data.Conduit.List as Conduit.List
import qualified Data.HashMap.Strict as HashMap
import qualified Data.List.NonEmpty as NonEmpty
import Data.XML.Types (Event (..))
import System.IO.Unsafe (unsafePerformIO)
import Text.XML
import qualified Text.XML.Stream.Render as XML.Stream
import qualified Text.XML.Unresolved as XML.Unresolved

infixl 7 .@, .@?

(.@) :: FromXML a => [Node] -> Text -> Either String a
[Node]
ns .@ :: [Node] -> Text -> Either String a
.@ Text
n = Text -> [Node] -> Either String [Node]
findElement Text
n [Node]
ns Either String [Node]
-> ([Node] -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML

(.@?) :: FromXML a => [Node] -> Text -> Either String (Maybe a)
[Node]
ns .@? :: [Node] -> Text -> Either String (Maybe a)
.@? Text
n =
  case Text -> [Node] -> Either String [Node]
findElement Text
n [Node]
ns of
    Left String
_ -> Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    Right [Node]
xs -> [Node] -> Either String (Maybe a)
forall a. FromXML a => [Node] -> Either String a
parseXML [Node]
xs

infixr 7 @=, @@=

(@=) :: ToXML a => Name -> a -> XML
Name
n @= :: Name -> a -> XML
@= a
x =
  case a -> XML
forall a. ToXML a => a -> XML
toXML a
x of
    XML
XNull -> XML
XNull
    XML
xs -> Node -> XML
XOne (Node -> XML) -> (Element -> Node) -> Element -> XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
NodeElement (Element -> XML) -> Element -> XML
forall a b. (a -> b) -> a -> b
$ Name -> XML -> Element
forall a. ToXML a => Name -> a -> Element
mkElement Name
n XML
xs

(@@=) :: ToText a => Name -> a -> XML
Name
n @@= :: Name -> a -> XML
@@= a
x = Name -> Text -> XML
XAttr Name
n (a -> Text
forall a. ToText a => a -> Text
toText a
x)

decodeXML :: FromXML a => ByteStringLazy -> Either String a
decodeXML :: ByteStringLazy -> Either String a
decodeXML ByteStringLazy
lbs =
  (SomeException -> String)
-> (Document -> Element)
-> Either SomeException Document
-> Either String Element
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap SomeException -> String
forall a. Show a => a -> String
show Document -> Element
documentRoot (ParseSettings -> ByteStringLazy -> Either SomeException Document
parseLBS ParseSettings
forall a. Default a => a
def ByteStringLazy
lbs)
    Either String Element
-> (Element -> Either String a) -> Either String a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML ([Node] -> Either String a)
-> (Element -> [Node]) -> Element -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Node]
childrenOf

-- The following is taken from xml-conduit.Text.XML which uses
-- unsafePerformIO anyway, with the following caveat:
--   'not generally safe, but we know that runResourceT
--    will not deallocate any of the resources being used
--    by the process.'
encodeXML :: ToElement a => a -> ByteStringLazy
encodeXML :: a -> ByteStringLazy
encodeXML a
x =
  [ByteString] -> ByteStringLazy
LBS.fromChunks ([ByteString] -> ByteStringLazy)
-> (Source IO ByteString -> [ByteString])
-> Source IO ByteString
-> ByteStringLazy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [ByteString] -> [ByteString]
forall a. IO a -> a
unsafePerformIO (IO [ByteString] -> [ByteString])
-> (Source IO ByteString -> IO [ByteString])
-> Source IO ByteString
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source IO ByteString -> IO [ByteString]
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
Conduit.Lazy.lazyConsume (Source IO ByteString -> ByteStringLazy)
-> Source IO ByteString -> ByteStringLazy
forall a b. (a -> b) -> a -> b
$
    [Event] -> ConduitT () Event IO ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
Conduit.List.sourceList (Document -> [Event]
XML.Unresolved.toEvents Document
doc)
      ConduitT () Event IO ()
-> ConduitM Event ByteString IO () -> Source IO ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
Conduit..| (Event -> Event) -> ConduitT Event Event IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
Conduit.List.map Event -> Event
rename
      ConduitT Event Event IO ()
-> ConduitM Event ByteString IO ()
-> ConduitM Event ByteString IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
Conduit..| RenderSettings -> ConduitM Event ByteString IO ()
forall (m :: * -> *).
PrimMonad m =>
RenderSettings -> ConduitT Event ByteString m ()
XML.Stream.renderBytes RenderSettings
forall a. Default a => a
def
  where
    doc :: Document
doc =
      Document -> Document
toXMLDocument (Document -> Document) -> Document -> Document
forall a b. (a -> b) -> a -> b
$
        Document :: Prologue -> Element -> [Miscellaneous] -> Document
Document
          { documentRoot :: Element
documentRoot = Element
root,
            documentEpilogue :: [Miscellaneous]
documentEpilogue = [],
            documentPrologue :: Prologue
documentPrologue =
              Prologue :: [Miscellaneous] -> Maybe Doctype -> [Miscellaneous] -> Prologue
Prologue
                { prologueBefore :: [Miscellaneous]
prologueBefore = [],
                  prologueDoctype :: Maybe Doctype
prologueDoctype = Maybe Doctype
forall a. Maybe a
Nothing,
                  prologueAfter :: [Miscellaneous]
prologueAfter = []
                }
          }

    rename :: Event -> Event
rename = \case
      EventBeginElement Name
n [(Name, [Content])]
xs -> Name -> [(Name, [Content])] -> Event
EventBeginElement (Name -> Name
f Name
n) (((Name, [Content]) -> (Name, [Content]))
-> [(Name, [Content])] -> [(Name, [Content])]
forall a b. (a -> b) -> [a] -> [b]
map ((Name -> Name) -> (Name, [Content]) -> (Name, [Content])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Name -> Name
f) [(Name, [Content])]
xs)
      EventEndElement Name
n -> Name -> Event
EventEndElement (Name -> Name
f Name
n)
      Event
evt -> Event
evt
      where
        f :: Name -> Name
f Name
n
          | Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Name -> Maybe Text
nameNamespace Name
n) = Name
n {nameNamespace :: Maybe Text
nameNamespace = Maybe Text
ns}
          | Bool
otherwise = Name
n

    ns :: Maybe Text
ns = Name -> Maybe Text
nameNamespace (Element -> Name
elementName Element
root)
    root :: Element
root = a -> Element
forall a. ToElement a => a -> Element
toElement a
x

class FromXML a where
  parseXML :: [Node] -> Either String a

instance FromXML [Node] where
  parseXML :: [Node] -> Either String [Node]
parseXML = [Node] -> Either String [Node]
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance FromXML a => FromXML (Maybe a) where
  parseXML :: [Node] -> Either String (Maybe a)
parseXML [] = Maybe a -> Either String (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseXML [Node]
ns = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML [Node]
ns

instance FromXML Text where
  parseXML :: [Node] -> Either String Text
parseXML = (Maybe Text -> Text)
-> Either String (Maybe Text) -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty) (Either String (Maybe Text) -> Either String Text)
-> ([Node] -> Either String (Maybe Text))
-> [Node]
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Node] -> Either String (Maybe Text)
withContent String
"Text"

instance FromXML Char where parseXML :: [Node] -> Either String Char
parseXML = String -> [Node] -> Either String Char
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Char"

instance FromXML ByteString where parseXML :: [Node] -> Either String ByteString
parseXML = String -> [Node] -> Either String ByteString
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"ByteString"

instance FromXML Int where parseXML :: [Node] -> Either String Int
parseXML = String -> [Node] -> Either String Int
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Int"

instance FromXML Integer where parseXML :: [Node] -> Either String Integer
parseXML = String -> [Node] -> Either String Integer
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Integer"

instance FromXML Natural where parseXML :: [Node] -> Either String Natural
parseXML = String -> [Node] -> Either String Natural
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Natural"

instance FromXML Double where parseXML :: [Node] -> Either String Double
parseXML = String -> [Node] -> Either String Double
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Double"

instance FromXML Bool where parseXML :: [Node] -> Either String Bool
parseXML = String -> [Node] -> Either String Bool
forall a. FromText a => String -> [Node] -> Either String a
parseXMLText String
"Bool"

class ToElement a where
  toElement :: a -> Element

instance ToElement Element where
  toElement :: Element -> Element
toElement = Element -> Element
forall a. a -> a
id

-- | Convert to an 'Element', only if the resulting element contains @> 0@ nodes.
maybeElement :: ToElement a => a -> Maybe Element
maybeElement :: a -> Maybe Element
maybeElement a
x =
  case a -> Element
forall a. ToElement a => a -> Element
toElement a
x of
    e :: Element
e@(Element Name
_ Map Name Text
_ [Node]
ns)
      | [Node] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
ns -> Maybe Element
forall a. Maybe a
Nothing
      | Bool
otherwise -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e

-- | Provides a way to make the operators for ToXML instance
-- declaration be consistent WRT to single nodes or lists of nodes.
data XML
  = XNull
  | XAttr Name Text
  | XOne Node
  | XMany [(Name, Text)] [Node]
  deriving stock (Int -> XML -> ShowS
[XML] -> ShowS
XML -> String
(Int -> XML -> ShowS)
-> (XML -> String) -> ([XML] -> ShowS) -> Show XML
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XML] -> ShowS
$cshowList :: [XML] -> ShowS
show :: XML -> String
$cshow :: XML -> String
showsPrec :: Int -> XML -> ShowS
$cshowsPrec :: Int -> XML -> ShowS
Show)

instance Semigroup XML where
  XML
XNull <> :: XML -> XML -> XML
<> XML
XNull = XML
XNull
  XML
a <> XML
XNull = XML
a
  XML
XNull <> XML
b = XML
b
  XML
a <> XML
b =
    [(Name, Text)] -> [Node] -> XML
XMany
      (XML -> [(Name, Text)]
listXMLAttributes XML
a [(Name, Text)] -> [(Name, Text)] -> [(Name, Text)]
forall a. Semigroup a => a -> a -> a
<> XML -> [(Name, Text)]
listXMLAttributes XML
b)
      (XML -> [Node]
listXMLNodes XML
a [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> XML -> [Node]
listXMLNodes XML
b)

instance Monoid XML where
  mempty :: XML
mempty = XML
XNull
  mappend :: XML -> XML -> XML
mappend = XML -> XML -> XML
forall a. Semigroup a => a -> a -> a
(<>)

listXMLNodes :: XML -> [Node]
listXMLNodes :: XML -> [Node]
listXMLNodes = \case
  XML
XNull -> []
  XAttr {} -> []
  XOne Node
n -> [Node
n]
  XMany [(Name, Text)]
_ [Node]
ns -> [Node]
ns

listXMLAttributes :: XML -> [(Name, Text)]
listXMLAttributes :: XML -> [(Name, Text)]
listXMLAttributes = \case
  XML
XNull -> []
  XAttr Name
n Text
t -> [(Name
n, Text
t)]
  XOne {} -> []
  XMany [(Name, Text)]
as [Node]
_ -> [(Name, Text)]
as

class ToXML a where
  toXML :: a -> XML

instance ToXML XML where
  toXML :: XML -> XML
toXML = XML -> XML
forall a. a -> a
id

instance ToXML a => ToXML (Maybe a) where
  toXML :: Maybe a -> XML
toXML (Just a
x) = a -> XML
forall a. ToXML a => a -> XML
toXML a
x
  toXML Maybe a
Nothing = XML
XNull

instance ToXML Text where toXML :: Text -> XML
toXML = Text -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML ByteString where toXML :: ByteString -> XML
toXML = ByteString -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML Int where toXML :: Int -> XML
toXML = Int -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML Integer where toXML :: Integer -> XML
toXML = Integer -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML Natural where toXML :: Natural -> XML
toXML = Natural -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML Double where toXML :: Double -> XML
toXML = Double -> XML
forall a. ToText a => a -> XML
toXMLText

instance ToXML Bool where toXML :: Bool -> XML
toXML = Bool -> XML
forall a. ToText a => a -> XML
toXMLText

parseXMLMap ::
  (Eq k, Hashable k, FromText k, FromXML v) =>
  Text ->
  Text ->
  Text ->
  [Node] ->
  Either String (HashMap k v)
parseXMLMap :: Text -> Text -> Text -> [Node] -> Either String (HashMap k v)
parseXMLMap Text
e Text
k Text
v =
  ([(k, v)] -> HashMap k v)
-> Either String [(k, v)] -> Either String (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList (Either String [(k, v)] -> Either String (HashMap k v))
-> ([Node] -> Either String [(k, v)])
-> [Node]
-> Either String (HashMap k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Node] -> Either String (k, v))
-> [[Node]] -> Either String [(k, v)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Node] -> Either String (k, v)
f ([[Node]] -> Either String [(k, v)])
-> ([Node] -> [[Node]]) -> [Node] -> Either String [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Maybe [Node]) -> [Node] -> [[Node]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Node -> Maybe [Node]
childNodesOf Text
e)
  where
    f :: [Node] -> Either String (k, v)
f [Node]
ns =
      (,)
        (k -> v -> (k, v))
-> Either String k -> Either String (v -> (k, v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Node]
ns [Node] -> Text -> Either String Text
forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
k Either String Text -> (Text -> Either String k) -> Either String k
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Either String k
forall a. FromText a => Text -> Either String a
fromText)
        Either String (v -> (k, v))
-> Either String v -> Either String (k, v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
ns [Node] -> Text -> Either String v
forall a. FromXML a => [Node] -> Text -> Either String a
.@ Text
v

parseXMLList1 ::
  FromXML a =>
  Text ->
  [Node] ->
  Either String (NonEmpty a)
parseXMLList1 :: Text -> [Node] -> Either String (NonEmpty a)
parseXMLList1 Text
n = Text -> [Node] -> Either String [a]
forall a. FromXML a => Text -> [Node] -> Either String [a]
parseXMLList Text
n ([Node] -> Either String [a])
-> ([a] -> Either String (NonEmpty a))
-> [Node]
-> Either String (NonEmpty a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [a] -> Either String (NonEmpty a)
parse
  where
    parse :: [a] -> Either String (NonEmpty a)
parse [a]
xs =
      Either String (NonEmpty a)
-> (NonEmpty a -> Either String (NonEmpty a))
-> Maybe (NonEmpty a)
-> Either String (NonEmpty a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (String -> Either String (NonEmpty a)
forall a b. a -> Either a b
Left (String -> Either String (NonEmpty a))
-> String -> Either String (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ String
"Error parsing empty List1 when expecting at least one element: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
n)
        NonEmpty a -> Either String (NonEmpty a)
forall a b. b -> Either a b
Right
        ([a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
xs)

parseXMLList ::
  FromXML a =>
  Text ->
  [Node] ->
  Either String [a]
parseXMLList :: Text -> [Node] -> Either String [a]
parseXMLList Text
n = ([Node] -> Either String a) -> [[Node]] -> Either String [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Node] -> Either String a
forall a. FromXML a => [Node] -> Either String a
parseXML ([[Node]] -> Either String [a])
-> ([Node] -> [[Node]]) -> [Node] -> Either String [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> Maybe [Node]) -> [Node] -> [[Node]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Node -> Maybe [Node]
childNodesOf Text
n)

parseXMLText :: FromText a => String -> [Node] -> Either String a
parseXMLText :: String -> [Node] -> Either String a
parseXMLText String
n =
  String -> [Node] -> Either String (Maybe Text)
withContent String
n
    ([Node] -> Either String (Maybe Text))
-> (Maybe Text -> Either String a) -> [Node] -> Either String a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Either String a
-> (Text -> Either String a) -> Maybe Text -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ String
"empty node list, when expecting single node " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n)
      Text -> Either String a
forall a. FromText a => Text -> Either String a
fromText

toXMLList :: (IsList a, ToXML (Item a)) => Name -> a -> XML
toXMLList :: Name -> a -> XML
toXMLList Name
n = [(Name, Text)] -> [Node] -> XML
XMany [] ([Node] -> XML) -> (a -> [Node]) -> a -> XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item a -> Node) -> [Item a] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement (Element -> Node) -> (Item a -> Element) -> Item a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Item a -> Element
forall a. ToXML a => Name -> a -> Element
mkElement Name
n) ([Item a] -> [Node]) -> (a -> [Item a]) -> a -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Item a]
forall l. IsList l => l -> [Item l]
toList

toXMLText :: ToText a => a -> XML
toXMLText :: a -> XML
toXMLText = Node -> XML
XOne (Node -> XML) -> (a -> Node) -> a -> XML
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
NodeContent (Text -> Node) -> (a -> Text) -> a -> Node
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToText a => a -> Text
toText

mkElement :: ToXML a => Name -> a -> Element
mkElement :: Name -> a -> Element
mkElement Name
n (a -> XML
forall a. ToXML a => a -> XML
toXML -> XML
x) =
  Name -> Map Name Text -> [Node] -> Element
Element Name
n ([Item (Map Name Text)] -> Map Name Text
forall l. IsList l => [Item l] -> l
fromList (XML -> [(Name, Text)]
listXMLAttributes XML
x)) (XML -> [Node]
listXMLNodes XML
x)

withContent :: String -> [Node] -> Either String (Maybe Text)
withContent :: String -> [Node] -> Either String (Maybe Text)
withContent String
k = \case
  [] -> Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right Maybe Text
forall a. Maybe a
Nothing
  [NodeContent Text
x] -> Maybe Text -> Either String (Maybe Text)
forall a b. b -> Either a b
Right (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x)
  [Node]
_ -> String -> Either String (Maybe Text)
forall a b. a -> Either a b
Left (String -> Either String (Maybe Text))
-> String -> Either String (Maybe Text)
forall a b. (a -> b) -> a -> b
$ String
"encountered many nodes, when expecting text: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
k

-- | Find a specific named NodeElement, at the current depth in the node tree.
--
-- Fails if absent.
findElement :: Text -> [Node] -> Either String [Node]
findElement :: Text -> [Node] -> Either String [Node]
findElement Text
n [Node]
ns =
  Text -> [Node] -> Maybe [Node] -> Either String [Node]
forall a. Text -> [Node] -> Maybe a -> Either String a
missingElement Text
n [Node]
ns
    (Maybe [Node] -> Either String [Node])
-> ([[Node]] -> Maybe [Node]) -> [[Node]] -> Either String [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> Maybe [Node]
forall a. [a] -> Maybe a
listToMaybe
    ([[Node]] -> Either String [Node])
-> [[Node]] -> Either String [Node]
forall a b. (a -> b) -> a -> b
$ (Node -> Maybe [Node]) -> [Node] -> [[Node]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Node -> Maybe [Node]
childNodesOf Text
n) [Node]
ns

-- | Find the first specific named NodeElement, at any depth in the node tree.
--
-- Fails if absent.
firstElement :: Text -> [Node] -> Either String [Node]
firstElement :: Text -> [Node] -> Either String [Node]
firstElement Text
n [Node]
ns =
  Text -> [Node] -> Maybe [Node] -> Either String [Node]
forall a. Text -> [Node] -> Maybe a -> Either String a
missingElement Text
n [Node]
ns
    (Maybe [Node] -> Either String [Node])
-> ([[Node]] -> Maybe [Node]) -> [[Node]] -> Either String [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> Maybe [Node]
forall a. [a] -> Maybe a
listToMaybe
    ([[Node]] -> Either String [Node])
-> [[Node]] -> Either String [Node]
forall a b. (a -> b) -> a -> b
$ (Node -> Maybe [Node]) -> [Node] -> [[Node]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe [Node]
go [Node]
ns
  where
    go :: Node -> Maybe [Node]
go Node
x = case Node
x of
      NodeElement Element
e
        | Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> Maybe Text
localName Node
x -> [Node] -> Maybe [Node]
forall a. a -> Maybe a
Just (Element -> [Node]
childrenOf Element
e)
        | Bool
otherwise -> [[Node]] -> Maybe [Node]
forall a. [a] -> Maybe a
listToMaybe ((Node -> Maybe [Node]) -> [Node] -> [[Node]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe [Node]
go (Element -> [Node]
elementNodes Element
e))
      Node
_ -> Maybe [Node]
forall a. Maybe a
Nothing

childNodesOf :: Text -> Node -> Maybe [Node]
childNodesOf :: Text -> Node -> Maybe [Node]
childNodesOf Text
n Node
x = case Node
x of
  NodeElement Element
e
    | Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Node -> Maybe Text
localName Node
x ->
      [Node] -> Maybe [Node]
forall a. a -> Maybe a
Just (Element -> [Node]
childrenOf Element
e)
  Node
_ -> Maybe [Node]
forall a. Maybe a
Nothing

childrenOf :: Element -> [Node]
childrenOf :: Element -> [Node]
childrenOf Element
e = Element -> [Node]
elementNodes Element
e [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> ((Name, Text) -> Node) -> [(Name, Text)] -> [Node]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Text) -> Node
node (Map Name Text -> [Item (Map Name Text)]
forall l. IsList l => l -> [Item l]
toList (Element -> Map Name Text
elementAttributes Element
e))
  where
    node :: (Name, Text) -> Node
node (Name
k, Text
v) = Element -> Node
NodeElement (Name -> Map Name Text -> [Node] -> Element
Element (Name -> Name
name Name
k) Map Name Text
forall a. Monoid a => a
mempty [Text -> Node
NodeContent Text
v])

    name :: Name -> Name
name Name
k =
      Name :: Text -> Maybe Text -> Maybe Text -> Name
Name
        { nameLocalName :: Text
nameLocalName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Name -> Maybe Text
namePrefix Name
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
nameLocalName Name
k,
          nameNamespace :: Maybe Text
nameNamespace = Maybe Text
forall a. Monoid a => a
mempty,
          namePrefix :: Maybe Text
namePrefix = Maybe Text
forall a. Monoid a => a
mempty
        }

localName :: Node -> Maybe Text
localName :: Node -> Maybe Text
localName = \case
  NodeElement Element
e -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Name -> Text
nameLocalName (Element -> Name
elementName Element
e))
  Node
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | An inefficient mechanism for retreiving the root
-- element name of an XML document.
rootElementName :: ByteStringLazy -> Maybe Text
rootElementName :: ByteStringLazy -> Maybe Text
rootElementName ByteStringLazy
bs =
  (SomeException -> Maybe Text)
-> (Document -> Maybe Text)
-> Either SomeException Document
-> Maybe Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (Maybe Text -> SomeException -> Maybe Text
forall a b. a -> b -> a
const Maybe Text
forall a. Maybe a
Nothing)
    (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (Document -> Text) -> Document -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName (Name -> Text) -> (Document -> Name) -> Document -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName (Element -> Name) -> (Document -> Element) -> Document -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Element
documentRoot)
    (ParseSettings -> ByteStringLazy -> Either SomeException Document
parseLBS ParseSettings
forall a. Default a => a
def ByteStringLazy
bs)

missingElement :: Text -> [Node] -> Maybe a -> Either String a
missingElement :: Text -> [Node] -> Maybe a -> Either String a
missingElement Text
n [Node]
ns = Either String a
-> (a -> Either String a) -> Maybe a -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String a
forall a b. a -> Either a b
Left String
err) a -> Either String a
forall a b. b -> Either a b
Right
  where
    err :: String
err =
      String
"unable to find element "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
n
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in nodes "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Text] -> String
forall a. Show a => a -> String
show ((Node -> Maybe Text) -> [Node] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Text
localName [Node]
ns)