{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
module Data.YAML.Loader
( decodeLoader
, Loader(..)
, LoaderT
, NodeId
) where
import Control.Monad.State (MonadState(..), gets, modify,
StateT, evalStateT, state)
import Control.Monad.Trans (MonadTrans(..))
import qualified Data.ByteString.Lazy as BS.L
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.YAML.Event (Tag)
import qualified Data.YAML.Event as YE
import Util
type NodeId = Word
data Loader m n = Loader
{ forall (m :: * -> *) n.
Loader m n -> Tag -> ScalarStyle -> Text -> LoaderT m n
yScalar :: Tag -> YE.ScalarStyle -> Text -> LoaderT m n
, forall (m :: * -> *) n. Loader m n -> Tag -> [n] -> LoaderT m n
ySequence :: Tag -> [n] -> LoaderT m n
, forall (m :: * -> *) n.
Loader m n -> Tag -> [(n, n)] -> LoaderT m n
yMapping :: Tag -> [(n,n)] -> LoaderT m n
, forall (m :: * -> *) n.
Loader m n -> NodeId -> Bool -> n -> LoaderT m n
yAlias :: NodeId -> Bool -> n -> LoaderT m n
, forall (m :: * -> *) n. Loader m n -> NodeId -> n -> LoaderT m n
yAnchor :: NodeId -> n -> LoaderT m n
}
type LoaderT m n = YE.Pos -> m (Either (YE.Pos,String) n)
{-# INLINEABLE decodeLoader #-}
decodeLoader :: forall n m . MonadFix m => Loader m n -> BS.L.ByteString -> m (Either (YE.Pos, String) [n])
decodeLoader :: forall n (m :: * -> *).
MonadFix m =>
Loader m n -> ByteString -> m (Either (Pos, String) [n])
decodeLoader Loader{NodeId -> n -> LoaderT m n
NodeId -> Bool -> n -> LoaderT m n
Tag -> [n] -> LoaderT m n
Tag -> [(n, n)] -> LoaderT m n
Tag -> ScalarStyle -> Text -> LoaderT m n
yAnchor :: NodeId -> n -> LoaderT m n
yAlias :: NodeId -> Bool -> n -> LoaderT m n
yMapping :: Tag -> [(n, n)] -> LoaderT m n
ySequence :: Tag -> [n] -> LoaderT m n
yScalar :: Tag -> ScalarStyle -> Text -> LoaderT m n
yAnchor :: forall (m :: * -> *) n. Loader m n -> NodeId -> n -> LoaderT m n
yAlias :: forall (m :: * -> *) n.
Loader m n -> NodeId -> Bool -> n -> LoaderT m n
yMapping :: forall (m :: * -> *) n.
Loader m n -> Tag -> [(n, n)] -> LoaderT m n
ySequence :: forall (m :: * -> *) n. Loader m n -> Tag -> [n] -> LoaderT m n
yScalar :: forall (m :: * -> *) n.
Loader m n -> Tag -> ScalarStyle -> Text -> LoaderT m n
..} ByteString
bs0 = do
case forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Either a EvPos -> Bool
isComment) (ByteString -> EvStream
YE.parseEvents ByteString
bs0) of
Left (Pos
pos,String
err) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (Pos
pos,String
err)
Right [EvPos]
evs -> forall (m :: * -> *) n a.
Monad m =>
PT n m a -> [EvPos] -> m (Either (Pos, String) a)
runParserT PT n m [n]
goStream [EvPos]
evs
where
isComment :: Either a EvPos -> Bool
isComment Either a EvPos
evPos = case Either a EvPos
evPos of
Right (YE.EvPos {eEvent :: EvPos -> Event
eEvent = (YE.Comment Text
_), ePos :: EvPos -> Pos
ePos = Pos
_}) -> Bool
True
Either a EvPos
_ -> Bool
False
goStream :: PT n m [n]
goStream :: PT n m [n]
goStream = do
EvPos
_ <- forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
satisfy (forall a. Eq a => a -> a -> Bool
== Event
YE.StreamStart)
[n]
ds <- forall (m :: * -> *) n a.
Monad m =>
(Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless (forall a. Eq a => a -> a -> Bool
== Event
YE.StreamEnd) PT n m n
goDoc
forall (m :: * -> *) n. Monad m => PT n m ()
eof
forall (m :: * -> *) a. Monad m => a -> m a
return [n]
ds
goDoc :: PT n m n
goDoc :: PT n m n
goDoc = do
EvPos
_ <- forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
satisfy Event -> Bool
isDocStart
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \S n
s0 -> S n
s0 { sDict :: Map Text (NodeId, n)
sDict = forall a. Monoid a => a
mempty, sCycle :: Set Text
sCycle = forall a. Monoid a => a
mempty }
n
n <- PT n m n
goNode
EvPos
_ <- forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
satisfy Event -> Bool
isDocEnd
forall (m :: * -> *) a. Monad m => a -> m a
return n
n
getNewNid :: PT n m Word
getNewNid :: PT n m NodeId
getNewNid = forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state forall a b. (a -> b) -> a -> b
$ \S n
s0 -> let i0 :: NodeId
i0 = forall n. S n -> NodeId
sIdCnt S n
s0
in (NodeId
i0, S n
s0 { sIdCnt :: NodeId
sIdCnt = NodeId
i0forall a. Num a => a -> a -> a
+NodeId
1 })
returnNode :: YE.Pos -> Maybe YE.Anchor -> Either (YE.Pos, String) n -> PT n m n
returnNode :: Pos -> Maybe Text -> Either (Pos, String) n -> PT n m n
returnNode Pos
_ Maybe Text
_ (Left (Pos, String)
err) = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Pos, String)
err
returnNode Pos
_ Maybe Text
Nothing (Right n
node) = forall (m :: * -> *) a. Monad m => a -> m a
return n
node
returnNode Pos
pos (Just Text
a) (Right n
node) = do
NodeId
nid <- PT n m NodeId
getNewNid
n
node' <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NodeId -> n -> LoaderT m n
yAnchor NodeId
nid n
node Pos
pos)
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \S n
s0 -> S n
s0 { sDict :: Map Text (NodeId, n)
sDict = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
a (NodeId
nid,n
node') (forall n. S n -> Map Text (NodeId, n)
sDict S n
s0) }
forall (m :: * -> *) a. Monad m => a -> m a
return n
node'
registerAnchor :: YE.Pos -> Maybe YE.Anchor -> PT n m n -> PT n m n
registerAnchor :: Pos -> Maybe Text -> PT n m n -> PT n m n
registerAnchor Pos
_ Maybe Text
Nothing PT n m n
pn = PT n m n
pn
registerAnchor Pos
pos (Just Text
a) PT n m n
pn = do
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \S n
s0 -> S n
s0 { sCycle :: Set Text
sCycle = forall a. Ord a => a -> Set a -> Set a
Set.insert Text
a (forall n. S n -> Set Text
sCycle S n
s0) }
NodeId
nid <- PT n m NodeId
getNewNid
mdo
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \S n
s0 -> S n
s0 { sDict :: Map Text (NodeId, n)
sDict = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
a (NodeId
nid,n
n) (forall n. S n -> Map Text (NodeId, n)
sDict S n
s0) }
n
n0 <- PT n m n
pn
n
n <- forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NodeId -> n -> LoaderT m n
yAnchor NodeId
nid n
n0 Pos
pos)
forall (m :: * -> *) a. Monad m => a -> m a
return n
n
exitAnchor :: Maybe YE.Anchor -> PT n m ()
exitAnchor :: Maybe Text -> PT n m ()
exitAnchor Maybe Text
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
exitAnchor (Just Text
a) = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \S n
s0 -> S n
s0 { sCycle :: Set Text
sCycle = forall a. Ord a => a -> Set a -> Set a
Set.delete Text
a (forall n. S n -> Set Text
sCycle S n
s0) }
goNode :: PT n m n
goNode :: PT n m n
goNode = do
EvPos
n <- forall (m :: * -> *) n. Monad m => PT n m EvPos
anyEv
let pos :: Pos
pos = EvPos -> Pos
YE.ePos EvPos
n
case EvPos -> Event
YE.eEvent EvPos
n of
YE.Scalar Maybe Text
manc Tag
tag ScalarStyle
sty Text
val -> do
Maybe Text -> PT n m ()
exitAnchor Maybe Text
manc
Either (Pos, String) n
n' <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Tag -> ScalarStyle -> Text -> LoaderT m n
yScalar Tag
tag ScalarStyle
sty Text
val Pos
pos)
Pos -> Maybe Text -> Either (Pos, String) n -> PT n m n
returnNode Pos
pos Maybe Text
manc forall a b. (a -> b) -> a -> b
$! Either (Pos, String) n
n'
YE.SequenceStart Maybe Text
manc Tag
tag NodeStyle
_ -> Pos -> Maybe Text -> PT n m n -> PT n m n
registerAnchor Pos
pos Maybe Text
manc forall a b. (a -> b) -> a -> b
$ do
[n]
ns <- forall (m :: * -> *) n a.
Monad m =>
(Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless (forall a. Eq a => a -> a -> Bool
== Event
YE.SequenceEnd) PT n m n
goNode
Maybe Text -> PT n m ()
exitAnchor Maybe Text
manc
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Tag -> [n] -> LoaderT m n
ySequence Tag
tag [n]
ns Pos
pos)
YE.MappingStart Maybe Text
manc Tag
tag NodeStyle
_ -> Pos -> Maybe Text -> PT n m n -> PT n m n
registerAnchor Pos
pos Maybe Text
manc forall a b. (a -> b) -> a -> b
$ do
[(n, n)]
kvs <- forall (m :: * -> *) n a.
Monad m =>
(Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless (forall a. Eq a => a -> a -> Bool
== Event
YE.MappingEnd) (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) PT n m n
goNode PT n m n
goNode)
Maybe Text -> PT n m ()
exitAnchor Maybe Text
manc
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Tag -> [(n, n)] -> LoaderT m n
yMapping Tag
tag [(n, n)]
kvs Pos
pos)
YE.Alias Text
a -> do
Map Text (NodeId, n)
d <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. S n -> Map Text (NodeId, n)
sDict
Set Text
cy <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall n. S n -> Set Text
sCycle
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
a Map Text (NodeId, n)
d of
Maybe (NodeId, n)
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Pos
pos, (String
"anchor not found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
a))
Just (NodeId
nid,n
n') -> forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NodeId -> Bool -> n -> LoaderT m n
yAlias NodeId
nid (forall a. Ord a => a -> Set a -> Bool
Set.member Text
a Set Text
cy) n
n' Pos
pos)
Event
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Pos
pos, String
"goNode: unexpected event")
data S n = S { forall n. S n -> [EvPos]
sEvs :: [YE.EvPos]
, forall n. S n -> Map Text (NodeId, n)
sDict :: Map YE.Anchor (Word,n)
, forall n. S n -> Set Text
sCycle :: Set YE.Anchor
, forall n. S n -> NodeId
sIdCnt :: !Word
}
newtype PT n m a = PT (StateT (S n) (ExceptT (YE.Pos, String) m) a)
deriving ( forall a b. a -> PT n m b -> PT n m a
forall a b. (a -> b) -> PT n m a -> PT n m b
forall n (m :: * -> *) a b. Functor m => a -> PT n m b -> PT n m a
forall n (m :: * -> *) a b.
Functor m =>
(a -> b) -> PT n m a -> PT n m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PT n m b -> PT n m a
$c<$ :: forall n (m :: * -> *) a b. Functor m => a -> PT n m b -> PT n m a
fmap :: forall a b. (a -> b) -> PT n m a -> PT n m b
$cfmap :: forall n (m :: * -> *) a b.
Functor m =>
(a -> b) -> PT n m a -> PT n m b
Functor
, forall a. a -> PT n m a
forall a b. PT n m a -> PT n m b -> PT n m a
forall a b. PT n m a -> PT n m b -> PT n m b
forall a b. PT n m (a -> b) -> PT n m a -> PT n m b
forall a b c. (a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
forall {n} {m :: * -> *}. Monad m => Functor (PT n m)
forall n (m :: * -> *) a. Monad m => a -> PT n m a
forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m a
forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m b
forall n (m :: * -> *) a b.
Monad m =>
PT n m (a -> b) -> PT n m a -> PT n m b
forall n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PT n m a -> PT n m b -> PT n m a
$c<* :: forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m a
*> :: forall a b. PT n m a -> PT n m b -> PT n m b
$c*> :: forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m b
liftA2 :: forall a b c. (a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
$cliftA2 :: forall n (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
<*> :: forall a b. PT n m (a -> b) -> PT n m a -> PT n m b
$c<*> :: forall n (m :: * -> *) a b.
Monad m =>
PT n m (a -> b) -> PT n m a -> PT n m b
pure :: forall a. a -> PT n m a
$cpure :: forall n (m :: * -> *) a. Monad m => a -> PT n m a
Applicative
, forall a. a -> PT n m a
forall a b. PT n m a -> PT n m b -> PT n m b
forall a b. PT n m a -> (a -> PT n m b) -> PT n m b
forall n (m :: * -> *). Monad m => Applicative (PT n m)
forall n (m :: * -> *) a. Monad m => a -> PT n m a
forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m b
forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> (a -> PT n m b) -> PT n m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PT n m a
$creturn :: forall n (m :: * -> *) a. Monad m => a -> PT n m a
>> :: forall a b. PT n m a -> PT n m b -> PT n m b
$c>> :: forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> PT n m b -> PT n m b
>>= :: forall a b. PT n m a -> (a -> PT n m b) -> PT n m b
$c>>= :: forall n (m :: * -> *) a b.
Monad m =>
PT n m a -> (a -> PT n m b) -> PT n m b
Monad
, MonadState (S n)
, MonadError (YE.Pos, String)
, forall a. (a -> PT n m a) -> PT n m a
forall {n} {m :: * -> *}. MonadFix m => Monad (PT n m)
forall n (m :: * -> *) a. MonadFix m => (a -> PT n m a) -> PT n m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: forall a. (a -> PT n m a) -> PT n m a
$cmfix :: forall n (m :: * -> *) a. MonadFix m => (a -> PT n m a) -> PT n m a
MonadFix
)
instance MonadTrans (PT n) where
lift :: forall (m :: * -> *) a. Monad m => m a -> PT n m a
lift = forall n (m :: * -> *) a.
StateT (S n) (ExceptT (Pos, String) m) a -> PT n m a
PT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
runParserT :: Monad m => PT n m a -> [YE.EvPos] -> m (Either (YE.Pos, String) a)
runParserT :: forall (m :: * -> *) n a.
Monad m =>
PT n m a -> [EvPos] -> m (Either (Pos, String) a)
runParserT (PT StateT (S n) (ExceptT (Pos, String) m) a
act) [EvPos]
s0 = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT (S n) (ExceptT (Pos, String) m) a
act (forall n.
[EvPos] -> Map Text (NodeId, n) -> Set Text -> NodeId -> S n
S [EvPos]
s0 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty NodeId
0)
satisfy :: Monad m => (YE.Event -> Bool) -> PT n m YE.EvPos
satisfy :: forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
satisfy Event -> Bool
p = do
S n
s0 <- forall s (m :: * -> *). MonadState s m => m s
get
case forall n. S n -> [EvPos]
sEvs S n
s0 of
[] -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Pos
fakePos, String
"satisfy: premature eof")
(EvPos
ev:[EvPos]
rest)
| Event -> Bool
p (EvPos -> Event
YE.eEvent EvPos
ev) -> do forall s (m :: * -> *). MonadState s m => s -> m ()
put (S n
s0 { sEvs :: [EvPos]
sEvs = [EvPos]
rest})
forall (m :: * -> *) a. Monad m => a -> m a
return EvPos
ev
| Bool
otherwise -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EvPos -> Pos
YE.ePos EvPos
ev, (String
"satisfy: predicate failed " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EvPos
ev))
peek :: Monad m => PT n m (Maybe YE.EvPos)
peek :: forall (m :: * -> *) n. Monad m => PT n m (Maybe EvPos)
peek = do
S n
s0 <- forall s (m :: * -> *). MonadState s m => m s
get
case forall n. S n -> [EvPos]
sEvs S n
s0 of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
(EvPos
ev:[EvPos]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just EvPos
ev)
peek1 :: Monad m => PT n m YE.EvPos
peek1 :: forall (m :: * -> *) n. Monad m => PT n m EvPos
peek1 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Pos
fakePos,String
"peek1: premature eof")) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) n. Monad m => PT n m (Maybe EvPos)
peek
anyEv :: Monad m => PT n m YE.EvPos
anyEv :: forall (m :: * -> *) n. Monad m => PT n m EvPos
anyEv = forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
satisfy (forall a b. a -> b -> a
const Bool
True)
eof :: Monad m => PT n m ()
eof :: forall (m :: * -> *) n. Monad m => PT n m ()
eof = do
S n
s0 <- forall s (m :: * -> *). MonadState s m => m s
get
case forall n. S n -> [EvPos]
sEvs S n
s0 of
[] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(EvPos
ev:[EvPos]
_) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EvPos -> Pos
YE.ePos EvPos
ev, String
"eof expected")
manyUnless :: Monad m => (YE.Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless :: forall (m :: * -> *) n a.
Monad m =>
(Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless Event -> Bool
p PT n m a
act = do
EvPos
t0 <- forall (m :: * -> *) n. Monad m => PT n m EvPos
peek1
if Event -> Bool
p (EvPos -> Event
YE.eEvent EvPos
t0)
then forall (m :: * -> *) n. Monad m => PT n m EvPos
anyEv forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) PT n m a
act (forall (m :: * -> *) n a.
Monad m =>
(Event -> Bool) -> PT n m a -> PT n m [a]
manyUnless Event -> Bool
p PT n m a
act)
isDocStart :: YE.Event -> Bool
isDocStart :: Event -> Bool
isDocStart (YE.DocumentStart Directives
_) = Bool
True
isDocStart Event
_ = Bool
False
isDocEnd :: YE.Event -> Bool
isDocEnd :: Event -> Bool
isDocEnd (YE.DocumentEnd Bool
_) = Bool
True
isDocEnd Event
_ = Bool
False
fakePos :: YE.Pos
fakePos :: Pos
fakePos = YE.Pos { posByteOffset :: Int
posByteOffset = -Int
1 , posCharOffset :: Int
posCharOffset = -Int
1 , posLine :: Int
posLine = Int
1 , posColumn :: Int
posColumn = Int
0 }