{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
module Text.RDF.RDF4H.XmlParser.Xmlbf
(
parse
, parseM
, ParserT
, parserT
, runParserT
, ParserState
, initialParserState
, pElement
, pAnyElement
, pName
, pAttr
, pAttrs
, pChildren
, pText
, pEndOfInput
, encode
, Node
, node
, pattern Element
, element
, element'
, pattern Text
, text
, text'
, dfpos
, dfposM
, dfpre
, dfpreM
, FromXml(fromXml)
, ToXml(toXml)
)
where
import Control.Applicative (Alternative(empty, (<|>)), liftA2)
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(mplus, mzero), join, when, ap)
import qualified Control.Monad.Catch as Ex
import Control.Monad.Error.Class (MonadError(catchError, throwError))
import Control.Monad.Cont (MonadCont(callCC))
import qualified Control.Monad.Fail
import Control.Monad.Fix (MonadFix(mfix))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Morph (MFunctor(hoist))
import Control.Monad.Reader.Class (MonadReader(local, ask))
import Control.Monad.State.Class (MonadState(state))
import Control.Monad.Trans (MonadTrans(lift))
import Control.Monad.Zip (MonadZip(mzipWith))
import Control.Selective (Selective(select))
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Builder.Prim as BBP
import qualified Data.Char as Char
import Data.Foldable (for_, toList)
import Data.Functor.Identity (Identity(Identity), runIdentity)
import qualified Data.HashMap.Strict as HM
import Data.Kind (Type)
#if MIN_VERSION_base(4,9,0)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup
#else
#endif
#else
#endif
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Traversable (for)
import Data.Word (Word8)
data Node
= Element' !T.Text !(HM.HashMap T.Text T.Text) ![Node]
| Text' !TL.Text
deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq)
instance NFData Node where
rnf :: Node -> ()
rnf = \case
Element' Text
n HashMap Text Text
as [Node]
cs -> Text -> ()
forall a. NFData a => a -> ()
rnf Text
n () -> () -> ()
forall a b. a -> b -> b
`seq` HashMap Text Text -> ()
forall a. NFData a => a -> ()
rnf HashMap Text Text
as () -> () -> ()
forall a b. a -> b -> b
`seq` [Node] -> ()
forall a. NFData a => a -> ()
rnf [Node]
cs () -> () -> ()
forall a b. a -> b -> b
`seq` ()
Text' Text
t -> Text -> ()
forall a. NFData a => a -> ()
rnf Text
t () -> () -> ()
forall a b. a -> b -> b
`seq` ()
{-# INLINABLE rnf #-}
instance Show Node where
showsPrec :: Int -> Node -> ShowS
showsPrec Int
n = \Node
x -> Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ case Node
x of
Text' Text
t -> String -> ShowS
showString String
"Text " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Text
t
Element' Text
t HashMap Text Text
as [Node]
cs ->
String -> ShowS
showString String
"Element " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 Text
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [(Text, Text)] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 (HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Text Text
as) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [Node] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
0 [Node]
cs
pattern Element :: T.Text -> HM.HashMap T.Text T.Text -> [Node] -> Node
pattern $mElement :: forall {r}.
Node
-> (Text -> HashMap Text Text -> [Node] -> r) -> ((# #) -> r) -> r
Element t as cs <- Element' t as cs
#if MIN_VERSION_base(4,10,0)
{-# COMPLETE Element #-}
#endif
pattern Text :: TL.Text -> Node
pattern $mText :: forall {r}. Node -> (Text -> r) -> ((# #) -> r) -> r
Text t <- Text' t
#if MIN_VERSION_base(4,10,0)
{-# COMPLETE Text #-}
#endif
node
:: (T.Text -> HM.HashMap T.Text T.Text -> [Node] -> a)
-> (TL.Text -> a)
-> Node
-> a
{-# INLINE node #-}
node :: forall a.
(Text -> HashMap Text Text -> [Node] -> a)
-> (Text -> a) -> Node -> a
node Text -> HashMap Text Text -> [Node] -> a
fe Text -> a
ft = \case
Text' Text
t -> Text -> a
ft Text
t
Element' Text
t HashMap Text Text
as [Node]
cs -> Text -> HashMap Text Text -> [Node] -> a
fe Text
t HashMap Text Text
as [Node]
cs
normalize :: [Node] -> [Node]
{-# INLINE normalize #-}
normalize :: [Node] -> [Node]
normalize = \case
Text' Text
"" : [Node]
ns -> [Node] -> [Node]
normalize [Node]
ns
Text' Text
a : Text' Text
b : [Node]
ns -> [Node] -> [Node]
normalize (Text -> [Node]
text (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b) [Node] -> [Node] -> [Node]
forall a. Semigroup a => a -> a -> a
<> [Node]
ns)
Text' Text
a : [Node]
ns -> Text -> Node
Text' Text
a Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node] -> [Node]
normalize [Node]
ns
Element' Text
t HashMap Text Text
as [Node]
cs : [Node]
ns -> Text -> HashMap Text Text -> [Node] -> Node
Element' Text
t HashMap Text Text
as ([Node] -> [Node]
normalize [Node]
cs) Node -> [Node] -> [Node]
forall a. a -> [a] -> [a]
: [Node] -> [Node]
normalize [Node]
ns
[] -> []
text
:: TL.Text
-> [Node]
{-# INLINE text #-}
text :: Text -> [Node]
text Text
t = case Text -> Either String Node
text' Text
t of
Right Node
x -> [Node
x]
Left String
_ -> []
text'
:: TL.Text
-> Either String Node
{-# INLINE text' #-}
text' :: Text -> Either String Node
text' = \case
Text
"" -> String -> Either String Node
forall a b. a -> Either a b
Left String
"Empty text"
Text
t -> Node -> Either String Node
forall a b. b -> Either a b
Right (Text -> Node
Text' Text
t)
element
:: T.Text
-> HM.HashMap T.Text T.Text
-> [Node]
-> [Node]
{-# INLINE element #-}
element :: Text -> HashMap Text Text -> [Node] -> [Node]
element Text
t HashMap Text Text
hm [Node]
ns = case Text -> HashMap Text Text -> [Node] -> Either String Node
element' Text
t HashMap Text Text
hm [Node]
ns of
Right Node
x -> [Node
x]
Left String
_ -> []
element'
:: T.Text
-> HM.HashMap T.Text T.Text
-> [Node]
-> Either String Node
element' :: Text -> HashMap Text Text -> [Node] -> Either String Node
element' Text
t0 HashMap Text Text
hm0 [Node]
ns0 = do
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
t0 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Text
T.strip Text
t0)
(String -> Either String ()
forall a b. a -> Either a b
Left (String
"Element name has surrounding whitespace: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t0))
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
t0)
(String -> Either String ()
forall a b. a -> Either a b
Left (String
"Element name is blank: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
t0))
[Text] -> (Text -> Either String ()) -> Either String ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HashMap Text Text -> [Text]
forall k v. HashMap k v -> [k]
HM.keys HashMap Text Text
hm0) ((Text -> Either String ()) -> Either String ())
-> (Text -> Either String ()) -> Either String ()
forall a b. (a -> b) -> a -> b
$ \Text
k -> do
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
k Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text -> Text
T.strip Text
k)
(String -> Either String ()
forall a b. a -> Either a b
Left (String
"Attribute name has surrounding whitespace: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k))
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
T.null Text
k)
(String -> Either String ()
forall a b. a -> Either a b
Left (String
"Attribute name is blank: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
k))
Node -> Either String Node
forall a b. b -> Either a b
Right (Text -> HashMap Text Text -> [Node] -> Node
Element' Text
t0 HashMap Text Text
hm0 ([Node] -> [Node]
normalize [Node]
ns0))
class FromXml a where
fromXml :: ParserT m a
data ParserState
= STop ![Node]
| SReg !T.Text !(HM.HashMap T.Text T.Text) ![Node]
initialParserState :: [Node] -> ParserState
initialParserState :: [Node] -> ParserState
initialParserState = [Node] -> ParserState
STop ([Node] -> ParserState)
-> ([Node] -> [Node]) -> [Node] -> ParserState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> [Node]
normalize
{-# INLINE initialParserState #-}
newtype ParserT (m :: Type -> Type) (a :: Type)
= ParserT (ParserState -> m (ParserState, Either String a))
parserT
:: (ParserState -> m (ParserState, Either String a))
-> ParserT m a
parserT :: forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
parserT = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT
{-# INLINE parserT #-}
runParserT
:: ParserT m a
-> ParserState
-> m (ParserState, Either String a)
runParserT :: forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (ParserT ParserState -> m (ParserState, Either String a)
f) = ParserState -> m (ParserState, Either String a)
f
{-# INLINE runParserT #-}
parseM
:: Applicative m
=> ParserT m a
-> [Node]
-> m (Either String a)
parseM :: forall (m :: * -> *) a.
Applicative m =>
ParserT m a -> [Node] -> m (Either String a)
parseM ParserT m a
p = ((ParserState, Either String a) -> Either String a)
-> m (ParserState, Either String a) -> m (Either String a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParserState, Either String a) -> Either String a
forall a b. (a, b) -> b
snd (m (ParserState, Either String a) -> m (Either String a))
-> ([Node] -> m (ParserState, Either String a))
-> [Node]
-> m (Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p (ParserState -> m (ParserState, Either String a))
-> ([Node] -> ParserState)
-> [Node]
-> m (ParserState, Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node] -> ParserState
initialParserState
{-# INLINE parseM #-}
parse
:: ParserT Identity a
-> [Node]
-> Either String a
parse :: forall a. ParserT Identity a -> [Node] -> Either String a
parse ParserT Identity a
p = Identity (Either String a) -> Either String a
forall a. Identity a -> a
runIdentity (Identity (Either String a) -> Either String a)
-> ([Node] -> Identity (Either String a))
-> [Node]
-> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT Identity a -> [Node] -> Identity (Either String a)
forall (m :: * -> *) a.
Applicative m =>
ParserT m a -> [Node] -> m (Either String a)
parseM ParserT Identity a
p
{-# INLINE parse #-}
#if MIN_VERSION_base(4,9,0)
instance (Monad m, Semigroup a) => Semigroup (ParserT m a) where
<> :: ParserT m a -> ParserT m a -> ParserT m a
(<>) = (a -> a -> a) -> ParserT m a -> ParserT m a -> ParserT m a
forall a b c.
(a -> b -> c) -> ParserT m a -> ParserT m b -> ParserT m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE (<>) #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance (Monad m, Monoid a, Semigroup a) => Monoid (ParserT m a) where
#else
instance (Monad m, Monoid a) => Monoid (ParserT m a) where
#endif
mempty :: ParserT m a
mempty = a -> ParserT m a
forall a. a -> ParserT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
#if MIN_VERSION_base(4,9,0)
mappend :: ParserT m a -> ParserT m a -> ParserT m a
mappend = ParserT m a -> ParserT m a -> ParserT m a
forall a. Semigroup a => a -> a -> a
(<>)
#else
mappend = liftA2 mappend
#endif
{-# INLINE mappend #-}
instance Functor m => Functor (ParserT m) where
fmap :: forall a b. (a -> b) -> ParserT m a -> ParserT m b
fmap a -> b
f = \ParserT m a
pa -> (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> ((ParserState, Either String a) -> (ParserState, Either String b))
-> m (ParserState, Either String a)
-> m (ParserState, Either String b)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either String a -> Either String b)
-> (ParserState, Either String a) -> (ParserState, Either String b)
forall a b. (a -> b) -> (ParserState, a) -> (ParserState, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either String a -> Either String b
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) (ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
pa ParserState
s))
{-# INLINE fmap #-}
instance Monad m => Applicative (ParserT m) where
pure :: forall a. a -> ParserT m a
pure = \a
a -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, a -> Either String a
forall a b. b -> Either a b
Right a
a))
{-# INLINE pure #-}
<*> :: forall a b. ParserT m (a -> b) -> ParserT m a -> ParserT m b
(<*>) = ParserT m (a -> b) -> ParserT m a -> ParserT m b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
{-# INLINE (<*>) #-}
instance Monad m => Alternative (ParserT m) where
empty :: forall a. ParserT m a
empty = String -> ParserT m a
forall (m :: * -> *) a. Applicative m => String -> ParserT m a
pFail String
"empty"
{-# INLINE empty #-}
ParserT m a
pa <|> :: forall a. ParserT m a -> ParserT m a -> ParserT m a
<|> ParserT m a
pb = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 -> do
(ParserState
s1, Either String a
ea) <- ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
pa ParserState
s0
case Either String a
ea of
Right a
a -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, a -> Either String a
forall a b. b -> Either a b
Right a
a)
Left String
_ -> ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
pb ParserState
s0)
{-# INLINABLE (<|>) #-}
instance Monad m => Selective (ParserT m) where
select :: forall a b.
ParserT m (Either a b) -> ParserT m (a -> b) -> ParserT m b
select ParserT m (Either a b)
pe ParserT m (a -> b)
pf = (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 -> do
(ParserState
s1, Either String (Either a b)
eeab) <- ParserT m (Either a b)
-> ParserState -> m (ParserState, Either String (Either a b))
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m (Either a b)
pe ParserState
s0
case Either String (Either a b)
eeab of
Right (Right b
b) -> (ParserState, Either String b) -> m (ParserState, Either String b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, b -> Either String b
forall a b. b -> Either a b
Right b
b)
Right (Left a
a) -> ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (ParserT m (a -> b)
pf ParserT m (a -> b) -> ParserT m a -> ParserT m b
forall a b. ParserT m (a -> b) -> ParserT m a -> ParserT m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> ParserT m a
forall a. a -> ParserT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) ParserState
s1
Left String
msg -> (ParserState, Either String b) -> m (ParserState, Either String b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String b
forall a b. a -> Either a b
Left String
msg))
{-# INLINABLE select #-}
instance Monad m => Monad (ParserT m) where
return :: forall a. a -> ParserT m a
return = a -> ParserT m a
forall a. a -> ParserT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
ParserT m a
pa >>= :: forall a b. ParserT m a -> (a -> ParserT m b) -> ParserT m b
>>= a -> ParserT m b
kpb = (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 -> do
(ParserState
s1, Either String a
ea) <- ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
pa ParserState
s0
case Either String a
ea of
Right a
a -> ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ParserT m b
kpb a
a) ParserState
s1
Left String
msg -> (ParserState, Either String b) -> m (ParserState, Either String b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String b
forall a b. a -> Either a b
Left String
msg))
{-# INLINABLE (>>=) #-}
#if !MIN_VERSION_base(4,13,0)
fail = pFail
{-# INLINE fail #-}
#endif
#if MIN_VERSION_base(4,9,0)
instance Monad m => Control.Monad.Fail.MonadFail (ParserT m) where
fail :: forall a. String -> ParserT m a
fail = String -> ParserT m a
forall (m :: * -> *) a. Applicative m => String -> ParserT m a
pFail
{-# INLINE fail #-}
#endif
pFail :: Applicative m => String -> ParserT m a
pFail :: forall (m :: * -> *) a. Applicative m => String -> ParserT m a
pFail = \String
msg -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String a
forall a b. a -> Either a b
Left String
msg))
{-# INLINE pFail #-}
instance Monad m => MonadPlus (ParserT m) where
mzero :: forall a. ParserT m a
mzero = ParserT m a
forall a. ParserT m a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mzero #-}
mplus :: forall a. ParserT m a -> ParserT m a -> ParserT m a
mplus = ParserT m a -> ParserT m a -> ParserT m a
forall a. ParserT m a -> ParserT m a -> ParserT m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
{-# INLINE mplus #-}
instance MonadFix m => MonadFix (ParserT m) where
mfix :: forall a. (a -> ParserT m a) -> ParserT m a
mfix a -> ParserT m a
f =
let die :: String -> a
die = \String
msg -> String -> a
forall a. HasCallStack => String -> a
error (String
"mfix (ParserT): " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg)
in (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 ->
((ParserState, Either String a)
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a. (a -> m a) -> m a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (\ ~(ParserState
_s1, Either String a
ea) -> ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ParserT m a
f ((String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> a
forall {a}. String -> a
die a -> a
forall a. a -> a
id Either String a
ea)) ParserState
s0))
instance MonadZip m => MonadZip (ParserT m) where
mzipWith :: forall a b c.
(a -> b -> c) -> ParserT m a -> ParserT m b -> ParserT m c
mzipWith a -> b -> c
f ParserT m a
pa ParserT m b
pb = (ParserState -> m (ParserState, Either String c)) -> ParserT m c
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 -> do
(ParserState
s1, Either String a
ea) <- ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
pa ParserState
s0
case Either String a
ea of
Right a
a0 ->
(a
-> (ParserState, Either String b)
-> (ParserState, Either String c))
-> m a
-> m (ParserState, Either String b)
-> m (ParserState, Either String c)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (m :: * -> *) a b c.
MonadZip m =>
(a -> b -> c) -> m a -> m b -> m c
mzipWith (\a
a1 (ParserState
s2, Either String b
eb) -> (ParserState
s2, (b -> c) -> Either String b -> Either String c
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
f a
a1) Either String b
eb))
(a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a0) (ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m b
pb ParserState
s1)
Left String
msg -> (ParserState, Either String c) -> m (ParserState, Either String c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String c
forall a b. a -> Either a b
Left String
msg))
{-# INLINABLE mzipWith #-}
instance MonadTrans ParserT where
lift :: forall (m :: * -> *) a. Monad m => m a -> ParserT m a
lift = \m a
ma -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> m a
ma m a
-> (a -> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, a -> Either String a
forall a b. b -> Either a b
Right a
a))
{-# INLINE lift #-}
instance MFunctor ParserT where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ParserT m b -> ParserT n b
hoist forall a. m a -> n a
nat = \ParserT m b
p -> (ParserState -> n (ParserState, Either String b)) -> ParserT n b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> m (ParserState, Either String b)
-> n (ParserState, Either String b)
forall a. m a -> n a
nat (ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m b
p ParserState
s))
{-# INLINE hoist #-}
instance MonadIO m => MonadIO (ParserT m) where
liftIO :: forall a. IO a -> ParserT m a
liftIO = m a -> ParserT m a
forall (m :: * -> *) a. Monad m => m a -> ParserT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParserT m a) -> (IO a -> m a) -> IO a -> ParserT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
{-# INLINE liftIO #-}
instance MonadReader r m => MonadReader r (ParserT m) where
ask :: ParserT m r
ask = m r -> ParserT m r
forall (m :: * -> *) a. Monad m => m a -> ParserT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m r
forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE ask #-}
local :: forall a. (r -> r) -> ParserT m a -> ParserT m a
local r -> r
f = \ParserT m a
p -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> (r -> r)
-> m (ParserState, Either String a)
-> m (ParserState, Either String a)
forall a. (r -> r) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local r -> r
f (ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p ParserState
s))
{-# INLINE local #-}
instance MonadState s m => MonadState s (ParserT m) where
state :: forall a. (s -> (a, s)) -> ParserT m a
state = m a -> ParserT m a
forall (m :: * -> *) a. Monad m => m a -> ParserT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParserT m a)
-> ((s -> (a, s)) -> m a) -> (s -> (a, s)) -> ParserT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> (a, s)) -> m a
forall a. (s -> (a, s)) -> m a
forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state
{-# INLINE state #-}
instance MonadError e m => MonadError e (ParserT m) where
throwError :: forall a. e -> ParserT m a
throwError = m a -> ParserT m a
forall (m :: * -> *) a. Monad m => m a -> ParserT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParserT m a) -> (e -> m a) -> e -> ParserT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall a. e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
{-# INLINABLE throwError #-}
catchError :: forall a. ParserT m a -> (e -> ParserT m a) -> ParserT m a
catchError ParserT m a
ma e -> ParserT m a
h = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s ->
m (ParserState, Either String a)
-> (e -> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a. m a -> (e -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
ma ParserState
s)
(\e
e -> ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (e -> ParserT m a
h e
e) ParserState
s))
{-# INLINABLE catchError #-}
instance Ex.MonadThrow m => Ex.MonadThrow (ParserT m) where
throwM :: forall e a. (HasCallStack, Exception e) => e -> ParserT m a
throwM = m a -> ParserT m a
forall (m :: * -> *) a. Monad m => m a -> ParserT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ParserT m a) -> (e -> m a) -> e -> ParserT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> m a
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Ex.throwM
{-# INLINABLE throwM #-}
instance Ex.MonadCatch m => Ex.MonadCatch (ParserT m) where
catch :: forall e a.
(HasCallStack, Exception e) =>
ParserT m a -> (e -> ParserT m a) -> ParserT m a
catch ParserT m a
ma e -> ParserT m a
h = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s ->
m (ParserState, Either String a)
-> (e -> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall e a. (HasCallStack, Exception e) => m a -> (e -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch (ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
ma ParserState
s)
(\e
e -> ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (e -> ParserT m a
h e
e) ParserState
s))
{-# INLINABLE catch #-}
instance Ex.MonadMask m => Ex.MonadMask (ParserT m) where
mask :: forall b.
HasCallStack =>
((forall a. ParserT m a -> ParserT m a) -> ParserT m b)
-> ParserT m b
mask (forall a. ParserT m a -> ParserT m a) -> ParserT m b
f = (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s ->
((forall a. m a -> m a) -> m (ParserState, Either String b))
-> m (ParserState, Either String b)
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
Ex.mask (\forall a. m a -> m a
u ->
ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ((forall a. ParserT m a -> ParserT m a) -> ParserT m b
f (\ParserT m a
p -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (m (ParserState, Either String a)
-> m (ParserState, Either String a)
forall a. m a -> m a
u (m (ParserState, Either String a)
-> m (ParserState, Either String a))
-> (ParserState -> m (ParserState, Either String a))
-> ParserState
-> m (ParserState, Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p))) ParserState
s))
{-# INLINABLE mask #-}
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. ParserT m a -> ParserT m a) -> ParserT m b)
-> ParserT m b
uninterruptibleMask (forall a. ParserT m a -> ParserT m a) -> ParserT m b
f = (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s ->
((forall a. m a -> m a) -> m (ParserState, Either String b))
-> m (ParserState, Either String b)
forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. m a -> m a) -> m b) -> m b
Ex.uninterruptibleMask (\forall a. m a -> m a
u ->
ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ((forall a. ParserT m a -> ParserT m a) -> ParserT m b
f (\ParserT m a
p -> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (m (ParserState, Either String a)
-> m (ParserState, Either String a)
forall a. m a -> m a
u (m (ParserState, Either String a)
-> m (ParserState, Either String a))
-> (ParserState -> m (ParserState, Either String a))
-> ParserState
-> m (ParserState, Either String a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p))) ParserState
s))
{-# INLINABLE uninterruptibleMask #-}
generalBracket :: forall a b c.
HasCallStack =>
ParserT m a
-> (a -> ExitCase b -> ParserT m c)
-> (a -> ParserT m b)
-> ParserT m (b, c)
generalBracket ParserT m a
acq a -> ExitCase b -> ParserT m c
rel a -> ParserT m b
use = (ParserState -> m (ParserState, Either String (b, c)))
-> ParserT m (b, c)
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 -> do
((ParserState
_sb,Either String b
eb), (ParserState
sc,Either String c
ec)) <- m (ParserState, Either String a)
-> ((ParserState, Either String a)
-> ExitCase (ParserState, Either String b)
-> m (ParserState, Either String c))
-> ((ParserState, Either String a)
-> m (ParserState, Either String b))
-> m ((ParserState, Either String b),
(ParserState, Either String c))
forall a b c.
HasCallStack =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
Ex.generalBracket
(ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
acq ParserState
s0)
(\(ParserState
s1, Either String a
ea) ExitCase (ParserState, Either String b)
ec -> case Either String a
ea of
Right a
a -> case ExitCase (ParserState, Either String b)
ec of
Ex.ExitCaseSuccess (ParserState
s2, Right b
b) ->
ParserT m c -> ParserState -> m (ParserState, Either String c)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ExitCase b -> ParserT m c
rel a
a (b -> ExitCase b
forall a. a -> ExitCase a
Ex.ExitCaseSuccess b
b)) ParserState
s2
Ex.ExitCaseSuccess (ParserState
s2, Left String
msg) ->
(ParserState, Either String c) -> m (ParserState, Either String c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s2, String -> Either String c
forall a b. a -> Either a b
Left String
msg)
Ex.ExitCaseException SomeException
e ->
ParserT m c -> ParserState -> m (ParserState, Either String c)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ExitCase b -> ParserT m c
rel a
a (SomeException -> ExitCase b
forall a. SomeException -> ExitCase a
Ex.ExitCaseException SomeException
e)) ParserState
s1
ExitCase (ParserState, Either String b)
Ex.ExitCaseAbort ->
ParserT m c -> ParserState -> m (ParserState, Either String c)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ExitCase b -> ParserT m c
rel a
a ExitCase b
forall a. ExitCase a
Ex.ExitCaseAbort) ParserState
s1
Left String
msg ->
(ParserState, Either String c) -> m (ParserState, Either String c)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String c
forall a b. a -> Either a b
Left String
msg))
(\(ParserState
s1, Either String a
ea) -> case Either String a
ea of
Right a
a -> ParserT m b -> ParserState -> m (ParserState, Either String b)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (a -> ParserT m b
use a
a) ParserState
s1
Left String
msg ->
(ParserState, Either String b) -> m (ParserState, Either String b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String b
forall a b. a -> Either a b
Left String
msg))
(ParserState, Either String (b, c))
-> m (ParserState, Either String (b, c))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
sc, (b -> c -> (b, c)) -> c -> b -> (b, c)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (c -> b -> (b, c))
-> Either String c -> Either String (b -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String c
ec Either String (b -> (b, c))
-> Either String b -> Either String (b, c)
forall a b.
Either String (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either String b
eb))
instance MonadCont m => MonadCont (ParserT m) where
callCC :: forall a b. ((a -> ParserT m b) -> ParserT m a) -> ParserT m a
callCC (a -> ParserT m b) -> ParserT m a
f = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s0 ->
(((ParserState, Either String a)
-> m (ParserState, Either String b))
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. ((a -> m b) -> m a) -> m a
forall (m :: * -> *) a b. MonadCont m => ((a -> m b) -> m a) -> m a
callCC (\(ParserState, Either String a) -> m (ParserState, Either String b)
c -> ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ((a -> ParserT m b) -> ParserT m a
f (\a
a -> (ParserState -> m (ParserState, Either String b)) -> ParserT m b
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s1 -> (ParserState, Either String a) -> m (ParserState, Either String b)
c (ParserState
s1, a -> Either String a
forall a b. b -> Either a b
Right a
a)))) ParserState
s0))
pElement
:: Monad m
=> T.Text
-> ParserT m a
-> ParserT m a
pElement :: forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
pElement Text
t0 ParserT m a
p0 = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT ((ParserState -> m (ParserState, Either String a)) -> ParserT m a)
-> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall a b. (a -> b) -> a -> b
$ \case
SReg Text
t1 HashMap Text Text
as0 (Element' Text
t HashMap Text Text
as [Node]
cs : [Node]
cs0) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t0 ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p0 (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs) m (ParserState, Either String a)
-> ((ParserState, Either String a)
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(ParserState
_, Right a
a) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t1 HashMap Text Text
as0 [Node]
cs0, a -> Either String a
forall a b. b -> Either a b
Right a
a)
(ParserState
s1, Left String
msg) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String a
forall a b. a -> Either a b
Left String
msg)
STop (Element' Text
t HashMap Text Text
as [Node]
cs : [Node]
cs0) | Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
t0 ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p0 (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs) m (ParserState, Either String a)
-> ((ParserState, Either String a)
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(ParserState
_, Right a
a) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Node] -> ParserState
STop [Node]
cs0, a -> Either String a
forall a b. b -> Either a b
Right a
a)
(ParserState
s1, Left String
msg) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String a
forall a b. a -> Either a b
Left String
msg)
SReg Text
t HashMap Text Text
as (Text' Text
x : [Node]
cs) | (Char -> Bool) -> Text -> Bool
TL.all Char -> Bool
Char.isSpace Text
x ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (Text -> ParserT m a -> ParserT m a
forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
pElement Text
t0 ParserT m a
p0) (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs)
STop (Text' Text
x : [Node]
cs) | (Char -> Bool) -> Text -> Bool
TL.all Char -> Bool
Char.isSpace Text
x ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (Text -> ParserT m a -> ParserT m a
forall (m :: * -> *) a.
Monad m =>
Text -> ParserT m a -> ParserT m a
pElement Text
t0 ParserT m a
p0) ([Node] -> ParserState
STop [Node]
cs)
ParserState
s0 -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s0, String -> Either String a
forall a b. a -> Either a b
Left (String
"Missing element " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t0))
{-# INLINABLE pElement #-}
pAnyElement
:: Monad m
=> ParserT m a
-> ParserT m a
pAnyElement :: forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement ParserT m a
p0 = (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT ((ParserState -> m (ParserState, Either String a)) -> ParserT m a)
-> (ParserState -> m (ParserState, Either String a)) -> ParserT m a
forall a b. (a -> b) -> a -> b
$ \case
SReg Text
t0 HashMap Text Text
as0 (Element' Text
t HashMap Text Text
as [Node]
cs : [Node]
cs0) ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p0 (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs) m (ParserState, Either String a)
-> ((ParserState, Either String a)
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(ParserState
_, Right a
a) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t0 HashMap Text Text
as0 [Node]
cs0, a -> Either String a
forall a b. b -> Either a b
Right a
a)
(ParserState
s1, Left String
msg) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String a
forall a b. a -> Either a b
Left String
msg)
STop (Element' Text
t HashMap Text Text
as [Node]
cs : [Node]
cs0) ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT ParserT m a
p0 (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs) m (ParserState, Either String a)
-> ((ParserState, Either String a)
-> m (ParserState, Either String a))
-> m (ParserState, Either String a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
(ParserState
_, Right a
a) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Node] -> ParserState
STop [Node]
cs0, a -> Either String a
forall a b. b -> Either a b
Right a
a)
(ParserState
s1, Left String
msg) -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s1, String -> Either String a
forall a b. a -> Either a b
Left String
msg)
SReg Text
t HashMap Text Text
as (Text' Text
x : [Node]
cs) | (Char -> Bool) -> Text -> Bool
TL.all Char -> Bool
Char.isSpace Text
x ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (ParserT m a -> ParserT m a
forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement ParserT m a
p0) (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs)
STop (Text' Text
x : [Node]
cs) | (Char -> Bool) -> Text -> Bool
TL.all Char -> Bool
Char.isSpace Text
x ->
ParserT m a -> ParserState -> m (ParserState, Either String a)
forall (m :: * -> *) a.
ParserT m a -> ParserState -> m (ParserState, Either String a)
runParserT (ParserT m a -> ParserT m a
forall (m :: * -> *) a. Monad m => ParserT m a -> ParserT m a
pAnyElement ParserT m a
p0) ([Node] -> ParserState
STop [Node]
cs)
ParserState
s0 -> (ParserState, Either String a) -> m (ParserState, Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s0, String -> Either String a
forall a b. a -> Either a b
Left String
"Missing element")
{-# INLINABLE pAnyElement #-}
pName
:: Applicative m
=> ParserT m T.Text
pName :: forall (m :: * -> *). Applicative m => ParserT m Text
pName = (ParserState -> m (ParserState, Either String Text))
-> ParserT m Text
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> case ParserState
s of
SReg Text
t HashMap Text Text
_ [Node]
_ -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, Text -> Either String Text
forall a b. b -> Either a b
Right Text
t)
ParserState
_ -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String Text
forall a b. a -> Either a b
Left String
"Before selecting an name, you must select an element"))
{-# INLINABLE pName #-}
pAttr
:: Applicative m
=> T.Text
-> ParserT m T.Text
pAttr :: forall (m :: * -> *). Applicative m => Text -> ParserT m Text
pAttr Text
n = (ParserState -> m (ParserState, Either String Text))
-> ParserT m Text
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> case ParserState
s of
SReg Text
t HashMap Text Text
as [Node]
cs -> case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
n HashMap Text Text
as of
Just Text
x -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t (Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
n HashMap Text Text
as) [Node]
cs, Text -> Either String Text
forall a b. b -> Either a b
Right Text
x)
Maybe Text
Nothing -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String Text
forall a b. a -> Either a b
Left (String
"Missing attribute " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
n))
ParserState
_ -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String Text
forall a b. a -> Either a b
Left String
"Before selecting an attribute, you must select an element"))
{-# INLINABLE pAttr #-}
pAttrs
:: Applicative m
=> ParserT m (HM.HashMap T.Text T.Text)
pAttrs :: forall (m :: * -> *).
Applicative m =>
ParserT m (HashMap Text Text)
pAttrs = (ParserState -> m (ParserState, Either String (HashMap Text Text)))
-> ParserT m (HashMap Text Text)
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> case ParserState
s of
SReg Text
t HashMap Text Text
as [Node]
cs -> (ParserState, Either String (HashMap Text Text))
-> m (ParserState, Either String (HashMap Text Text))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
forall a. Monoid a => a
mempty [Node]
cs, HashMap Text Text -> Either String (HashMap Text Text)
forall a b. b -> Either a b
Right HashMap Text Text
as)
ParserState
_ -> (ParserState, Either String (HashMap Text Text))
-> m (ParserState, Either String (HashMap Text Text))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String (HashMap Text Text)
forall a b. a -> Either a b
Left String
"Before selecting an attribute, you must select an element"))
{-# INLINABLE pAttrs #-}
pChildren
:: Applicative m
=> ParserT m [Node]
pChildren :: forall (m :: * -> *). Applicative m => ParserT m [Node]
pChildren = (ParserState -> m (ParserState, Either String [Node]))
-> ParserT m [Node]
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\case
STop [Node]
cs -> (ParserState, Either String [Node])
-> m (ParserState, Either String [Node])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Node] -> ParserState
STop [Node]
forall a. Monoid a => a
mempty, [Node] -> Either String [Node]
forall a b. b -> Either a b
Right [Node]
cs)
SReg Text
t HashMap Text Text
as [Node]
cs -> (ParserState, Either String [Node])
-> m (ParserState, Either String [Node])
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
forall a. Monoid a => a
mempty, [Node] -> Either String [Node]
forall a b. b -> Either a b
Right [Node]
cs))
{-# INLINABLE pChildren #-}
pText
:: Applicative m
=> ParserT m TL.Text
pText :: forall (m :: * -> *). Applicative m => ParserT m Text
pText = (ParserState -> m (ParserState, Either String Text))
-> ParserT m Text
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\case
STop (Text Text
x : [Node]
ns) -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Node] -> ParserState
STop [Node]
ns, Text -> Either String Text
forall a b. b -> Either a b
Right Text
x)
SReg Text
t HashMap Text Text
as (Text Text
x : [Node]
cs) -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HashMap Text Text -> [Node] -> ParserState
SReg Text
t HashMap Text Text
as [Node]
cs, Text -> Either String Text
forall a b. b -> Either a b
Right Text
x)
ParserState
s0 -> (ParserState, Either String Text)
-> m (ParserState, Either String Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s0, String -> Either String Text
forall a b. a -> Either a b
Left String
"Missing text node"))
{-# INLINABLE pText #-}
pEndOfInput :: Applicative m => ParserT m ()
pEndOfInput :: forall (m :: * -> *). Applicative m => ParserT m ()
pEndOfInput = (ParserState -> m (ParserState, Either String ())) -> ParserT m ()
forall (m :: * -> *) a.
(ParserState -> m (ParserState, Either String a)) -> ParserT m a
ParserT (\ParserState
s -> case ParserState -> Bool
isEof ParserState
s of
Bool
True -> (ParserState, Either String ())
-> m (ParserState, Either String ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, () -> Either String ()
forall a b. b -> Either a b
Right ())
Bool
False -> (ParserState, Either String ())
-> m (ParserState, Either String ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserState
s, String -> Either String ()
forall a b. a -> Either a b
Left String
"Not end of input yet"))
{-# INLINABLE pEndOfInput #-}
isEof :: ParserState -> Bool
isEof :: ParserState -> Bool
isEof = \case
SReg Text
_ HashMap Text Text
as [Node]
cs -> HashMap Text Text -> Bool
forall k v. HashMap k v -> Bool
HM.null HashMap Text Text
as Bool -> Bool -> Bool
&& [Node] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
cs
STop [Node]
ns -> [Node] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Node]
ns
{-# INLINE isEof #-}
class ToXml a where
toXml :: a -> [Node]
encode :: [Node] -> BB.Builder
encode :: [Node] -> Builder
encode [Node]
xs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ((Node -> Builder) -> [Node] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Node -> Builder
encodeNode [Node]
xs)
where
encodeNode :: Node -> BB.Builder
encodeNode :: Node -> Builder
encodeNode = \case
Text Text
x -> Text -> Builder
encodeXmlUtf8Lazy Text
x
Element Text
t HashMap Text Text
as [Node]
cs ->
Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8 Text
t
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> HashMap Text Text -> Builder
encodeAttrs (Builder
">" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Node] -> Builder
encode [Node]
cs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"</" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8 Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
">") HashMap Text Text
as
{-# INLINE encodeNode #-}
encodeAttrs :: BB.Builder -> HM.HashMap T.Text T.Text -> BB.Builder
encodeAttrs :: Builder -> HashMap Text Text -> Builder
encodeAttrs = (Builder -> Text -> Text -> Builder)
-> Builder -> HashMap Text Text -> Builder
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey'
(\Builder
o Text
k Text
v -> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeUtf8 Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeXmlUtf8 Text
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
o)
{-# INLINE encodeAttrs #-}
dfpos :: ((Node -> [Node]) -> Node -> [Node]) -> Node -> [Node]
dfpos :: ((Node -> [Node]) -> Node -> [Node]) -> Node -> [Node]
dfpos (Node -> [Node]) -> Node -> [Node]
f = Identity [Node] -> [Node]
forall a. Identity a -> a
runIdentity (Identity [Node] -> [Node])
-> (Node -> Identity [Node]) -> Node -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Node -> Identity [Node]) -> Node -> Identity [Node])
-> Node -> Identity [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM (\Node -> Identity [Node]
k -> [Node] -> Identity [Node]
forall a. a -> Identity a
Identity ([Node] -> Identity [Node])
-> (Node -> [Node]) -> Node -> Identity [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> [Node]) -> Node -> [Node]
f (Identity [Node] -> [Node]
forall a. Identity a -> a
runIdentity (Identity [Node] -> [Node])
-> (Node -> Identity [Node]) -> Node -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Identity [Node]
k))
dfposM :: Monad m => ((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM :: forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM (Node -> m [Node]) -> Node -> m [Node]
f = \Node
n0 -> do
Cursor
c1 <- (Node -> m [Node]) -> Cursor -> m Cursor
forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseChildren (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM (Node -> m [Node]) -> Node -> m [Node]
f) (Node -> Cursor
cursorFromNode Node
n0)
Cursor
c2 <- (Node -> m [Node]) -> Cursor -> m Cursor
forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseRightSiblings (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM (Node -> m [Node]) -> Node -> m [Node]
f) Cursor
c1
([[Node]] -> [Node]) -> m [[Node]] -> m [Node]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Node] -> [Node]
normalize ([Node] -> [Node]) -> ([[Node]] -> [Node]) -> [[Node]] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> [Node]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join)
((Node -> m [Node]) -> [Node] -> m [[Node]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Node -> m [Node]) -> Node -> m [Node]
f (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfposM (Node -> m [Node]) -> Node -> m [Node]
f)) (Cursor -> [Node]
cursorSiblings Cursor
c2))
dfpre :: ((Node -> [Node]) -> Node -> [Node]) -> Node -> [Node]
dfpre :: ((Node -> [Node]) -> Node -> [Node]) -> Node -> [Node]
dfpre (Node -> [Node]) -> Node -> [Node]
f = Identity [Node] -> [Node]
forall a. Identity a -> a
runIdentity (Identity [Node] -> [Node])
-> (Node -> Identity [Node]) -> Node -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Node -> Identity [Node]) -> Node -> Identity [Node])
-> Node -> Identity [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM (\Node -> Identity [Node]
k -> [Node] -> Identity [Node]
forall a. a -> Identity a
Identity ([Node] -> Identity [Node])
-> (Node -> [Node]) -> Node -> Identity [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> [Node]) -> Node -> [Node]
f (Identity [Node] -> [Node]
forall a. Identity a -> a
runIdentity (Identity [Node] -> [Node])
-> (Node -> Identity [Node]) -> Node -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Identity [Node]
k))
dfpreM :: Monad m => ((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM :: forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM (Node -> m [Node]) -> Node -> m [Node]
f = \Node
n0 -> do
[Node]
ns <- (Node -> m [Node]) -> Node -> m [Node]
f (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM (Node -> m [Node]) -> Node -> m [Node]
f) Node
n0
([[Node]] -> [Node]) -> m [[Node]] -> m [Node]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Node] -> [Node]
normalize ([Node] -> [Node]) -> ([[Node]] -> [Node]) -> [[Node]] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> [Node]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) (m [[Node]] -> m [Node]) -> m [[Node]] -> m [Node]
forall a b. (a -> b) -> a -> b
$ [Node] -> (Node -> m [Node]) -> m [[Node]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Node]
ns ((Node -> m [Node]) -> m [[Node]])
-> (Node -> m [Node]) -> m [[Node]]
forall a b. (a -> b) -> a -> b
$ \Node
n -> do
Cursor
c1 <- (Node -> m [Node]) -> Cursor -> m Cursor
forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseChildren (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM (Node -> m [Node]) -> Node -> m [Node]
f) (Node -> Cursor
cursorFromNode Node
n)
Cursor -> [Node]
cursorSiblings (Cursor -> [Node]) -> m Cursor -> m [Node]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> m [Node]) -> Cursor -> m Cursor
forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseRightSiblings (((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
forall (m :: * -> *).
Monad m =>
((Node -> m [Node]) -> Node -> m [Node]) -> Node -> m [Node]
dfpreM (Node -> m [Node]) -> Node -> m [Node]
f) Cursor
c1
data Cursor = Cursor
{ Cursor -> Node
_cursorCurrent :: !Node
, Cursor -> Seq Node
_cursorLefts :: !(Seq Node)
, Cursor -> Seq Node
_cursorRights :: !(Seq Node)
, Cursor -> Seq (Seq Node, Text, HashMap Text Text, Seq Node)
_cursorParents :: !(Seq (Seq Node, T.Text, HM.HashMap T.Text T.Text, Seq Node))
}
traverseChildren :: Monad m => (Node -> m [Node]) -> Cursor -> m Cursor
{-# INLINABLE traverseChildren #-}
traverseChildren :: forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseChildren Node -> m [Node]
f Cursor
c0 = case Cursor -> Node
_cursorCurrent Cursor
c0 of
Text Text
_ -> Cursor -> m Cursor
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor
c0
Element Text
t HashMap Text Text
as [Node]
cs -> do
[Node]
n1s <- ([[Node]] -> [Node]) -> m [[Node]] -> m [Node]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Node] -> [Node]
normalize ([Node] -> [Node]) -> ([[Node]] -> [Node]) -> [[Node]] -> [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Node]] -> [Node]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) ((Node -> m [Node]) -> [Node] -> m [[Node]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Node -> m [Node]
f [Node]
cs)
Cursor -> m Cursor
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cursor
c0 {_cursorCurrent = Element' t as n1s})
traverseRightSiblings :: Monad m => (Node -> m [Node]) -> Cursor -> m Cursor
{-# INLINABLE traverseRightSiblings #-}
traverseRightSiblings :: forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseRightSiblings Node -> m [Node]
f Cursor
c0 = case Cursor -> Maybe (Node, Cursor)
cursorRemoveRight Cursor
c0 of
Maybe (Node, Cursor)
Nothing -> Cursor -> m Cursor
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor
c0
Just (Node
n1, Cursor
c1) -> do
[Node]
n2s <- ([Node] -> [Node]) -> m [Node] -> m [Node]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Node] -> [Node]
normalize (Node -> m [Node]
f Node
n1)
(Node -> m [Node]) -> Cursor -> m Cursor
forall (m :: * -> *).
Monad m =>
(Node -> m [Node]) -> Cursor -> m Cursor
traverseRightSiblings Node -> m [Node]
f ([Node] -> Cursor -> Cursor
cursorInsertManyRight [Node]
n2s Cursor
c1)
cursorFromNode :: Node -> Cursor
{-# INLINE cursorFromNode #-}
cursorFromNode :: Node -> Cursor
cursorFromNode Node
n = Node
-> Seq Node
-> Seq Node
-> Seq (Seq Node, Text, HashMap Text Text, Seq Node)
-> Cursor
Cursor Node
n Seq Node
forall a. Monoid a => a
mempty Seq Node
forall a. Monoid a => a
mempty Seq (Seq Node, Text, HashMap Text Text, Seq Node)
forall a. Monoid a => a
mempty
cursorSiblings :: Cursor -> [Node]
{-# INLINE cursorSiblings #-}
cursorSiblings :: Cursor -> [Node]
cursorSiblings (Cursor Node
cur Seq Node
ls Seq Node
rs Seq (Seq Node, Text, HashMap Text Text, Seq Node)
_) =
Seq Node -> [Node]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Seq Node -> Seq Node
forall a. Seq a -> Seq a
Seq.reverse Seq Node
ls Seq Node -> Seq Node -> Seq Node
forall a. Semigroup a => a -> a -> a
<> (Node
cur Node -> Seq Node -> Seq Node
forall a. a -> Seq a -> Seq a
Seq.<| Seq Node
rs))
cursorRemoveRight :: Cursor -> Maybe (Node, Cursor)
{-# INLINABLE cursorRemoveRight #-}
cursorRemoveRight :: Cursor -> Maybe (Node, Cursor)
cursorRemoveRight = \case
Cursor Node
n Seq Node
ls Seq Node
rs0 Seq (Seq Node, Text, HashMap Text Text, Seq Node)
ps | Bool -> Bool
not (Seq Node -> Bool
forall a. Seq a -> Bool
Seq.null Seq Node
rs0) ->
case Seq Node -> ViewL Node
forall a. Seq a -> ViewL a
Seq.viewl Seq Node
rs0 of
Node
r Seq.:< Seq Node
rs -> (Node, Cursor) -> Maybe (Node, Cursor)
forall a. a -> Maybe a
Just (Node
r, Node
-> Seq Node
-> Seq Node
-> Seq (Seq Node, Text, HashMap Text Text, Seq Node)
-> Cursor
Cursor Node
n Seq Node
ls Seq Node
rs Seq (Seq Node, Text, HashMap Text Text, Seq Node)
ps)
ViewL Node
_ -> Maybe (Node, Cursor)
forall a. HasCallStack => a
undefined
Cursor
_ -> Maybe (Node, Cursor)
forall a. Maybe a
Nothing
cursorInsertManyRight :: [Node] -> Cursor -> Cursor
{-# INLINE cursorInsertManyRight #-}
cursorInsertManyRight :: [Node] -> Cursor -> Cursor
cursorInsertManyRight [Node]
ns (Cursor Node
nn Seq Node
ls Seq Node
rs Seq (Seq Node, Text, HashMap Text Text, Seq Node)
ps) =
Node
-> Seq Node
-> Seq Node
-> Seq (Seq Node, Text, HashMap Text Text, Seq Node)
-> Cursor
Cursor Node
nn Seq Node
ls ([Node] -> Seq Node
forall a. [a] -> Seq a
Seq.fromList [Node]
ns Seq Node -> Seq Node -> Seq Node
forall a. Semigroup a => a -> a -> a
<> Seq Node
rs) Seq (Seq Node, Text, HashMap Text Text, Seq Node)
ps
encodeUtf8 :: T.Text -> BB.Builder
{-# INLINE encodeUtf8 #-}
encodeUtf8 :: Text -> Builder
encodeUtf8 = Text -> Builder
T.encodeUtf8Builder
encodeXmlUtf8 :: T.Text -> BB.Builder
{-# INLINE encodeXmlUtf8 #-}
encodeXmlUtf8 :: Text -> Builder
encodeXmlUtf8 = BoundedPrim Word8 -> Text -> Builder
T.encodeUtf8BuilderEscaped BoundedPrim Word8
xmlEscaped
encodeXmlUtf8Lazy :: TL.Text -> BB.Builder
{-# INLINE encodeXmlUtf8Lazy #-}
encodeXmlUtf8Lazy :: Text -> Builder
encodeXmlUtf8Lazy = BoundedPrim Word8 -> Text -> Builder
TL.encodeUtf8BuilderEscaped BoundedPrim Word8
xmlEscaped
xmlEscaped :: BBP.BoundedPrim Word8
{-# INLINE xmlEscaped #-}
xmlEscaped :: BoundedPrim Word8
xmlEscaped =
(Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
38) ((Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
fixed5 (Word8
38,(Word8
97,(Word8
109,(Word8
112,Word8
59))))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
(Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
60) ((Word8, (Word8, (Word8, Word8))) -> BoundedPrim Word8
fixed4 (Word8
38,(Word8
108,(Word8
116,Word8
59)))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
(Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
62) ((Word8, (Word8, (Word8, Word8))) -> BoundedPrim Word8
fixed4 (Word8
38,(Word8
103,(Word8
116,Word8
59)))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
(Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
BBP.condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
34) ((Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
fixed5 (Word8
38,(Word8
35,(Word8
51,(Word8
52,Word8
59))))) (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$
FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded FixedPrim Word8
BBP.word8
where
{-# INLINE fixed4 #-}
fixed4 :: (Word8, (Word8, (Word8, Word8))) -> BBP.BoundedPrim Word8
fixed4 :: (Word8, (Word8, (Word8, Word8))) -> BoundedPrim Word8
fixed4 (Word8, (Word8, (Word8, Word8)))
x = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded
((Word8, (Word8, (Word8, Word8)))
-> Word8 -> (Word8, (Word8, (Word8, Word8)))
forall a b. a -> b -> a
const (Word8, (Word8, (Word8, Word8)))
x (Word8 -> (Word8, (Word8, (Word8, Word8))))
-> FixedPrim (Word8, (Word8, (Word8, Word8))) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BBP.>$< FixedPrim Word8
BBP.word8 FixedPrim Word8
-> FixedPrim (Word8, (Word8, Word8))
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8
FixedPrim Word8
-> FixedPrim (Word8, Word8) -> FixedPrim (Word8, (Word8, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8)
{-# INLINE fixed5 #-}
fixed5 :: (Word8, (Word8, (Word8, (Word8, Word8)))) -> BBP.BoundedPrim Word8
fixed5 :: (Word8, (Word8, (Word8, (Word8, Word8)))) -> BoundedPrim Word8
fixed5 (Word8, (Word8, (Word8, (Word8, Word8))))
x = FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
BBP.liftFixedToBounded
((Word8, (Word8, (Word8, (Word8, Word8))))
-> Word8 -> (Word8, (Word8, (Word8, (Word8, Word8))))
forall a b. a -> b -> a
const (Word8, (Word8, (Word8, (Word8, Word8))))
x (Word8 -> (Word8, (Word8, (Word8, (Word8, Word8)))))
-> FixedPrim (Word8, (Word8, (Word8, (Word8, Word8))))
-> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
BBP.>$< FixedPrim Word8
BBP.word8 FixedPrim Word8
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
-> FixedPrim (Word8, (Word8, (Word8, (Word8, Word8))))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8
FixedPrim Word8
-> FixedPrim (Word8, (Word8, Word8))
-> FixedPrim (Word8, (Word8, (Word8, Word8)))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8 FixedPrim Word8
-> FixedPrim (Word8, Word8) -> FixedPrim (Word8, (Word8, Word8))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8 FixedPrim Word8 -> FixedPrim Word8 -> FixedPrim (Word8, Word8)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
BBP.>*< FixedPrim Word8
BBP.word8)