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 .@ :: forall a. FromXML a => [Node] -> Text -> Either [Char] a
.@ Text
n = Text -> [Node] -> Either [Char] [Node]
findElement Text
n [Node]
ns forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromXML a => [Node] -> Either [Char] a
parseXML
(.@?) :: FromXML a => [Node] -> Text -> Either String (Maybe a)
[Node]
ns .@? :: forall a. FromXML a => [Node] -> Text -> Either [Char] (Maybe a)
.@? Text
n =
case Text -> [Node] -> Either [Char] [Node]
findElement Text
n [Node]
ns of
Left [Char]
_ -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
Right [Node]
xs -> forall a. FromXML a => [Node] -> Either [Char] a
parseXML [Node]
xs
infixr 7 @=, @@=
(@=) :: ToXML a => Name -> a -> XML
Name
n @= :: forall a. ToXML a => Name -> a -> XML
@= a
x =
case forall a. ToXML a => a -> XML
toXML a
x of
XML
XNull -> XML
XNull
XML
xs -> Node -> XML
XOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Node
NodeElement forall a b. (a -> b) -> a -> b
$ forall a. ToXML a => Name -> a -> Element
mkElement Name
n XML
xs
(@@=) :: ToText a => Name -> a -> XML
Name
n @@= :: forall a. ToText a => Name -> a -> XML
@@= a
x = Name -> Text -> XML
XAttr Name
n (forall a. ToText a => a -> Text
toText a
x)
decodeXML :: FromXML a => ByteStringLazy -> Either String a
decodeXML :: forall a. FromXML a => ByteStringLazy -> Either [Char] a
decodeXML ByteStringLazy
lbs =
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall a. Show a => a -> [Char]
show Document -> Element
documentRoot (ParseSettings -> ByteStringLazy -> Either SomeException Document
parseLBS forall a. Default a => a
def ByteStringLazy
lbs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromXML a => [Node] -> Either [Char] a
parseXML forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Node]
childrenOf
encodeXML :: ToElement a => a -> ByteStringLazy
encodeXML :: forall a. ToElement a => a -> ByteStringLazy
encodeXML a
x =
[ByteString] -> ByteStringLazy
LBS.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadUnliftIO m, MonadActive m) =>
Source m a -> m [a]
Conduit.Lazy.lazyConsume forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
Conduit.List.sourceList (Document -> [Event]
XML.Unresolved.toEvents Document
doc)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
Conduit..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
Conduit.List.map Event -> Event
rename
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
Conduit..| forall (m :: * -> *).
PrimMonad m =>
RenderSettings -> ConduitT Event ByteString m ()
XML.Stream.renderBytes forall a. Default a => a
def
where
doc :: Document
doc =
Document -> Document
toXMLDocument forall a b. (a -> b) -> a -> b
$
Document
{ documentRoot :: Element
documentRoot = Element
root,
documentEpilogue :: [Miscellaneous]
documentEpilogue = [],
documentPrologue :: Prologue
documentPrologue =
Prologue
{ prologueBefore :: [Miscellaneous]
prologueBefore = [],
prologueDoctype :: Maybe Doctype
prologueDoctype = 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) (forall a b. (a -> b) -> [a] -> [b]
map (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
| 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 = 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 [Char] [Node]
parseXML = forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance FromXML a => FromXML (Maybe a) where
parseXML :: [Node] -> Either [Char] (Maybe a)
parseXML [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
parseXML [Node]
ns = forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromXML a => [Node] -> Either [Char] a
parseXML [Node]
ns
instance FromXML Text where
parseXML :: [Node] -> Either [Char] Text
parseXML = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Node] -> Either [Char] (Maybe Text)
withContent [Char]
"Text"
instance FromXML Char where parseXML :: [Node] -> Either [Char] Char
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Char"
instance FromXML ByteString where parseXML :: [Node] -> Either [Char] ByteString
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"ByteString"
instance FromXML Int where parseXML :: [Node] -> Either [Char] Int
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Int"
instance FromXML Integer where parseXML :: [Node] -> Either [Char] Integer
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Integer"
instance FromXML Natural where parseXML :: [Node] -> Either [Char] Natural
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Natural"
instance FromXML Double where parseXML :: [Node] -> Either [Char] Double
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Double"
instance FromXML Bool where parseXML :: [Node] -> Either [Char] Bool
parseXML = forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
"Bool"
class ToElement a where
toElement :: a -> Element
instance ToElement Element where
toElement :: Element -> Element
toElement = forall a. a -> a
id
maybeElement :: ToElement a => a -> Maybe Element
maybeElement :: forall a. ToElement a => a -> Maybe Element
maybeElement a
x =
case forall a. ToElement a => a -> Element
toElement a
x of
e :: Element
e@(Element Name
_ Map Name Text
_ [Node]
ns)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
ns -> forall a. Maybe a
Nothing
| Bool
otherwise -> forall a. a -> Maybe a
Just Element
e
data XML
= XNull
| XAttr Name Text
| XOne Node
| XMany [(Name, Text)] [Node]
deriving stock (Int -> XML -> ShowS
[XML] -> ShowS
XML -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [XML] -> ShowS
$cshowList :: [XML] -> ShowS
show :: XML -> [Char]
$cshow :: XML -> [Char]
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 forall a. Semigroup a => a -> a -> a
<> XML -> [(Name, Text)]
listXMLAttributes XML
b)
(XML -> [Node]
listXMLNodes XML
a 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 = 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 = forall a. a -> a
id
instance ToXML a => ToXML (Maybe a) where
toXML :: Maybe a -> XML
toXML (Just a
x) = forall a. ToXML a => a -> XML
toXML a
x
toXML Maybe a
Nothing = XML
XNull
instance ToXML Text where toXML :: Text -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML ByteString where toXML :: ByteString -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML Int where toXML :: Int -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML Integer where toXML :: Integer -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML Natural where toXML :: Natural -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML Double where toXML :: Double -> XML
toXML = forall a. ToText a => a -> XML
toXMLText
instance ToXML Bool where toXML :: Bool -> XML
toXML = 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 :: forall k v.
(Eq k, Hashable k, FromText k, FromXML v) =>
Text -> Text -> Text -> [Node] -> Either [Char] (HashMap k v)
parseXMLMap Text
e Text
k Text
v =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [Node] -> Either [Char] (k, v)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Node -> Maybe [Node]
childNodesOf Text
e)
where
f :: [Node] -> Either [Char] (k, v)
f [Node]
ns =
(,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Node]
ns forall a. FromXML a => [Node] -> Text -> Either [Char] a
.@ Text
k forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. FromText a => Text -> Either [Char] a
fromText)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Node]
ns forall a. FromXML a => [Node] -> Text -> Either [Char] a
.@ Text
v
parseXMLList1 ::
FromXML a =>
Text ->
[Node] ->
Either String (NonEmpty a)
parseXMLList1 :: forall a. FromXML a => Text -> [Node] -> Either [Char] (NonEmpty a)
parseXMLList1 Text
n = forall a. FromXML a => Text -> [Node] -> Either [Char] [a]
parseXMLList Text
n forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> [a] -> Either [Char] (NonEmpty a)
parse
where
parse :: [a] -> Either [Char] (NonEmpty a)
parse [a]
xs =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Error parsing empty List1 when expecting at least one element: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
n)
forall a b. b -> Either a b
Right
(forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
xs)
parseXMLList ::
FromXML a =>
Text ->
[Node] ->
Either String [a]
parseXMLList :: forall a. FromXML a => Text -> [Node] -> Either [Char] [a]
parseXMLList Text
n = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. FromXML a => [Node] -> Either [Char] a
parseXML forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. FromText a => [Char] -> [Node] -> Either [Char] a
parseXMLText [Char]
n =
[Char] -> [Node] -> Either [Char] (Maybe Text)
withContent [Char]
n
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"empty node list, when expecting single node " forall a. [a] -> [a] -> [a]
++ [Char]
n)
forall a. FromText a => Text -> Either [Char] a
fromText
toXMLList :: (IsList a, ToXML (Item a)) => Name -> a -> XML
toXMLList :: forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
toXMLList Name
n = [(Name, Text)] -> [Node] -> XML
XMany [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Element -> Node
NodeElement forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToXML a => Name -> a -> Element
mkElement Name
n) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l. IsList l => l -> [Item l]
toList
toXMLText :: ToText a => a -> XML
toXMLText :: forall a. ToText a => a -> XML
toXMLText = Node -> XML
XOne forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node
NodeContent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToText a => a -> Text
toText
mkElement :: ToXML a => Name -> a -> Element
mkElement :: forall a. ToXML a => Name -> a -> Element
mkElement Name
n (forall a. ToXML a => a -> XML
toXML -> XML
x) =
Name -> Map Name Text -> [Node] -> Element
Element Name
n (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 :: [Char] -> [Node] -> Either [Char] (Maybe Text)
withContent [Char]
k = \case
[] -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
[NodeContent Text
x] -> forall a b. b -> Either a b
Right (forall a. a -> Maybe a
Just Text
x)
[Node]
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"encountered many nodes, when expecting text: " forall a. [a] -> [a] -> [a]
++ [Char]
k
findElement :: Text -> [Node] -> Either String [Node]
findElement :: Text -> [Node] -> Either [Char] [Node]
findElement Text
n [Node]
ns =
forall a. Text -> [Node] -> Maybe a -> Either [Char] a
missingElement Text
n [Node]
ns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Text -> Node -> Maybe [Node]
childNodesOf Text
n) [Node]
ns
firstElement :: Text -> [Node] -> Either String [Node]
firstElement :: Text -> [Node] -> Either [Char] [Node]
firstElement Text
n [Node]
ns =
forall a. Text -> [Node] -> Maybe a -> Either [Char] a
missingElement Text
n [Node]
ns
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe
forall a b. (a -> b) -> a -> b
$ 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
| forall a. a -> Maybe a
Just Text
n forall a. Eq a => a -> a -> Bool
== Node -> Maybe Text
localName Node
x -> forall a. a -> Maybe a
Just (Element -> [Node]
childrenOf Element
e)
| Bool
otherwise -> forall a. [a] -> Maybe a
listToMaybe (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe [Node]
go (Element -> [Node]
elementNodes Element
e))
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
| forall a. a -> Maybe a
Just Text
n forall a. Eq a => a -> a -> Bool
== Node -> Maybe Text
localName Node
x ->
forall a. a -> Maybe a
Just (Element -> [Node]
childrenOf Element
e)
Node
_ -> forall a. Maybe a
Nothing
childrenOf :: Element -> [Node]
childrenOf :: Element -> [Node]
childrenOf Element
e = Element -> [Node]
elementNodes Element
e forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (Name, Text) -> Node
node (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) forall a. Monoid a => a
mempty [Text -> Node
NodeContent Text
v])
name :: Name -> Name
name Name
k =
Name
{ nameLocalName :: Text
nameLocalName = forall a. a -> Maybe a -> a
fromMaybe Text
"" (Name -> Maybe Text
namePrefix Name
k) forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Name -> Text
nameLocalName Name
k,
nameNamespace :: Maybe Text
nameNamespace = forall a. Monoid a => a
mempty,
namePrefix :: Maybe Text
namePrefix = forall a. Monoid a => a
mempty
}
localName :: Node -> Maybe Text
localName :: Node -> Maybe Text
localName = \case
NodeElement Element
e -> forall a. a -> Maybe a
Just (Name -> Text
nameLocalName (Element -> Name
elementName Element
e))
Node
_ -> forall a. Maybe a
Nothing
rootElementName :: ByteStringLazy -> Maybe Text
rootElementName :: ByteStringLazy -> Maybe Text
rootElementName ByteStringLazy
bs =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(forall a b. a -> b -> a
const forall a. Maybe a
Nothing)
(forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
nameLocalName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Name
elementName forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Element
documentRoot)
(ParseSettings -> ByteStringLazy -> Either SomeException Document
parseLBS forall a. Default a => a
def ByteStringLazy
bs)
missingElement :: Text -> [Node] -> Maybe a -> Either String a
missingElement :: forall a. Text -> [Node] -> Maybe a -> Either [Char] a
missingElement Text
n [Node]
ns = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left [Char]
err) forall a b. b -> Either a b
Right
where
err :: [Char]
err =
[Char]
"unable to find element "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
n
forall a. [a] -> [a] -> [a]
++ [Char]
" in nodes "
forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node -> Maybe Text
localName [Node]
ns)