{-# LANGUAGE TupleSections #-}

module Data.Yaml.Marked.Internal
  ( Warning (..)
  , decodeHelper
  , decodeAllHelper

    -- * Debugging helpers
  , debugEventStream_
  , debugEventStream
  ) where

import Prelude

import Conduit
import Control.Applicative ((<|>))
import Control.Monad (unless, void, when)
import Control.Monad.Reader (MonadReader (..), asks)
import Control.Monad.State (MonadState (..), gets, modify)
import Control.Monad.Trans.RWS.Strict (RWST, evalRWST)
import Control.Monad.Writer (MonadWriter (..), tell)
import Data.Aeson.Compat.Key (Key)
import qualified Data.Aeson.Compat.Key as Key
import Data.Aeson.Compat.KeyMap (KeyMap)
import qualified Data.Aeson.Compat.KeyMap as KeyMap
import Data.Aeson.Types (JSONPath, JSONPathElement (..))
import qualified Data.Attoparsec.Text as Atto
import Data.Bifunctor (first, second)
import Data.Bitraversable (Bitraversable, bimapM)
import Data.Bits (shiftL, (.|.))
import Data.ByteString (ByteString)
import Data.Char (isOctDigit, ord)
import Data.DList (DList)
import Data.Foldable (toList, traverse_)
import Data.List (foldl', (\\))
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Scientific (Scientific)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import qualified Data.Vector as V
import Data.Yaml (ParseException (..))
import Data.Yaml.Marked
import Data.Yaml.Marked.Value
import Text.Libyaml hiding (decode, decodeFile, encode, encodeFile)
import qualified Text.Libyaml as Y
import UnliftIO.Exception

newtype Warning = DuplicateKey JSONPath
  deriving stock (Warning -> Warning -> Bool
(Warning -> Warning -> Bool)
-> (Warning -> Warning -> Bool) -> Eq Warning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Warning -> Warning -> Bool
== :: Warning -> Warning -> Bool
$c/= :: Warning -> Warning -> Bool
/= :: Warning -> Warning -> Bool
Eq, Int -> Warning -> ShowS
[Warning] -> ShowS
Warning -> String
(Int -> Warning -> ShowS)
-> (Warning -> String) -> ([Warning] -> ShowS) -> Show Warning
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Warning -> ShowS
showsPrec :: Int -> Warning -> ShowS
$cshow :: Warning -> String
show :: Warning -> String
$cshowList :: [Warning] -> ShowS
showList :: [Warning] -> ShowS
Show)

newtype ParseT m a = ParseT
  { forall (m :: * -> *) a.
ParseT m a
-> RWST JSONPath (DList Warning) (Map String (Marked Value)) m a
unParseT :: RWST JSONPath (DList Warning) (Map String (Marked Value)) m a
  }
  deriving newtype
    ( (forall a b. (a -> b) -> ParseT m a -> ParseT m b)
-> (forall a b. a -> ParseT m b -> ParseT m a)
-> Functor (ParseT m)
forall a b. a -> ParseT m b -> ParseT m a
forall a b. (a -> b) -> ParseT m a -> ParseT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ParseT m b -> ParseT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParseT m a -> ParseT 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 (m :: * -> *) a b.
Functor m =>
(a -> b) -> ParseT m a -> ParseT m b
fmap :: forall a b. (a -> b) -> ParseT m a -> ParseT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ParseT m b -> ParseT m a
<$ :: forall a b. a -> ParseT m b -> ParseT m a
Functor
    , Functor (ParseT m)
Functor (ParseT m) =>
(forall a. a -> ParseT m a)
-> (forall a b. ParseT m (a -> b) -> ParseT m a -> ParseT m b)
-> (forall a b c.
    (a -> b -> c) -> ParseT m a -> ParseT m b -> ParseT m c)
-> (forall a b. ParseT m a -> ParseT m b -> ParseT m b)
-> (forall a b. ParseT m a -> ParseT m b -> ParseT m a)
-> Applicative (ParseT m)
forall a. a -> ParseT m a
forall a b. ParseT m a -> ParseT m b -> ParseT m a
forall a b. ParseT m a -> ParseT m b -> ParseT m b
forall a b. ParseT m (a -> b) -> ParseT m a -> ParseT m b
forall a b c.
(a -> b -> c) -> ParseT m a -> ParseT m b -> ParseT m c
forall (m :: * -> *). Monad m => Functor (ParseT m)
forall (m :: * -> *) a. Monad m => a -> ParseT m a
forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m a
forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m b
forall (m :: * -> *) a b.
Monad m =>
ParseT m (a -> b) -> ParseT m a -> ParseT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ParseT m a -> ParseT m b -> ParseT 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 (m :: * -> *) a. Monad m => a -> ParseT m a
pure :: forall a. a -> ParseT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
ParseT m (a -> b) -> ParseT m a -> ParseT m b
<*> :: forall a b. ParseT m (a -> b) -> ParseT m a -> ParseT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> ParseT m a -> ParseT m b -> ParseT m c
liftA2 :: forall a b c.
(a -> b -> c) -> ParseT m a -> ParseT m b -> ParseT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m b
*> :: forall a b. ParseT m a -> ParseT m b -> ParseT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m a
<* :: forall a b. ParseT m a -> ParseT m b -> ParseT m a
Applicative
    , Applicative (ParseT m)
Applicative (ParseT m) =>
(forall a b. ParseT m a -> (a -> ParseT m b) -> ParseT m b)
-> (forall a b. ParseT m a -> ParseT m b -> ParseT m b)
-> (forall a. a -> ParseT m a)
-> Monad (ParseT m)
forall a. a -> ParseT m a
forall a b. ParseT m a -> ParseT m b -> ParseT m b
forall a b. ParseT m a -> (a -> ParseT m b) -> ParseT m b
forall (m :: * -> *). Monad m => Applicative (ParseT m)
forall (m :: * -> *) a. Monad m => a -> ParseT m a
forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m b
forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> (a -> ParseT m b) -> ParseT 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 (m :: * -> *) a b.
Monad m =>
ParseT m a -> (a -> ParseT m b) -> ParseT m b
>>= :: forall a b. ParseT m a -> (a -> ParseT m b) -> ParseT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ParseT m a -> ParseT m b -> ParseT m b
>> :: forall a b. ParseT m a -> ParseT m b -> ParseT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ParseT m a
return :: forall a. a -> ParseT m a
Monad
    , Monad (ParseT m)
Monad (ParseT m) =>
(forall a. IO a -> ParseT m a) -> MonadIO (ParseT m)
forall a. IO a -> ParseT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (ParseT m)
forall (m :: * -> *) a. MonadIO m => IO a -> ParseT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> ParseT m a
liftIO :: forall a. IO a -> ParseT m a
MonadIO
    , MonadIO (ParseT m)
MonadIO (ParseT m) =>
(forall a. ResourceT IO a -> ParseT m a)
-> MonadResource (ParseT m)
forall a. ResourceT IO a -> ParseT m a
forall (m :: * -> *).
MonadIO m =>
(forall a. ResourceT IO a -> m a) -> MonadResource m
forall (m :: * -> *). MonadResource m => MonadIO (ParseT m)
forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> ParseT m a
$cliftResourceT :: forall (m :: * -> *) a.
MonadResource m =>
ResourceT IO a -> ParseT m a
liftResourceT :: forall a. ResourceT IO a -> ParseT m a
MonadResource
    , MonadReader JSONPath
    , MonadWriter (DList Warning)
    , MonadState (Map String (Marked Value))
    )

runParseT :: Monad m => ParseT m a -> m (a, [Warning])
runParseT :: forall (m :: * -> *) a. Monad m => ParseT m a -> m (a, [Warning])
runParseT ParseT m a
p = (DList Warning -> [Warning])
-> (a, DList Warning) -> (a, [Warning])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second DList Warning -> [Warning]
forall a. DList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ((a, DList Warning) -> (a, [Warning]))
-> m (a, DList Warning) -> m (a, [Warning])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST JSONPath (DList Warning) (Map String (Marked Value)) m a
-> JSONPath -> Map String (Marked Value) -> m (a, DList Warning)
forall (m :: * -> *) r w s a.
Monad m =>
RWST r w s m a -> r -> s -> m (a, w)
evalRWST (ParseT m a
-> RWST JSONPath (DList Warning) (Map String (Marked Value)) m a
forall (m :: * -> *) a.
ParseT m a
-> RWST JSONPath (DList Warning) (Map String (Marked Value)) m a
unParseT ParseT m a
p) [] Map String (Marked Value)
forall a. Monoid a => a
mempty

type Parse = ParseT (ResourceT IO)

runParse :: ConduitT () Void Parse a -> IO (a, [Warning])
runParse :: forall a. ConduitT () Void Parse a -> IO (a, [Warning])
runParse = ResourceT IO (a, [Warning]) -> IO (a, [Warning])
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO (a, [Warning]) -> IO (a, [Warning]))
-> (ConduitT () Void Parse a -> ResourceT IO (a, [Warning]))
-> ConduitT () Void Parse a
-> IO (a, [Warning])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseT (ResourceT IO) a -> ResourceT IO (a, [Warning])
forall (m :: * -> *) a. Monad m => ParseT m a -> m (a, [Warning])
runParseT (ParseT (ResourceT IO) a -> ResourceT IO (a, [Warning]))
-> (ConduitT () Void Parse a -> ParseT (ResourceT IO) a)
-> ConduitT () Void Parse a
-> ResourceT IO (a, [Warning])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void Parse a -> ParseT (ResourceT IO) a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit

defineAnchor
  :: MonadState (Map String (Marked Value)) m
  => String
  -> Marked Value
  -> m ()
defineAnchor :: forall (m :: * -> *).
MonadState (Map String (Marked Value)) m =>
String -> Marked Value -> m ()
defineAnchor String
name = (Map String (Marked Value) -> Map String (Marked Value)) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((Map String (Marked Value) -> Map String (Marked Value)) -> m ())
-> (Marked Value
    -> Map String (Marked Value) -> Map String (Marked Value))
-> Marked Value
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Marked Value
-> Map String (Marked Value)
-> Map String (Marked Value)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name

lookupAnchor
  :: (MonadIO m, MonadState (Map String (Marked Value)) m)
  => String
  -> m (Marked Value)
lookupAnchor :: forall (m :: * -> *).
(MonadIO m, MonadState (Map String (Marked Value)) m) =>
String -> m (Marked Value)
lookupAnchor String
name =
  m (Marked Value)
-> (Marked Value -> m (Marked Value))
-> Maybe (Marked Value)
-> m (Marked Value)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ParseException -> m (Marked Value)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> m (Marked Value))
-> ParseException -> m (Marked Value)
forall a b. (a -> b) -> a -> b
$ String -> ParseException
UnknownAlias String
name) Marked Value -> m (Marked Value)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Marked Value) -> m (Marked Value))
-> m (Maybe (Marked Value)) -> m (Marked Value)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Map String (Marked Value) -> Maybe (Marked Value))
-> m (Maybe (Marked Value))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (String -> Map String (Marked Value) -> Maybe (Marked Value)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name)

lookupAliasKey
  :: ( MonadIO m
     , MonadState (Map String (Marked Value)) m
     )
  => String
  -> m Key
lookupAliasKey :: forall (m :: * -> *).
(MonadIO m, MonadState (Map String (Marked Value)) m) =>
String -> m Key
lookupAliasKey String
an = do
  Marked Value
a <- String -> m (Marked Value)
forall (m :: * -> *).
(MonadIO m, MonadState (Map String (Marked Value)) m) =>
String -> m (Marked Value)
lookupAnchor String
an
  case Marked Value
a of
    Marked Value
v | String Text
t <- Marked Value -> Value
forall a. Marked a -> a
markedItem Marked Value
v -> Key -> m Key
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> m Key) -> Key -> m Key
forall a b. (a -> b) -> a -> b
$ Text -> Key
Key.fromText Text
t
    Marked Value
v -> ParseException -> m Key
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> m Key) -> ParseException -> m Key
forall a b. (a -> b) -> a -> b
$ String -> Value -> ParseException
NonStringKeyAlias String
an (Value -> ParseException) -> Value -> ParseException
forall a b. (a -> b) -> a -> b
$ Value -> Value
valueToValue (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Marked Value -> Value
forall a. Marked a -> a
markedItem Marked Value
v

decodeHelper
  :: MonadIO m
  => (Marked Value -> Either String a)
  -> FilePath
  -- ^ Name for file being parsed
  -> ConduitT () MarkedEvent Parse ()
  -- ^ "Text.Libyaml" source
  -> m (Either ParseException (a, [Warning]))
decodeHelper :: forall (m :: * -> *) a.
MonadIO m =>
(Marked Value -> Either String a)
-> String
-> ConduitT () MarkedEvent Parse ()
-> m (Either ParseException (a, [Warning]))
decodeHelper Marked Value -> Either String a
parse String
fp ConduitT () MarkedEvent Parse ()
src =
  ConduitT (Marked Event) Void Parse (Maybe (Marked Value))
-> (Maybe (Marked Value) -> Either String a)
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException (a, [Warning]))
forall (m :: * -> *) val a.
MonadIO m =>
ConduitT (Marked Event) Void Parse val
-> (val -> Either String a)
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException (a, [Warning]))
mkHelper ConduitT (Marked Event) Void Parse (Maybe (Marked Value))
forall o. ConduitT (Marked Event) o Parse (Maybe (Marked Value))
parseOne Maybe (Marked Value) -> Either String a
go (ConduitT () (Marked Event) Parse ()
 -> m (Either ParseException (a, [Warning])))
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException (a, [Warning]))
forall a b. (a -> b) -> a -> b
$ ConduitT () MarkedEvent Parse ()
src ConduitT () MarkedEvent Parse ()
-> ConduitT MarkedEvent (Marked Event) Parse ()
-> ConduitT () (Marked Event) Parse ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (MarkedEvent -> Marked Event)
-> ConduitT MarkedEvent (Marked Event) Parse ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (MarkedEvent -> String -> Marked Event
`fromMarkedEvent` String
fp)
 where
  go :: Maybe (Marked Value) -> Either String a
go = \case
    Maybe (Marked Value)
Nothing -> Marked Value -> Either String a
parse Marked Value
zeroMarkedNull
    Just Marked Value
mv -> Marked Value -> Either String a
parse Marked Value
mv

  zeroMarkedNull :: Marked Value
zeroMarkedNull =
    Marked
      { markedItem :: Value
markedItem = Value
Null
      , markedPath :: String
markedPath = String
fp
      , markedJSONPath :: Maybe JSONPath
markedJSONPath = Maybe JSONPath
forall a. Maybe a
Nothing
      , markedLocationStart :: Location
markedLocationStart = Natural -> Natural -> Natural -> Location
Location Natural
0 Natural
0 Natural
0
      , markedLocationEnd :: Location
markedLocationEnd = Natural -> Natural -> Natural -> Location
Location Natural
0 Natural
0 Natural
0
      }

decodeAllHelper
  :: MonadIO m
  => (Marked Value -> Either String a)
  -> FilePath
  -- ^ Name for file being parsed
  -> ConduitT () MarkedEvent Parse ()
  -- ^ "Text.Libyaml" source
  -> m (Either ParseException ([a], [Warning]))
decodeAllHelper :: forall (m :: * -> *) a.
MonadIO m =>
(Marked Value -> Either String a)
-> String
-> ConduitT () MarkedEvent Parse ()
-> m (Either ParseException ([a], [Warning]))
decodeAllHelper Marked Value -> Either String a
parse String
fp ConduitT () MarkedEvent Parse ()
src =
  ConduitT (Marked Event) Void Parse [Marked Value]
-> ([Marked Value] -> Either String [a])
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException ([a], [Warning]))
forall (m :: * -> *) val a.
MonadIO m =>
ConduitT (Marked Event) Void Parse val
-> (val -> Either String a)
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException (a, [Warning]))
mkHelper ConduitT (Marked Event) Void Parse [Marked Value]
forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseAll ((Marked Value -> Either String a)
-> [Marked Value] -> Either String [a]
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 Marked Value -> Either String a
parse) (ConduitT () (Marked Event) Parse ()
 -> m (Either ParseException ([a], [Warning])))
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException ([a], [Warning]))
forall a b. (a -> b) -> a -> b
$ ConduitT () MarkedEvent Parse ()
src ConduitT () MarkedEvent Parse ()
-> ConduitT MarkedEvent (Marked Event) Parse ()
-> ConduitT () (Marked Event) Parse ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (MarkedEvent -> Marked Event)
-> ConduitT MarkedEvent (Marked Event) Parse ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (MarkedEvent -> String -> Marked Event
`fromMarkedEvent` String
fp)

mkHelper
  :: MonadIO m
  => ConduitT (Marked Event) Void Parse val
  -> (val -> Either String a)
  -> ConduitT () (Marked Event) Parse ()
  -> m (Either ParseException (a, [Warning]))
mkHelper :: forall (m :: * -> *) val a.
MonadIO m =>
ConduitT (Marked Event) Void Parse val
-> (val -> Either String a)
-> ConduitT () (Marked Event) Parse ()
-> m (Either ParseException (a, [Warning]))
mkHelper ConduitT (Marked Event) Void Parse val
eventParser val -> Either String a
f ConduitT () (Marked Event) Parse ()
src = IO (Either ParseException (a, [Warning]))
-> m (Either ParseException (a, [Warning]))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ParseException (a, [Warning]))
 -> m (Either ParseException (a, [Warning])))
-> IO (Either ParseException (a, [Warning]))
-> m (Either ParseException (a, [Warning]))
forall a b. (a -> b) -> a -> b
$ IO (Either ParseException (a, [Warning]))
-> [Handler IO (Either ParseException (a, [Warning]))]
-> IO (Either ParseException (a, [Warning]))
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
catches IO (Either ParseException (a, [Warning]))
go [Handler IO (Either ParseException (a, [Warning]))]
forall {m :: * -> *} {b}.
Applicative m =>
[Handler m (Either ParseException b)]
handlers
 where
  go :: IO (Either ParseException (a, [Warning]))
go = (String -> ParseException)
-> Either String (a, [Warning])
-> Either ParseException (a, [Warning])
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ParseException
AesonException (Either String (a, [Warning])
 -> Either ParseException (a, [Warning]))
-> ((val, [Warning]) -> Either String (a, [Warning]))
-> (val, [Warning])
-> Either ParseException (a, [Warning])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (val -> Either String a)
-> (val, [Warning]) -> Either String (a, [Warning])
forall (t :: * -> * -> *) (f :: * -> *) a a' b.
(Bitraversable t, Applicative f) =>
(a -> f a') -> t a b -> f (t a' b)
firstM val -> Either String a
f ((val, [Warning]) -> Either ParseException (a, [Warning]))
-> IO (val, [Warning]) -> IO (Either ParseException (a, [Warning]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT () Void Parse val -> IO (val, [Warning])
forall a. ConduitT () Void Parse a -> IO (a, [Warning])
runParse (ConduitT () (Marked Event) Parse ()
src ConduitT () (Marked Event) Parse ()
-> ConduitT (Marked Event) Void Parse val
-> ConduitT () Void Parse val
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT (Marked Event) Void Parse val
eventParser)
  handlers :: [Handler m (Either ParseException b)]
handlers =
    [ (ParseException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ParseException -> m (Either ParseException b))
 -> Handler m (Either ParseException b))
-> (ParseException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ \ParseException
pe -> Either ParseException b -> m (Either ParseException b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException b -> m (Either ParseException b))
-> Either ParseException b -> m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ ParseException -> Either ParseException b
forall a b. a -> Either a b
Left ParseException
pe
    , (YamlException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((YamlException -> m (Either ParseException b))
 -> Handler m (Either ParseException b))
-> (YamlException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ \YamlException
ye -> Either ParseException b -> m (Either ParseException b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException b -> m (Either ParseException b))
-> Either ParseException b -> m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ ParseException -> Either ParseException b
forall a b. a -> Either a b
Left (ParseException -> Either ParseException b)
-> ParseException -> Either ParseException b
forall a b. (a -> b) -> a -> b
$ Maybe YamlException -> ParseException
InvalidYaml (Maybe YamlException -> ParseException)
-> Maybe YamlException -> ParseException
forall a b. (a -> b) -> a -> b
$ YamlException -> Maybe YamlException
forall a. a -> Maybe a
Just YamlException
ye
    , (SomeException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> m (Either ParseException b))
 -> Handler m (Either ParseException b))
-> (SomeException -> m (Either ParseException b))
-> Handler m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ \SomeException
ex -> Either ParseException b -> m (Either ParseException b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseException b -> m (Either ParseException b))
-> Either ParseException b -> m (Either ParseException b)
forall a b. (a -> b) -> a -> b
$ ParseException -> Either ParseException b
forall a b. a -> Either a b
Left (ParseException -> Either ParseException b)
-> ParseException -> Either ParseException b
forall a b. (a -> b) -> a -> b
$ SomeException -> ParseException
OtherParseException SomeException
ex
    ]

throwUnexpectedEvent :: MonadIO m => Maybe (Marked Event) -> m a
throwUnexpectedEvent :: forall (m :: * -> *) a. MonadIO m => Maybe (Marked Event) -> m a
throwUnexpectedEvent Maybe (Marked Event)
me =
  ParseException -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> m a) -> ParseException -> m a
forall a b. (a -> b) -> a -> b
$ Maybe Event -> Maybe Event -> ParseException
UnexpectedEvent (Marked Event -> Event
forall a. Marked a -> a
markedItem (Marked Event -> Event) -> Maybe (Marked Event) -> Maybe Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Marked Event)
me) Maybe Event
forall a. Maybe a
Nothing

requireEvent :: MonadIO m => Event -> ConduitT (Marked Event) o m ()
requireEvent :: forall (m :: * -> *) o.
MonadIO m =>
Event -> ConduitT (Marked Event) o m ()
requireEvent Event
e = do
  Maybe Event
f <- (Marked Event -> Event) -> Maybe (Marked Event) -> Maybe Event
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Marked Event -> Event
forall a. Marked a -> a
markedItem (Maybe (Marked Event) -> Maybe Event)
-> ConduitT (Marked Event) o m (Maybe (Marked Event))
-> ConduitT (Marked Event) o m (Maybe Event)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT (Marked Event) o m (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC
  Bool
-> ConduitT (Marked Event) o m () -> ConduitT (Marked Event) o m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Event
f Maybe Event -> Maybe Event -> Bool
forall a. Eq a => a -> a -> Bool
== Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e) (ConduitT (Marked Event) o m () -> ConduitT (Marked Event) o m ())
-> ConduitT (Marked Event) o m () -> ConduitT (Marked Event) o m ()
forall a b. (a -> b) -> a -> b
$ ParseException -> ConduitT (Marked Event) o m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> ConduitT (Marked Event) o m ())
-> ParseException -> ConduitT (Marked Event) o m ()
forall a b. (a -> b) -> a -> b
$ Maybe Event -> Maybe Event -> ParseException
UnexpectedEvent Maybe Event
f (Maybe Event -> ParseException) -> Maybe Event -> ParseException
forall a b. (a -> b) -> a -> b
$ Event -> Maybe Event
forall a. a -> Maybe a
Just Event
e

parseOne :: ConduitT (Marked Event) o Parse (Maybe (Marked Value))
parseOne :: forall o. ConduitT (Marked Event) o Parse (Maybe (Marked Value))
parseOne = do
  [Marked Value]
docs <- ConduitT (Marked Event) o Parse [Marked Value]
forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseAll
  case [Marked Value]
docs of
    [] -> Maybe (Marked Value)
-> ConduitT (Marked Event) o Parse (Maybe (Marked Value))
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Marked Value)
forall a. Maybe a
Nothing
    [Marked Value
doc] -> Maybe (Marked Value)
-> ConduitT (Marked Event) o Parse (Maybe (Marked Value))
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Marked Value)
 -> ConduitT (Marked Event) o Parse (Maybe (Marked Value)))
-> Maybe (Marked Value)
-> ConduitT (Marked Event) o Parse (Maybe (Marked Value))
forall a b. (a -> b) -> a -> b
$ Marked Value -> Maybe (Marked Value)
forall a. a -> Maybe a
Just Marked Value
doc
    [Marked Value]
_ -> ParseException
-> ConduitT (Marked Event) o Parse (Maybe (Marked Value))
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO ParseException
MultipleDocuments

parseAll :: ConduitT (Marked Event) o Parse [Marked Value]
parseAll :: forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseAll =
  ConduitT (Marked Event) o Parse (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC ConduitT (Marked Event) o Parse (Maybe (Marked Event))
-> (Maybe (Marked Event)
    -> ConduitT (Marked Event) o Parse [Marked Value])
-> ConduitT (Marked Event) o Parse [Marked Value]
forall a b.
ConduitT (Marked Event) o Parse a
-> (a -> ConduitT (Marked Event) o Parse b)
-> ConduitT (Marked Event) o Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Marked Event)
Nothing -> [Marked Value] -> ConduitT (Marked Event) o Parse [Marked Value]
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Marked Event
me | Event
EventStreamStart <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> ConduitT (Marked Event) o Parse [Marked Value]
forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseStream
    Maybe (Marked Event)
x -> Maybe (Marked Event)
-> ConduitT (Marked Event) o Parse [Marked Value]
forall (m :: * -> *) a. MonadIO m => Maybe (Marked Event) -> m a
throwUnexpectedEvent Maybe (Marked Event)
x

parseStream :: ConduitT (Marked Event) o Parse [Marked Value]
parseStream :: forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseStream =
  ConduitT (Marked Event) o Parse (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC ConduitT (Marked Event) o Parse (Maybe (Marked Event))
-> (Maybe (Marked Event)
    -> ConduitT (Marked Event) o Parse [Marked Value])
-> ConduitT (Marked Event) o Parse [Marked Value]
forall a b.
ConduitT (Marked Event) o Parse a
-> (a -> ConduitT (Marked Event) o Parse b)
-> ConduitT (Marked Event) o Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Marked Event
me | Event
EventStreamEnd <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> [Marked Value] -> ConduitT (Marked Event) o Parse [Marked Value]
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Just Marked Event
me | Event
EventDocumentStart <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> do
      Marked Value
res <- ConduitT (Marked Event) o Parse (Marked Value)
forall o. ConduitT (Marked Event) o Parse (Marked Value)
parseDocument
      Event -> ConduitT (Marked Event) o Parse ()
forall (m :: * -> *) o.
MonadIO m =>
Event -> ConduitT (Marked Event) o m ()
requireEvent Event
EventDocumentEnd
      (Marked Value
res Marked Value -> [Marked Value] -> [Marked Value]
forall a. a -> [a] -> [a]
:) ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse [Marked Value]
-> ConduitT (Marked Event) o Parse [Marked Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT (Marked Event) o Parse [Marked Value]
forall o. ConduitT (Marked Event) o Parse [Marked Value]
parseStream
    Maybe (Marked Event)
x -> Maybe (Marked Event)
-> ConduitT (Marked Event) o Parse [Marked Value]
forall (m :: * -> *) a. MonadIO m => Maybe (Marked Event) -> m a
throwUnexpectedEvent Maybe (Marked Event)
x

parseDocument :: ConduitT (Marked Event) o Parse (Marked Value)
parseDocument :: forall o. ConduitT (Marked Event) o Parse (Marked Value)
parseDocument =
  ConduitT (Marked Event) o Parse (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC ConduitT (Marked Event) o Parse (Maybe (Marked Event))
-> (Maybe (Marked Event)
    -> ConduitT (Marked Event) o Parse (Marked Value))
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b.
ConduitT (Marked Event) o Parse a
-> (a -> ConduitT (Marked Event) o Parse b)
-> ConduitT (Marked Event) o Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Marked Event
me
      | EventScalar ByteString
v Tag
tag Style
style Anchor
a <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me ->
          Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse (Marked Value)
forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse (Marked Value)
parseScalar Marked Event
me ByteString
v Tag
tag Style
style Anchor
a
    Just Marked Event
me
      | EventSequenceStart Tag
_ SequenceStyle
_ Anchor
a <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me ->
          Location
-> Maybe Location
-> Int
-> Anchor
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
forall o.
Location
-> Maybe Location
-> Int
-> Anchor
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
parseSequence (Marked Event -> Location
forall a. Marked a -> Location
markedLocationStart Marked Event
me) Maybe Location
forall a. Maybe a
Nothing Int
0 Anchor
a [Marked Value] -> [Marked Value]
forall a. a -> a
id
    Just Marked Event
me
      | EventMappingStart Tag
_ MappingStyle
_ Anchor
a <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me ->
          Location
-> Maybe Location
-> Set Key
-> Anchor
-> KeyMap (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
forall o.
Location
-> Maybe Location
-> Set Key
-> Anchor
-> KeyMap (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
parseMapping (Marked Event -> Location
forall a. Marked a -> Location
markedLocationStart Marked Event
me) Maybe Location
forall a. Maybe a
Nothing Set Key
forall a. Monoid a => a
mempty Anchor
a KeyMap (Marked Value)
forall a. Monoid a => a
mempty
    Just Marked Event
me | EventAlias String
an <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> String -> ConduitT (Marked Event) o Parse (Marked Value)
forall (m :: * -> *).
(MonadIO m, MonadState (Map String (Marked Value)) m) =>
String -> m (Marked Value)
lookupAnchor String
an
    Maybe (Marked Event)
x -> ParseException -> ConduitT (Marked Event) o Parse (Marked Value)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> ConduitT (Marked Event) o Parse (Marked Value))
-> ParseException -> ConduitT (Marked Event) o Parse (Marked Value)
forall a b. (a -> b) -> a -> b
$ Maybe Event -> Maybe Event -> ParseException
UnexpectedEvent (Marked Event -> Event
forall a. Marked a -> a
markedItem (Marked Event -> Event) -> Maybe (Marked Event) -> Maybe Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Marked Event)
x) Maybe Event
forall a. Maybe a
Nothing

parseSequence
  :: Location
  -- ^ Location where the sequence started
  -> Maybe Location
  -- ^ Ending location of last item within the sequence
  -> Int
  -> Anchor
  -> ([Marked Value] -> [Marked Value])
  -> ConduitT (Marked Event) o Parse (Marked Value)
parseSequence :: forall o.
Location
-> Maybe Location
-> Int
-> Anchor
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
parseSequence Location
startLocation Maybe Location
mEndLocation !Int
n Anchor
a [Marked Value] -> [Marked Value]
front =
  ConduitT (Marked Event) o Parse (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
peekC ConduitT (Marked Event) o Parse (Maybe (Marked Event))
-> (Maybe (Marked Event)
    -> ConduitT (Marked Event) o Parse (Marked Value))
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b.
ConduitT (Marked Event) o Parse a
-> (a -> ConduitT (Marked Event) o Parse b)
-> ConduitT (Marked Event) o Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Marked Event
me | Event
EventSequenceEnd <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> do
      Int -> ConduitT (Marked Event) o Parse ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
dropC Int
1
      JSONPath
path <- (JSONPath -> JSONPath) -> ConduitT (Marked Event) o Parse JSONPath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JSONPath -> JSONPath
forall a. [a] -> [a]
reverse
      let res :: Marked Value
res =
            Marked
              { markedItem :: Value
markedItem = MarkedArray -> Value
Array (MarkedArray -> Value) -> MarkedArray -> Value
forall a b. (a -> b) -> a -> b
$ [Marked Value] -> MarkedArray
forall a. [a] -> Vector a
V.fromList ([Marked Value] -> MarkedArray) -> [Marked Value] -> MarkedArray
forall a b. (a -> b) -> a -> b
$ [Marked Value] -> [Marked Value]
front []
              , markedPath :: String
markedPath = Marked Event -> String
forall a. Marked a -> String
markedPath Marked Event
me
              , markedJSONPath :: Maybe JSONPath
markedJSONPath = JSONPath -> Maybe JSONPath
forall a. a -> Maybe a
Just JSONPath
path
              , markedLocationStart :: Location
markedLocationStart = Location
startLocation
              , markedLocationEnd :: Location
markedLocationEnd = Location -> Maybe Location -> Location
forall a. a -> Maybe a -> a
fromMaybe Location
startLocation Maybe Location
mEndLocation
              }
      Marked Value
res Marked Value
-> ConduitT (Marked Event) o Parse ()
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b.
a
-> ConduitT (Marked Event) o Parse b
-> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ConduitT (Marked Event) o Parse ())
-> Anchor -> ConduitT (Marked Event) o Parse ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Marked Value -> ConduitT (Marked Event) o Parse ()
forall (m :: * -> *).
MonadState (Map String (Marked Value)) m =>
String -> Marked Value -> m ()
`defineAnchor` Marked Value
res) Anchor
a
    Maybe (Marked Event)
_ -> do
      Marked Value
o <- (JSONPath -> JSONPath)
-> ConduitT (Marked Event) o Parse (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a.
(JSONPath -> JSONPath)
-> ConduitT (Marked Event) o Parse a
-> ConduitT (Marked Event) o Parse a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Int -> JSONPathElement
Index Int
n JSONPathElement -> JSONPath -> JSONPath
forall a. a -> [a] -> [a]
:) ConduitT (Marked Event) o Parse (Marked Value)
forall o. ConduitT (Marked Event) o Parse (Marked Value)
parseDocument
      Location
-> Maybe Location
-> Int
-> Anchor
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
forall o.
Location
-> Maybe Location
-> Int
-> Anchor
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
parseSequence Location
startLocation (Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location) -> Location -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Marked Value -> Location
forall a. Marked a -> Location
markedLocationEnd Marked Value
o) (Int -> Int
forall a. Enum a => a -> a
succ Int
n) Anchor
a (([Marked Value] -> [Marked Value])
 -> ConduitT (Marked Event) o Parse (Marked Value))
-> ([Marked Value] -> [Marked Value])
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b. (a -> b) -> a -> b
$
        [Marked Value] -> [Marked Value]
front ([Marked Value] -> [Marked Value])
-> ([Marked Value] -> [Marked Value])
-> [Marked Value]
-> [Marked Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Marked Value
o

parseMapping
  :: Location
  -- ^ Location where the mapping started
  -> Maybe Location
  -- ^ Ending location of last item within the map
  -> Set Key
  -> Anchor
  -> KeyMap (Marked Value)
  -> ConduitT (Marked Event) o Parse (Marked Value)
parseMapping :: forall o.
Location
-> Maybe Location
-> Set Key
-> Anchor
-> KeyMap (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
parseMapping Location
startLocation Maybe Location
mEndLocation Set Key
mergedKeys Anchor
a KeyMap (Marked Value)
front =
  ConduitT (Marked Event) o Parse (Maybe (Marked Event))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC ConduitT (Marked Event) o Parse (Maybe (Marked Event))
-> (Maybe (Marked Event)
    -> ConduitT (Marked Event) o Parse (Marked Value))
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b.
ConduitT (Marked Event) o Parse a
-> (a -> ConduitT (Marked Event) o Parse b)
-> ConduitT (Marked Event) o Parse b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Marked Event
me | Event
EventMappingEnd <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me -> do
      JSONPath
path <- (JSONPath -> JSONPath) -> ConduitT (Marked Event) o Parse JSONPath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JSONPath -> JSONPath
forall a. [a] -> [a]
reverse
      let res :: Marked Value
res =
            Marked
              { markedItem :: Value
markedItem = KeyMap (Marked Value) -> Value
Object KeyMap (Marked Value)
front
              , markedPath :: String
markedPath = Marked Event -> String
forall a. Marked a -> String
markedPath Marked Event
me
              , markedJSONPath :: Maybe JSONPath
markedJSONPath = JSONPath -> Maybe JSONPath
forall a. a -> Maybe a
Just JSONPath
path
              , markedLocationStart :: Location
markedLocationStart = Location
startLocation
              , markedLocationEnd :: Location
markedLocationEnd = Location -> Maybe Location -> Location
forall a. a -> Maybe a -> a
fromMaybe Location
startLocation Maybe Location
mEndLocation
              }
      Marked Value
res Marked Value
-> ConduitT (Marked Event) o Parse ()
-> ConduitT (Marked Event) o Parse (Marked Value)
forall a b.
a
-> ConduitT (Marked Event) o Parse b
-> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (String -> ConduitT (Marked Event) o Parse ())
-> Anchor -> ConduitT (Marked Event) o Parse ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Marked Value -> ConduitT (Marked Event) o Parse ()
forall (m :: * -> *).
MonadState (Map String (Marked Value)) m =>
String -> Marked Value -> m ()
`defineAnchor` Marked Value
res) Anchor
a
    Maybe (Marked Event)
me -> do
      Key
s <- case Maybe (Marked Event)
me of
        Just Marked Event
me'
          | EventScalar ByteString
v Tag
tag Style
style Anchor
a' <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me' ->
              Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Key
forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Key
parseScalarKey Marked Event
me' ByteString
v Tag
tag Style
style Anchor
a'
        Just Marked Event
me'
          | EventAlias String
an <- Marked Event -> Event
forall a. Marked a -> a
markedItem Marked Event
me' ->
              String -> ConduitT (Marked Event) o Parse Key
forall (m :: * -> *).
(MonadIO m, MonadState (Map String (Marked Value)) m) =>
String -> m Key
lookupAliasKey String
an
        Maybe (Marked Event)
_ -> do
          JSONPath
path <- (JSONPath -> JSONPath) -> ConduitT (Marked Event) o Parse JSONPath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JSONPath -> JSONPath
forall a. [a] -> [a]
reverse
          ParseException -> ConduitT (Marked Event) o Parse Key
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (ParseException -> ConduitT (Marked Event) o Parse Key)
-> ParseException -> ConduitT (Marked Event) o Parse Key
forall a b. (a -> b) -> a -> b
$ JSONPath -> ParseException
NonStringKey JSONPath
path

      ((Set Key
mergedKeys', KeyMap (Marked Value)
al'), Location
endLocation) <- (JSONPath -> JSONPath)
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
forall a.
(JSONPath -> JSONPath)
-> ConduitT (Marked Event) o Parse a
-> ConduitT (Marked Event) o Parse a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (Key -> JSONPathElement
Key Key
s JSONPathElement -> JSONPath -> JSONPath
forall a. a -> [a] -> [a]
:) (ConduitT
   (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
 -> ConduitT
      (Marked Event)
      o
      Parse
      ((Set Key, KeyMap (Marked Value)), Location))
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
forall a b. (a -> b) -> a -> b
$ do
        Marked Value
o <- ConduitT (Marked Event) o Parse (Marked Value)
forall o. ConduitT (Marked Event) o Parse (Marked Value)
parseDocument

        ((Set Key, KeyMap (Marked Value))
 -> ((Set Key, KeyMap (Marked Value)), Location))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
forall a b.
(a -> b)
-> ConduitT (Marked Event) o Parse a
-> ConduitT (Marked Event) o Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Marked Value -> Location
forall a. Marked a -> Location
markedLocationEnd Marked Value
o) (ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
 -> ConduitT
      (Marked Event)
      o
      Parse
      ((Set Key, KeyMap (Marked Value)), Location))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
-> ConduitT
     (Marked Event) o Parse ((Set Key, KeyMap (Marked Value)), Location)
forall a b. (a -> b) -> a -> b
$ do
          let al :: ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
al = do
                Bool
-> ConduitT (Marked Event) o Parse ()
-> ConduitT (Marked Event) o Parse ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Key -> KeyMap (Marked Value) -> Bool
forall a. Key -> KeyMap a -> Bool
KeyMap.member Key
s KeyMap (Marked Value)
front Bool -> Bool -> Bool
&& Key -> Set Key -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember Key
s Set Key
mergedKeys) (ConduitT (Marked Event) o Parse ()
 -> ConduitT (Marked Event) o Parse ())
-> ConduitT (Marked Event) o Parse ()
-> ConduitT (Marked Event) o Parse ()
forall a b. (a -> b) -> a -> b
$ do
                  JSONPath
path <- (JSONPath -> JSONPath) -> ConduitT (Marked Event) o Parse JSONPath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JSONPath -> JSONPath
forall a. [a] -> [a]
reverse
                  DList Warning -> ConduitT (Marked Event) o Parse ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (DList Warning -> ConduitT (Marked Event) o Parse ())
-> DList Warning -> ConduitT (Marked Event) o Parse ()
forall a b. (a -> b) -> a -> b
$ Warning -> DList Warning
forall a. a -> DList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Warning -> DList Warning) -> Warning -> DList Warning
forall a b. (a -> b) -> a -> b
$ JSONPath -> Warning
DuplicateKey JSONPath
path
                (Set Key, KeyMap (Marked Value))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
                  ( Key -> Set Key -> Set Key
forall a. Ord a => a -> Set a -> Set a
Set.delete Key
s Set Key
mergedKeys
                  , Key
-> Marked Value -> KeyMap (Marked Value) -> KeyMap (Marked Value)
forall v. Key -> v -> KeyMap v -> KeyMap v
KeyMap.insert Key
s Marked Value
o KeyMap (Marked Value)
front
                  )

          if Key
s Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
"<<"
            then case Marked Value -> Value
forall a. Marked a -> a
markedItem Marked Value
o of
              Object KeyMap (Marked Value)
l -> (Set Key, KeyMap (Marked Value))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Set Key, KeyMap (Marked Value))
 -> ConduitT
      (Marked Event) o Parse (Set Key, KeyMap (Marked Value)))
-> (Set Key, KeyMap (Marked Value))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
forall a b. (a -> b) -> a -> b
$ KeyMap (Marked Value) -> (Set Key, KeyMap (Marked Value))
merge KeyMap (Marked Value)
l
              Array MarkedArray
l ->
                (Set Key, KeyMap (Marked Value))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Set Key, KeyMap (Marked Value))
 -> ConduitT
      (Marked Event) o Parse (Set Key, KeyMap (Marked Value)))
-> (Set Key, KeyMap (Marked Value))
-> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
forall a b. (a -> b) -> a -> b
$
                  KeyMap (Marked Value) -> (Set Key, KeyMap (Marked Value))
merge (KeyMap (Marked Value) -> (Set Key, KeyMap (Marked Value)))
-> KeyMap (Marked Value) -> (Set Key, KeyMap (Marked Value))
forall a b. (a -> b) -> a -> b
$
                    (KeyMap (Marked Value) -> Marked Value -> KeyMap (Marked Value))
-> KeyMap (Marked Value) -> [Marked Value] -> KeyMap (Marked Value)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' KeyMap (Marked Value) -> Marked Value -> KeyMap (Marked Value)
mergeMarkedObject KeyMap (Marked Value)
forall a. Monoid a => a
mempty ([Marked Value] -> KeyMap (Marked Value))
-> [Marked Value] -> KeyMap (Marked Value)
forall a b. (a -> b) -> a -> b
$
                      MarkedArray -> [Marked Value]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MarkedArray
l
              Value
_ -> ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
al
            else ConduitT (Marked Event) o Parse (Set Key, KeyMap (Marked Value))
al

      Location
-> Maybe Location
-> Set Key
-> Anchor
-> KeyMap (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
forall o.
Location
-> Maybe Location
-> Set Key
-> Anchor
-> KeyMap (Marked Value)
-> ConduitT (Marked Event) o Parse (Marked Value)
parseMapping Location
startLocation (Location -> Maybe Location
forall a. a -> Maybe a
Just Location
endLocation) Set Key
mergedKeys' Anchor
a KeyMap (Marked Value)
al'
 where
  merge :: KeyMap (Marked Value) -> (Set Key, KeyMap (Marked Value))
merge KeyMap (Marked Value)
xs =
    ( [Key] -> Set Key
forall a. Ord a => [a] -> Set a
Set.fromList (KeyMap (Marked Value) -> [Key]
forall v. KeyMap v -> [Key]
KeyMap.keys KeyMap (Marked Value)
xs [Key] -> [Key] -> [Key]
forall a. Eq a => [a] -> [a] -> [a]
\\ KeyMap (Marked Value) -> [Key]
forall v. KeyMap v -> [Key]
KeyMap.keys KeyMap (Marked Value)
front)
    , KeyMap (Marked Value)
-> KeyMap (Marked Value) -> KeyMap (Marked Value)
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union KeyMap (Marked Value)
front KeyMap (Marked Value)
xs
    )

mergeMarkedObject
  :: KeyMap (Marked Value) -> Marked Value -> KeyMap (Marked Value)
mergeMarkedObject :: KeyMap (Marked Value) -> Marked Value -> KeyMap (Marked Value)
mergeMarkedObject KeyMap (Marked Value)
al Marked Value
v | Object KeyMap (Marked Value)
om <- Marked Value -> Value
forall a. Marked a -> a
markedItem Marked Value
v = KeyMap (Marked Value)
-> KeyMap (Marked Value) -> KeyMap (Marked Value)
forall v. KeyMap v -> KeyMap v -> KeyMap v
KeyMap.union KeyMap (Marked Value)
al KeyMap (Marked Value)
om
mergeMarkedObject KeyMap (Marked Value)
al Marked Value
_ = KeyMap (Marked Value)
al

parseScalar
  :: Marked Event
  -> ByteString
  -> Tag
  -> Style
  -> Anchor
  -> ConduitT (Marked Event) o Parse (Marked Value)
parseScalar :: forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse (Marked Value)
parseScalar Marked Event
me ByteString
v Tag
tag Style
style Anchor
a = do
  Text
s <- Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Text
forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Text
parseScalarText Marked Event
me ByteString
v Tag
tag Style
style Anchor
a
  let mv :: Marked Value
mv = Style -> Tag -> Text -> Value
textToValue Style
style Tag
tag Text
s Value -> Marked Event -> Marked Value
forall a b. a -> Marked b -> Marked a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Marked Event
me
  JSONPath
path <- Parse JSONPath -> ConduitT (Marked Event) o Parse JSONPath
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (Marked Event) o m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parse JSONPath -> ConduitT (Marked Event) o Parse JSONPath)
-> Parse JSONPath -> ConduitT (Marked Event) o Parse JSONPath
forall a b. (a -> b) -> a -> b
$ (JSONPath -> JSONPath) -> Parse JSONPath
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks JSONPath -> JSONPath
forall a. [a] -> [a]
reverse
  Marked Value -> ConduitT (Marked Event) o Parse (Marked Value)
forall a. a -> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Marked Value -> ConduitT (Marked Event) o Parse (Marked Value))
-> Marked Value -> ConduitT (Marked Event) o Parse (Marked Value)
forall a b. (a -> b) -> a -> b
$ Marked Value
mv {markedJSONPath = Just path}

parseScalarKey
  :: Marked Event
  -> ByteString
  -> Tag
  -> Style
  -> Anchor
  -> ConduitT (Marked Event) o Parse Key
parseScalarKey :: forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Key
parseScalarKey Marked Event
me ByteString
v Tag
tag Style
style =
  (Text -> Key)
-> ConduitT (Marked Event) o Parse Text
-> ConduitT (Marked Event) o Parse Key
forall a b.
(a -> b)
-> ConduitT (Marked Event) o Parse a
-> ConduitT (Marked Event) o Parse b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
Key.fromText (ConduitT (Marked Event) o Parse Text
 -> ConduitT (Marked Event) o Parse Key)
-> (Anchor -> ConduitT (Marked Event) o Parse Text)
-> Anchor
-> ConduitT (Marked Event) o Parse Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Text
forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Text
parseScalarText Marked Event
me ByteString
v Tag
tag Style
style

parseScalarText
  :: Marked Event
  -> ByteString
  -> Tag
  -> Style
  -> Anchor
  -> ConduitT (Marked Event) o Parse Text
parseScalarText :: forall o.
Marked Event
-> ByteString
-> Tag
-> Style
-> Anchor
-> ConduitT (Marked Event) o Parse Text
parseScalarText Marked Event
me ByteString
v Tag
tag Style
style = (Text
res Text
-> ConduitT (Marked Event) o Parse ()
-> ConduitT (Marked Event) o Parse Text
forall a b.
a
-> ConduitT (Marked Event) o Parse b
-> ConduitT (Marked Event) o Parse a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ConduitT (Marked Event) o Parse ()
 -> ConduitT (Marked Event) o Parse Text)
-> (Anchor -> ConduitT (Marked Event) o Parse ())
-> Anchor
-> ConduitT (Marked Event) o Parse Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ConduitT (Marked Event) o Parse ())
-> Anchor -> ConduitT (Marked Event) o Parse ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> Marked Value -> ConduitT (Marked Event) o Parse ()
forall (m :: * -> *).
MonadState (Map String (Marked Value)) m =>
String -> Marked Value -> m ()
`defineAnchor` Marked Value
anc)
 where
  res :: Text
res = OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode ByteString
v
  anc :: Marked Value
anc = Style -> Tag -> Text -> Value
textToValue Style
style Tag
tag Text
res Value -> Marked Event -> Marked Value
forall a b. a -> Marked b -> Marked a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Marked Event
me

textToValue :: Style -> Tag -> Text -> Value
textToValue :: Style -> Tag -> Text -> Value
textToValue Style
SingleQuoted Tag
_ Text
t = Text -> Value
String Text
t
textToValue Style
DoubleQuoted Tag
_ Text
t = Text -> Value
String Text
t
textToValue Style
_ Tag
StrTag Text
t = Text -> Value
String Text
t
textToValue Style
Folded Tag
_ Text
t = Text -> Value
String Text
t
textToValue Style
_ Tag
_ Text
t
  | Text
t Text -> Text -> Bool
`isLike` Text
"null" = Value
Null
  | Text
t Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"~", Text
""] = Value
Null
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
t Text -> Text -> Bool
`isLike`) [Text
"y", Text
"yes", Text
"on", Text
"true"] = Bool -> Value
Bool Bool
True
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text
t Text -> Text -> Bool
`isLike`) [Text
"n", Text
"no", Text
"off", Text
"false"] = Bool -> Value
Bool Bool
False
  | Right Scientific
x <- Text -> Either String Scientific
textToScientific Text
t = Scientific -> Value
Number Scientific
x
  | Bool
otherwise = Text -> Value
String Text
t
 where
  Text
x isLike :: Text -> Text -> Bool
`isLike` Text
ref = Text
x Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
ref, Text -> Text
T.toUpper Text
ref, Text -> Text
T.toTitle Text
ref]

textToScientific :: Text -> Either String Scientific
textToScientific :: Text -> Either String Scientific
textToScientific = Parser Scientific -> Text -> Either String Scientific
forall a. Parser a -> Text -> Either String a
Atto.parseOnly (Parser Scientific
num Parser Scientific -> Parser Text () -> Parser Scientific
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
Atto.endOfInput)
 where
  num :: Parser Scientific
num =
    (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Parser Text Integer -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"0x" Parser Text Text -> Parser Text Integer -> Parser Text Integer
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Integer
forall a. (Integral a, Bits a) => Parser a
Atto.hexadecimal))
      Parser Scientific -> Parser Scientific -> Parser Scientific
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Integer -> Scientific
forall a. Num a => Integer -> a
fromInteger (Integer -> Scientific) -> Parser Text Integer -> Parser Scientific
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
"0o" Parser Text Text -> Parser Text Integer -> Parser Text Integer
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Integer
forall {b}. (Bits b, Num b) => Parser Text b
octal))
      Parser Scientific -> Parser Scientific -> Parser Scientific
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Scientific
Atto.scientific

  octal :: Parser Text b
octal = (b -> Char -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' b -> Char -> b
forall {a}. (Bits a, Num a) => a -> Char -> a
step b
0 (Text -> b) -> Parser Text Text -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
Atto.takeWhile1 Char -> Bool
isOctDigit
   where
    step :: a -> Char -> a
step a
a Char
c = (a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
3) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
48)

firstM :: (Bitraversable t, Applicative f) => (a -> f a') -> t a b -> f (t a' b)
firstM :: forall (t :: * -> * -> *) (f :: * -> *) a a' b.
(Bitraversable t, Applicative f) =>
(a -> f a') -> t a b -> f (t a' b)
firstM a -> f a'
f = (a -> f a') -> (b -> f b) -> t a b -> f (t a' b)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bimapM a -> f a'
f b -> f b
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

debugEventStream_ :: ByteString -> IO ()
debugEventStream_ :: ByteString -> IO ()
debugEventStream_ = IO [MarkedEvent] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [MarkedEvent] -> IO ())
-> (ByteString -> IO [MarkedEvent]) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO [MarkedEvent]
debugEventStream

debugEventStream :: ByteString -> IO [MarkedEvent]
debugEventStream :: ByteString -> IO [MarkedEvent]
debugEventStream ByteString
bs =
  ResourceT IO [MarkedEvent] -> IO [MarkedEvent]
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO [MarkedEvent] -> IO [MarkedEvent])
-> ResourceT IO [MarkedEvent] -> IO [MarkedEvent]
forall a b. (a -> b) -> a -> b
$
    ConduitT () Void (ResourceT IO) [MarkedEvent]
-> ResourceT IO [MarkedEvent]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (ResourceT IO) [MarkedEvent]
 -> ResourceT IO [MarkedEvent])
-> ConduitT () Void (ResourceT IO) [MarkedEvent]
-> ResourceT IO [MarkedEvent]
forall a b. (a -> b) -> a -> b
$
      ByteString -> ConduitM () MarkedEvent (ResourceT IO) ()
forall (m :: * -> *) i.
MonadResource m =>
ByteString -> ConduitM i MarkedEvent m ()
Y.decodeMarked ByteString
bs
        ConduitM () MarkedEvent (ResourceT IO) ()
-> ConduitT MarkedEvent Void (ResourceT IO) [MarkedEvent]
-> ConduitT () Void (ResourceT IO) [MarkedEvent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| (MarkedEvent -> ResourceT IO ())
-> ConduitT MarkedEvent MarkedEvent (ResourceT IO) ()
forall (m :: * -> *) a. Monad m => (a -> m ()) -> ConduitT a a m ()
iterMC (IO () -> ResourceT IO ()
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ())
-> (MarkedEvent -> IO ()) -> MarkedEvent -> ResourceT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarkedEvent -> IO ()
printEvent)
        ConduitT MarkedEvent MarkedEvent (ResourceT IO) ()
-> ConduitT MarkedEvent Void (ResourceT IO) [MarkedEvent]
-> ConduitT MarkedEvent Void (ResourceT IO) [MarkedEvent]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT MarkedEvent Void (ResourceT IO) [MarkedEvent]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
 where
  showMark :: YamlMark -> String
showMark YamlMark {Int
yamlIndex :: Int
yamlLine :: Int
yamlColumn :: Int
yamlIndex :: YamlMark -> Int
yamlLine :: YamlMark -> Int
yamlColumn :: YamlMark -> Int
..} = (Int, Int, Int) -> String
forall a. Show a => a -> String
show (Int
yamlIndex, Int
yamlLine, Int
yamlColumn)

  printEvent :: MarkedEvent -> IO ()
printEvent MarkedEvent {YamlMark
Event
yamlEvent :: Event
yamlStartMark :: YamlMark
yamlEndMark :: YamlMark
yamlEvent :: MarkedEvent -> Event
yamlStartMark :: MarkedEvent -> YamlMark
yamlEndMark :: MarkedEvent -> YamlMark
..} = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Event: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Event -> String
forall a. Show a => a -> String
show Event
yamlEvent
        , String
", location: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> YamlMark -> String
showMark YamlMark
yamlStartMark
        , String
"-" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> YamlMark -> String
showMark YamlMark
yamlEndMark
        ]