    {-# LANGUAGE GeneralizedNewtypeDeriving #-}
    {-# LANGUAGE OverloadedStrings          #-}
    {-# LANGUAGE RecordWildCards            #-}
    {-# LANGUAGE RecursiveDo                #-}
    {-# LANGUAGE ScopedTypeVariables        #-}
    {-# LANGUAGE Trustworthy                #-}

    -- |
    -- Copyright: © Herbert Valerio Riedel 2015-2018
    -- SPDX-License-Identifier: GPL-2.0-or-later
    --
    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

    -- | Unique identifier for identifying nodes
    --
    -- This is allows to observe the alias/anchor-reference structure
    type NodeId = Word

    -- | Structure defining how to construct a document tree/graph
    --
    -- @since 0.2.0
    --
    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
      }

    -- | Helper type for 'Loader'
    --
    -- @since 0.2.0
    type LoaderT m n = YE.Pos -> m (Either (YE.Pos,String) n)

    -- TODO: newtype LoaderT m n = LoaderT { runLoaderT :: YE.Pos -> m (Either String n) }

    -- | Generalised document tree/graph construction
    --
    -- This doesn't yet perform any tag resolution (thus all scalars are
    -- represented as 'Text' values). See also 'Data.YAML.decodeNode' for a more
    -- convenient interface.
    --
    -- @since 0.2.0
    {-# 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
    yScalar :: forall (m :: * -> *) n.
    Loader m n -> Tag -> ScalarStyle -> Text -> LoaderT m n
    ySequence :: forall (m :: * -> *) n. Loader m n -> Tag -> [n] -> LoaderT m n
    yMapping :: forall (m :: * -> *) n.
    Loader m n -> Tag -> [(n, n)] -> LoaderT m n
    yAlias :: forall (m :: * -> *) n.
    Loader m n -> NodeId -> Bool -> n -> LoaderT m n
    yAnchor :: forall (m :: * -> *) n. Loader m n -> NodeId -> n -> LoaderT m n
    yScalar :: Tag -> ScalarStyle -> Text -> LoaderT m n
    ySequence :: Tag -> [n] -> LoaderT m n
    yMapping :: Tag -> [(n, n)] -> LoaderT m n
    yAlias :: NodeId -> Bool -> n -> LoaderT m n
    yAnchor :: NodeId -> n -> LoaderT m n
    ..} ByteString
    bs0 = do
        case [Either (Pos, String) EvPos] -> Either (Pos, String) [EvPos]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence ([Either (Pos, String) EvPos] -> Either (Pos, String) [EvPos])
    -> [Either (Pos, String) EvPos] -> Either (Pos, String) [EvPos]
    forall a b. (a -> b) -> a -> b
    $ (Either (Pos, String) EvPos -> Bool)
    -> [Either (Pos, String) EvPos] -> [Either (Pos, String) EvPos]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not(Bool -> Bool)
    -> (Either (Pos, String) EvPos -> Bool)
    -> Either (Pos, String) EvPos
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Either (Pos, String) EvPos -> Bool
    forall {a}. Either a EvPos -> Bool
    isComment) (ByteString -> [Either (Pos, String) EvPos]
    YE.parseEvents ByteString
    bs0) of
          Left (Pos
    pos,String
    err) -> Either (Pos, String) [n] -> m (Either (Pos, String) [n])
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either (Pos, String) [n] -> m (Either (Pos, String) [n]))
    -> Either (Pos, String) [n] -> m (Either (Pos, String) [n])
    forall a b. (a -> b) -> a -> b
    $ (Pos, String) -> Either (Pos, String) [n]
    forall a b. a -> Either a b
    Left (Pos
    pos,String
    err)
          Right [EvPos]
    evs      -> PT n m [n] -> [EvPos] -> m (Either (Pos, String) [n])
    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
          _ <- (Event -> Bool) -> PT n m EvPos
    forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
    satisfy (Event -> Event -> Bool
    forall a. Eq a => a -> a -> Bool
    == Event
    YE.StreamStart)
          ds <- manyUnless (== YE.StreamEnd) goDoc
          eof
          return ds

        goDoc :: PT n m n
        goDoc :: PT n m n
    goDoc = do
          _ <- (Event -> Bool) -> PT n m EvPos
    forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
    satisfy Event -> Bool
    isDocStart
          modify $ \S n
    s0 -> S n
    s0 { sDict = mempty, sCycle = mempty }
          n <- goNode
          _ <- satisfy isDocEnd
          return n

        getNewNid :: PT n m Word
        getNewNid :: PT n m NodeId
    getNewNid = (S n -> (NodeId, S n)) -> PT n m NodeId
    forall a. (S n -> (a, S n)) -> PT n m a
    forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
    state ((S n -> (NodeId, S n)) -> PT n m NodeId)
    -> (S n -> (NodeId, S n)) -> PT n m NodeId
    forall a b. (a -> b) -> a -> b
    $ \S n
    s0 -> let i0 :: NodeId
    i0 = S n -> NodeId
    forall n. S n -> NodeId
    sIdCnt S n
    s0
                                   in (NodeId
    i0, S n
    s0 { sIdCnt = i0+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) = (Pos, String) -> PT n m n
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Pos, String)
    err
        returnNode Pos
    _ Maybe Text
    Nothing (Right n
    node) = n -> PT n m n
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return n
    node
        returnNode Pos
    pos (Just Text
    a) (Right n
    node) = do
          nid <- PT n m NodeId
    getNewNid
          node' <- liftEither' =<< lift (yAnchor nid node pos)
          modify $ \S n
    s0 -> S n
    s0 { sDict = Map.insert a (nid,node') (sDict s0) }
          return 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
          (S n -> S n) -> PT n m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((S n -> S n) -> PT n m ()) -> (S n -> S n) -> PT n m ()
    forall a b. (a -> b) -> a -> b
    $ \S n
    s0 -> S n
    s0 { sCycle = Set.insert a (sCycle s0) }
          nid <- PT n m NodeId
    getNewNid

          mdo
            modify $ \S n
    s0 -> S n
    s0 { sDict = Map.insert a (nid,n) (sDict s0) }
            n0 <- pn
            n  <- liftEither' =<< lift (yAnchor nid n0 pos)
            return n

        exitAnchor :: Maybe YE.Anchor -> PT n m ()
        exitAnchor :: Maybe Text -> PT n m ()
    exitAnchor Maybe Text
    Nothing  = () -> PT n m ()
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        exitAnchor (Just Text
    a) = (S n -> S n) -> PT n m ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((S n -> S n) -> PT n m ()) -> (S n -> S n) -> PT n m ()
    forall a b. (a -> b) -> a -> b
    $ \S n
    s0 -> S n
    s0 { sCycle = Set.delete a (sCycle s0) }

        goNode :: PT n m n
        goNode :: PT n m n
    goNode = do
          n <- PT n m EvPos
    forall (m :: * -> *) n. Monad m => PT n m EvPos
    anyEv
          let pos = EvPos -> Pos
    YE.ePos EvPos
    n
          case YE.eEvent n of
            YE.Scalar Maybe Text
    manc Tag
    tag ScalarStyle
    sty Text
    val -> do
              Maybe Text -> PT n m ()
    exitAnchor Maybe Text
    manc
              n' <- m (Either (Pos, String) n) -> PT n m (Either (Pos, String) n)
    forall (m :: * -> *) a. Monad m => m a -> PT n m a
    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)
              returnNode pos manc $! 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 (PT n m n -> PT n m n) -> PT n m n -> PT n m n
    forall a b. (a -> b) -> a -> b
    $ do
              ns <- (Event -> Bool) -> PT n m n -> PT n m [n]
    forall (m :: * -> *) n a.
    Monad m =>
    (Event -> Bool) -> PT n m a -> PT n m [a]
    manyUnless (Event -> Event -> Bool
    forall a. Eq a => a -> a -> Bool
    == Event
    YE.SequenceEnd) PT n m n
    goNode
              exitAnchor manc
              liftEither' =<< lift (ySequence tag ns 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 (PT n m n -> PT n m n) -> PT n m n -> PT n m n
    forall a b. (a -> b) -> a -> b
    $ do
              kvs <- (Event -> Bool) -> PT n m (n, n) -> PT n m [(n, n)]
    forall (m :: * -> *) n a.
    Monad m =>
    (Event -> Bool) -> PT n m a -> PT n m [a]
    manyUnless (Event -> Event -> Bool
    forall a. Eq a => a -> a -> Bool
    == Event
    YE.MappingEnd) ((n -> n -> (n, n)) -> PT n m n -> PT n m n -> PT n m (n, n)
    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)
              exitAnchor manc
              liftEither' =<< lift (yMapping tag kvs pos)

            YE.Alias Text
    a -> do
              d <- (S n -> Map Text (NodeId, n)) -> PT n m (Map Text (NodeId, n))
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets S n -> Map Text (NodeId, n)
    forall n. S n -> Map Text (NodeId, n)
    sDict
              cy <- gets sCycle
              case Map.lookup a d of
                Maybe (NodeId, n)
    Nothing       -> (Pos, String) -> PT n m n
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Pos
    pos, (String
    "anchor not found: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    forall a. Show a => a -> String
    show Text
    a))
                Just (NodeId
    nid,n
    n') -> Either (Pos, String) n -> PT n m n
    forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
    liftEither' (Either (Pos, String) n -> PT n m n)
    -> PT n m (Either (Pos, String) n) -> PT n m n
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< m (Either (Pos, String) n) -> PT n m (Either (Pos, String) n)
    forall (m :: * -> *) a. Monad m => m a -> PT n m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (NodeId -> Bool -> n -> LoaderT m n
    yAlias NodeId
    nid (Text -> Set Text -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member Text
    a Set Text
    cy) n
    n' Pos
    pos)

            Event
    _ -> (Pos, String) -> PT n m n
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Pos
    pos, String
    "goNode: unexpected event")

    ----------------------------------------------------------------------------
    -- small parser framework

    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 -> b) -> PT n m a -> PT n m b)
    -> (forall a b. a -> PT n m b -> PT n m a) -> Functor (PT n m)
    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
    $cfmap :: forall n (m :: * -> *) a b.
    Functor m =>
    (a -> b) -> PT n m a -> PT n m b
    fmap :: forall a b. (a -> b) -> PT n m a -> PT n m b
    $c<$ :: forall n (m :: * -> *) a b. Functor m => a -> PT n m b -> PT n m a
    <$ :: forall a b. a -> PT n m b -> PT n m a
    Functor
                              , Functor (PT n m)
    Functor (PT n m) =>
    (forall a. a -> PT n m a)
    -> (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 a b. PT n m a -> PT n m b -> PT n m b)
    -> (forall a b. PT n m a -> PT n m b -> PT n m a)
    -> Applicative (PT n m)
    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
    $cpure :: forall n (m :: * -> *) a. Monad m => a -> PT n m a
    pure :: forall a. a -> PT n m a
    $c<*> :: forall n (m :: * -> *) a b.
    Monad m =>
    PT n m (a -> b) -> PT n m a -> PT n m b
    <*> :: forall a b. PT n m (a -> b) -> PT n m a -> PT n m b
    $cliftA2 :: forall n (m :: * -> *) a b c.
    Monad m =>
    (a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
    liftA2 :: forall a b c. (a -> b -> c) -> PT n m a -> PT n m b -> PT n m c
    $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 -> 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 a
    <* :: forall a b. PT n m a -> PT n m b -> PT n m a
    Applicative
                              , Applicative (PT n m)
    Applicative (PT n m) =>
    (forall a b. PT n m a -> (a -> PT n m b) -> PT n m b)
    -> (forall a b. PT n m a -> PT n m b -> PT n m b)
    -> (forall a. a -> PT n m a)
    -> Monad (PT n m)
    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
    $c>>= :: forall n (m :: * -> *) a b.
    Monad m =>
    PT n m a -> (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 -> PT n m b -> PT n m b
    >> :: forall a b. PT n m a -> PT n m b -> PT n m b
    $creturn :: forall n (m :: * -> *) a. Monad m => a -> PT n m a
    return :: forall a. a -> PT n m a
    Monad
                              , MonadState (S n)
                              , MonadError (YE.Pos, String)
                              , Monad (PT n m)
    Monad (PT n m) =>
    (forall a. (a -> PT n m a) -> PT n m a) -> MonadFix (PT n m)
    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
    $cmfix :: forall n (m :: * -> *) a. MonadFix m => (a -> PT n m a) -> PT n m a
    mfix :: forall a. (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 = StateT (S n) (ExceptT (Pos, String) m) a -> PT n m a
    forall n (m :: * -> *) a.
    StateT (S n) (ExceptT (Pos, String) m) a -> PT n m a
    PT (StateT (S n) (ExceptT (Pos, String) m) a -> PT n m a)
    -> (m a -> StateT (S n) (ExceptT (Pos, String) m) a)
    -> m a
    -> PT n m a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ExceptT (Pos, String) m a
    -> StateT (S n) (ExceptT (Pos, String) m) a
    forall (m :: * -> *) a. Monad m => m a -> StateT (S n) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (ExceptT (Pos, String) m a
     -> StateT (S n) (ExceptT (Pos, String) m) a)
    -> (m a -> ExceptT (Pos, String) m a)
    -> m a
    -> StateT (S n) (ExceptT (Pos, String) m) a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . m a -> ExceptT (Pos, String) m a
    forall (m :: * -> *) a. Monad m => m a -> ExceptT (Pos, String) m a
    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 = ExceptT (Pos, String) m a -> m (Either (Pos, String) a)
    forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
    runExceptT (ExceptT (Pos, String) m a -> m (Either (Pos, String) a))
    -> ExceptT (Pos, String) m a -> m (Either (Pos, String) a)
    forall a b. (a -> b) -> a -> b
    $ StateT (S n) (ExceptT (Pos, String) m) a
    -> S n -> ExceptT (Pos, String) m a
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT StateT (S n) (ExceptT (Pos, String) m) a
    act ([EvPos] -> Map Text (NodeId, n) -> Set Text -> NodeId -> S n
    forall n.
    [EvPos] -> Map Text (NodeId, n) -> Set Text -> NodeId -> S n
    S [EvPos]
    s0 Map Text (NodeId, n)
    forall a. Monoid a => a
    mempty Set Text
    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
      s0 <- PT n m (S n)
    forall s (m :: * -> *). MonadState s m => m s
    get
      case sEvs s0 of
        [] -> (Pos, String) -> PT n m EvPos
    forall a. (Pos, String) -> PT n m a
    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 S n -> PT n m ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (S n
    s0 { sEvs = rest})
                                    EvPos -> PT n m EvPos
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EvPos
    ev
           | Bool
    otherwise        -> (Pos, String) -> PT n m EvPos
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EvPos -> Pos
    YE.ePos EvPos
    ev, (String
    "satisfy: predicate failed " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ EvPos -> String
    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
      s0 <- PT n m (S n)
    forall s (m :: * -> *). MonadState s m => m s
    get
      case sEvs s0 of
        []     -> Maybe EvPos -> PT n m (Maybe EvPos)
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe EvPos
    forall a. Maybe a
    Nothing
        (EvPos
    ev:[EvPos]
    _) -> Maybe EvPos -> PT n m (Maybe EvPos)
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvPos -> Maybe EvPos
    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 = PT n m EvPos
    -> (EvPos -> PT n m EvPos) -> Maybe EvPos -> PT n m EvPos
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((Pos, String) -> PT n m EvPos
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (Pos
    fakePos,String
    "peek1: premature eof")) EvPos -> PT n m EvPos
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe EvPos -> PT n m EvPos)
    -> PT n m (Maybe EvPos) -> PT n m EvPos
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< PT n m (Maybe EvPos)
    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 = (Event -> Bool) -> PT n m EvPos
    forall (m :: * -> *) n. Monad m => (Event -> Bool) -> PT n m EvPos
    satisfy (Bool -> Event -> Bool
    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
      s0 <- PT n m (S n)
    forall s (m :: * -> *). MonadState s m => m s
    get
      case sEvs s0 of
        []     -> () -> PT n m ()
    forall a. a -> PT n m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        (EvPos
    ev:[EvPos]
    _) -> (Pos, String) -> PT n m ()
    forall a. (Pos, String) -> PT n m a
    forall e (m :: * -> *) a. MonadError e m => e -> m a
    throwError (EvPos -> Pos
    YE.ePos EvPos
    ev, String
    "eof expected")

    -- NB: consumes the end-event
    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
      t0 <- PT n m EvPos
    forall (m :: * -> *) n. Monad m => PT n m EvPos
    peek1
      if p (YE.eEvent t0)
        then anyEv >> return []
        else liftM2 (:) act (manyUnless p act)

    {-
    tryError :: MonadError e m => m a -> m (Either e a)
    tryError act = catchError (Right <$> act) (pure . Left)
    -}

    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 }