module Telescope.Asdf.Encoding.Stream where

import Conduit
import Data.ByteString (ByteString)
import Data.Conduit.Combinators (peek)
import Data.Conduit.Combinators qualified as C
import Data.List ((!?))
import Data.String (fromString)
import Data.Text (pack, unpack)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8)
import Data.Text.Encoding qualified as T
import Effectful
import Effectful.Error.Static
import Effectful.NonDet
import Effectful.Reader.Dynamic
import Effectful.Resource
import Effectful.State.Static.Local
import Telescope.Asdf.Class hiding (anchor)
import Telescope.Asdf.Encoding.File
import Telescope.Asdf.NDArray (NDArrayData (..))
import Telescope.Asdf.Node
import Telescope.Data.Axes
import Telescope.Data.Parser (runPureParser)
import Text.Libyaml (Event (..), MappingStyle (..), SequenceStyle (..), Style (..), Tag (..))
import Text.Libyaml qualified as Yaml
import Text.Read (readMaybe)


runStream :: (IOE :> es) => ConduitT () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a -> Eff es (a, [BlockData])
runStream :: forall (es :: [Effect]) a.
(IOE :> es) =>
ConduitT
  () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff es (a, [BlockData])
runStream ConduitT
  () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
con = do
  Eff (Resource : es) (a, [BlockData]) -> Eff es (a, [BlockData])
forall (es :: [Effect]) a.
(IOE :> es) =>
Eff (Resource : es) a -> Eff es a
runResource (Eff (Resource : es) (a, [BlockData]) -> Eff es (a, [BlockData]))
-> (ConduitT
      () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
    -> Eff (Resource : es) (a, [BlockData]))
-> ConduitT
     () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff es (a, [BlockData])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState @[BlockData] [] (Eff (State [BlockData] : Resource : es) a
 -> Eff (Resource : es) (a, [BlockData]))
-> (ConduitT
      () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
    -> Eff (State [BlockData] : Resource : es) a)
-> ConduitT
     () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff (Resource : es) (a, [BlockData])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: [Effect]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es a
evalState @Anchors Anchors
forall a. Monoid a => a
mempty (Eff (State Anchors : State [BlockData] : Resource : es) a
 -> Eff (State [BlockData] : Resource : es) a)
-> (ConduitT
      () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
    -> Eff (State Anchors : State [BlockData] : Resource : es) a)
-> ConduitT
     () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff (State [BlockData] : Resource : es) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT
  () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff (State Anchors : State [BlockData] : Resource : es) a
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT
   () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
 -> Eff es (a, [BlockData]))
-> ConduitT
     () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff es (a, [BlockData])
forall a b. (a -> b) -> a -> b
$ ConduitT
  () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
con


runStreamList :: (IOE :> es) => ConduitT () Event (Eff (State Anchors : State [BlockData] : Resource : es)) () -> Eff es [Event]
runStreamList :: forall (es :: [Effect]).
(IOE :> es) =>
ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
-> Eff es [Event]
runStreamList ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
con = do
  ([Event]
res, [BlockData]
_) <- ConduitT
  ()
  Void
  (Eff (State Anchors : State [BlockData] : Resource : es))
  [Event]
-> Eff es ([Event], [BlockData])
forall (es :: [Effect]) a.
(IOE :> es) =>
ConduitT
  () Void (Eff (State Anchors : State [BlockData] : Resource : es)) a
-> Eff es (a, [BlockData])
runStream (ConduitT
   ()
   Void
   (Eff (State Anchors : State [BlockData] : Resource : es))
   [Event]
 -> Eff es ([Event], [BlockData]))
-> ConduitT
     ()
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     [Event]
-> Eff es ([Event], [BlockData])
forall a b. (a -> b) -> a -> b
$ ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
con ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
-> ConduitT
     Event
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     [Event]
-> ConduitT
     ()
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     [Event]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  Event
  Void
  (Eff (State Anchors : State [BlockData] : Resource : es))
  [Event]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
  [Event] -> Eff es [Event]
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Event]
res


yieldDocumentStream :: (State [BlockData] :> es, IOE :> es) => ConduitT a Event (Eff es) () -> ConduitT a Event (Eff es) ()
yieldDocumentStream :: forall (es :: [Effect]) a.
(State [BlockData] :> es, IOE :> es) =>
ConduitT a Event (Eff es) () -> ConduitT a Event (Eff es) ()
yieldDocumentStream ConduitT a Event (Eff es) ()
content = do
  Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventStreamStart
  Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventDocumentStart
  ConduitT a Event (Eff es) ()
content
  Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventDocumentEnd
  Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventStreamEnd


yieldNode :: forall es a. (IOE :> es, State [BlockData] :> es, State Anchors :> es, Error YamlError :> es) => Node -> ConduitT a Event (Eff es) ()
yieldNode :: forall (es :: [Effect]) a.
(IOE :> es, State [BlockData] :> es, State Anchors :> es,
 Error YamlError :> es) =>
Node -> ConduitT a Event (Eff es) ()
yieldNode node :: Node
node@(Node SchemaTag
st Maybe Anchor
anc Value
val) = do
  Eff es () -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) a. Monad m => m a -> ConduitT a Event m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es () -> ConduitT a Event (Eff es) ())
-> Eff es () -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ Node -> Eff es ()
forall (es :: [Effect]). (State Anchors :> es) => Node -> Eff es ()
addNodeAnchor Node
node
  Value -> ConduitT a Event (Eff es) ()
yieldValue Value
val
 where
  yieldValue :: Value -> ConduitT a Event (Eff es) ()
yieldValue = \case
    Object Object
o -> Object -> ConduitT a Event (Eff es) ()
yieldObject Object
o
    Array [Node]
a -> [Node] -> ConduitT a Event (Eff es) ()
yieldArray [Node]
a
    String Key
"" -> ConduitT a Event (Eff es) ()
yieldEmptyString
    String Key
s -> ByteString -> ConduitT a Event (Eff es) ()
yieldScalar (Key -> ByteString
T.encodeUtf8 Key
s)
    Integer Integer
n -> Integer -> ConduitT a Event (Eff es) ()
forall n. (Num n, Show n) => n -> ConduitT a Event (Eff es) ()
yieldNum Integer
n
    NDArray NDArrayData
nd -> NDArrayData -> ConduitT a Event (Eff es) ()
yieldNDArray NDArrayData
nd
    Bool Bool
b -> Bool -> ConduitT a Event (Eff es) ()
yieldBool Bool
b
    Number Scientific
n -> Scientific -> ConduitT a Event (Eff es) ()
forall n. (Num n, Show n) => n -> ConduitT a Event (Eff es) ()
yieldNum Scientific
n
    Value
Null -> ByteString -> ConduitT a Event (Eff es) ()
yieldScalar ByteString
"~"
    Reference JSONReference
r -> Object -> ConduitT a Event (Eff es) ()
yieldObject [(Key
"$ref", Value -> Node
forall a. ToAsdf a => a -> Node
toNode (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ Key -> Value
String (String -> Key
pack (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ JSONReference -> String
forall a. Show a => a -> String
show JSONReference
r))]
    Alias Anchor
a -> Anchor -> ConduitT a Event (Eff es) ()
forall {es :: [Effect]} {i}.
(State Anchors :> es, Error YamlError :> es) =>
Anchor -> ConduitT i Event (Eff es) ()
yieldAlias Anchor
a

  anchor :: Yaml.Anchor
  anchor :: Anchor
anchor =
    case Maybe Anchor
anc of
      Maybe Anchor
Nothing -> Anchor
forall a. Maybe a
Nothing
      (Just (Anchor Key
a)) -> String -> Anchor
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> String
unpack Key
a)

  tag :: Tag
tag = case SchemaTag
st of
    SchemaTag Maybe Key
Nothing -> Tag
NoTag
    SchemaTag (Just Key
s) -> String -> Tag
UriTag (Key -> String
unpack Key
s)

  yieldScalar :: ByteString -> ConduitT a Event (Eff es) ()
yieldScalar ByteString
s = Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
s Tag
tag Style
Plain Anchor
anchor
  yieldEmptyString :: ConduitT a Event (Eff es) ()
yieldEmptyString = Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> Event
EventScalar ByteString
"" Tag
tag Style
SingleQuoted Anchor
anchor

  yieldAlias :: Anchor -> ConduitT i Event (Eff es) ()
yieldAlias (Anchor Key
a) = do
    Value
_ <- Eff es Value -> ConduitT i Event (Eff es) Value
forall (m :: * -> *) a. Monad m => m a -> ConduitT i Event m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Value -> ConduitT i Event (Eff es) Value)
-> Eff es Value -> ConduitT i Event (Eff es) Value
forall a b. (a -> b) -> a -> b
$ Anchor -> Eff es Value
forall (es :: [Effect]).
(State Anchors :> es, Error YamlError :> es) =>
Anchor -> Eff es Value
resolveAnchor (Key -> Anchor
Anchor Key
a)
    Event -> ConduitT i Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT i Event (Eff es) ())
-> Event -> ConduitT i Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ String -> Event
EventAlias (Key -> String
unpack Key
a)

  yieldNum :: (Num n, Show n) => n -> ConduitT a Event (Eff es) ()
  yieldNum :: forall n. (Num n, Show n) => n -> ConduitT a Event (Eff es) ()
yieldNum n
n = ByteString -> ConduitT a Event (Eff es) ()
yieldScalar (Key -> ByteString
T.encodeUtf8 (Key -> ByteString) -> Key -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> Key
pack (String -> Key) -> String -> Key
forall a b. (a -> b) -> a -> b
$ n -> String
forall a. Show a => a -> String
show n
n)

  yieldBool :: Bool -> ConduitT a Event (Eff es) ()
yieldBool = \case
    Bool
True -> ByteString -> ConduitT a Event (Eff es) ()
yieldScalar ByteString
"true"
    Bool
False -> ByteString -> ConduitT a Event (Eff es) ()
yieldScalar ByteString
"false"

  yieldObject :: [(Key, Node)] -> ConduitT a Event (Eff es) ()
  yieldObject :: Object -> ConduitT a Event (Eff es) ()
yieldObject Object
o = do
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ Tag -> MappingStyle -> Anchor -> Event
EventMappingStart Tag
tag MappingStyle
blockStyle Anchor
anchor
    ((Key, Node) -> ConduitT a Event (Eff es) ())
-> Object -> ConduitT a Event (Eff es) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping Object
o
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventMappingEnd
   where
    blockStyle :: MappingStyle
blockStyle
      | ((Key, Node) -> Bool) -> Object -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Node -> Bool
isComplexNode (Node -> Bool) -> ((Key, Node) -> Node) -> (Key, Node) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key, Node) -> Node
forall a b. (a, b) -> b
snd) Object
o = MappingStyle
BlockMapping
      | Bool
otherwise = MappingStyle
FlowMapping

  yieldMapping :: (Key, Node) -> ConduitT a Event (Eff es) ()
  yieldMapping :: (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping (Key
key, Node
nd) = do
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Tag -> Style -> Anchor -> Event
EventScalar (Key -> ByteString
T.encodeUtf8 Key
key) Tag
NoTag Style
Plain Anchor
forall a. Maybe a
Nothing
    Node -> ConduitT a Event (Eff es) ()
forall (es :: [Effect]) a.
(IOE :> es, State [BlockData] :> es, State Anchors :> es,
 Error YamlError :> es) =>
Node -> ConduitT a Event (Eff es) ()
yieldNode Node
nd

  yieldArray :: [Node] -> ConduitT a Event (Eff es) ()
  yieldArray :: [Node] -> ConduitT a Event (Eff es) ()
yieldArray [Node]
ns = do
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ Tag -> SequenceStyle -> Anchor -> Event
EventSequenceStart Tag
tag SequenceStyle
seqStyle Anchor
anchor
    (Node -> ConduitT a Event (Eff es) ())
-> [Node] -> ConduitT a Event (Eff es) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Node -> ConduitT a Event (Eff es) ()
forall (es :: [Effect]) a.
(IOE :> es, State [BlockData] :> es, State Anchors :> es,
 Error YamlError :> es) =>
Node -> ConduitT a Event (Eff es) ()
yieldNode [Node]
ns
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventSequenceEnd
   where
    seqStyle :: SequenceStyle
seqStyle
      | (Node -> Bool) -> [Node] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Node -> Bool
isComplexNode [Node]
ns = SequenceStyle
BlockSequence
      | Bool
otherwise = SequenceStyle
FlowSequence

  yieldNDArray :: NDArrayData -> ConduitT a Event (Eff es) ()
  yieldNDArray :: NDArrayData -> ConduitT a Event (Eff es) ()
yieldNDArray NDArrayData
nd = do
    BlockSource
src <- Eff es BlockSource -> ConduitT a Event (Eff es) BlockSource
forall (m :: * -> *) a. Monad m => m a -> ConduitT a Event m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es BlockSource -> ConduitT a Event (Eff es) BlockSource)
-> Eff es BlockSource -> ConduitT a Event (Eff es) BlockSource
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff es BlockSource
forall (es :: [Effect]).
(State [BlockData] :> es) =>
ByteString -> Eff es BlockSource
addBlock NDArrayData
nd.bytes
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield (Event -> ConduitT a Event (Eff es) ())
-> Event -> ConduitT a Event (Eff es) ()
forall a b. (a -> b) -> a -> b
$ Tag -> MappingStyle -> Anchor -> Event
EventMappingStart (String -> Tag
UriTag String
"!core/ndarray-1.0.0") MappingStyle
FlowMapping Anchor
anchor
    (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping (Key
"source", BlockSource -> Node
forall a. ToAsdf a => a -> Node
toNode BlockSource
src)
    (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping (Key
"datatype", DataType -> Node
forall a. ToAsdf a => a -> Node
toNode NDArrayData
nd.datatype)
    (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping (Key
"shape", Axes 'Row -> Node
forall a. ToAsdf a => a -> Node
toNode NDArrayData
nd.shape)
    (Key, Node) -> ConduitT a Event (Eff es) ()
yieldMapping (Key
"byteorder", ByteOrder -> Node
forall a. ToAsdf a => a -> Node
toNode NDArrayData
nd.byteorder)
    Event -> ConduitT a Event (Eff es) ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield Event
EventMappingEnd


addBlock :: (State [BlockData] :> es) => ByteString -> Eff es BlockSource
addBlock :: forall (es :: [Effect]).
(State [BlockData] :> es) =>
ByteString -> Eff es BlockSource
addBlock ByteString
bytes = do
  [BlockData]
blocks <- forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
Eff es s
get @[BlockData]
  [BlockData] -> Eff es ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
s -> Eff es ()
put ([BlockData] -> Eff es ()) -> [BlockData] -> Eff es ()
forall a b. (a -> b) -> a -> b
$ [BlockData]
blocks [BlockData] -> [BlockData] -> [BlockData]
forall a. Semigroup a => a -> a -> a
<> [ByteString -> BlockData
BlockData ByteString
bytes]
  BlockSource -> Eff es BlockSource
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockSource -> Eff es BlockSource)
-> BlockSource -> Eff es BlockSource
forall a b. (a -> b) -> a -> b
$ Int -> BlockSource
BlockSource (Int -> BlockSource) -> Int -> BlockSource
forall a b. (a -> b) -> a -> b
$ [BlockData] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [BlockData]
blocks


isComplexNode :: Node -> Bool
isComplexNode :: Node -> Bool
isComplexNode (Node SchemaTag
_ Maybe Anchor
_ Value
val) = Value -> Bool
isComplex Value
val
 where
  isComplex :: Value -> Bool
isComplex = \case
    Array [Node]
_ -> Bool
True
    Object Object
_ -> Bool
True
    NDArray NDArrayData
_ -> Bool
True
    Value
_ -> Bool
False


sinkTree :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Yaml.Event o (Eff es) Object
sinkTree :: forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Object
sinkTree = do
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventStreamStart
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventDocumentStart
  Node SchemaTag
_ Maybe Anchor
_ Value
v <- ConduitT Event o (Eff es) Node
forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Node
sinkNode
  case Value
v of
    Object Object
o -> Object -> ConduitT Event o (Eff es) Object
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
o
    Value
_ -> Eff es Object -> ConduitT Event o (Eff es) Object
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Object -> ConduitT Event o (Eff es) Object)
-> Eff es Object -> ConduitT Event o (Eff es) Object
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es Object
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Object) -> YamlError -> Eff es Object
forall a b. (a -> b) -> a -> b
$ String -> Value -> YamlError
InvalidTree String
"Expected Object" Value
v


sinkNode :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Yaml.Event o (Eff es) Node
sinkNode :: forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Node
sinkNode = do
  Event
e <- ConduitT Event o (Eff es) Event
forall (es :: [Effect]) i o.
(Error YamlError :> es) =>
ConduitT i o (Eff es) i
event
  Node
node <- Event -> ConduitT Event o (Eff es) Node
forall {o}. Event -> ConduitT Event o (Eff es) Node
sinkByEvent Event
e
  Eff es () -> ConduitT Event o (Eff es) ()
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es () -> ConduitT Event o (Eff es) ())
-> Eff es () -> ConduitT Event o (Eff es) ()
forall a b. (a -> b) -> a -> b
$ Node -> Eff es ()
forall (es :: [Effect]). (State Anchors :> es) => Node -> Eff es ()
addNodeAnchor Node
node
  Node -> ConduitT Event o (Eff es) Node
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node
 where
  sinkByEvent :: Event -> ConduitT Event o (Eff es) Node
sinkByEvent = \case
    EventScalar ByteString
s Tag
t Style
_ Anchor
a ->
      Eff es Node -> ConduitT Event o (Eff es) Node
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Node -> ConduitT Event o (Eff es) Node)
-> Eff es Node -> ConduitT Event o (Eff es) Node
forall a b. (a -> b) -> a -> b
$ Maybe Anchor -> ByteString -> Tag -> Eff es Node
forall (es :: [Effect]).
(Error YamlError :> es) =>
Maybe Anchor -> ByteString -> Tag -> Eff es Node
parseScalar (String -> Anchor
forall a. IsString a => String -> a
fromString (String -> Anchor) -> Anchor -> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Anchor
a) ByteString
s Tag
t
    EventMappingStart Tag
tg MappingStyle
_ Anchor
a -> do
      let stag :: SchemaTag
stag = Tag -> SchemaTag
parseSchemaTag Tag
tg
      Object
maps <- ConduitT Event o (Eff es) Object
forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Object
sinkMappings
      Value
val <- Eff es Value -> ConduitT Event o (Eff es) Value
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Value -> ConduitT Event o (Eff es) Value)
-> Eff es Value -> ConduitT Event o (Eff es) Value
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Object -> Eff es Value
forall (es :: [Effect]).
(Error YamlError :> es, Reader [BlockData] :> es) =>
SchemaTag -> Object -> Eff es Value
fromMappings SchemaTag
stag Object
maps
      Node -> ConduitT Event o (Eff es) Node
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> ConduitT Event o (Eff es) Node)
-> Node -> ConduitT Event o (Eff es) Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
stag (String -> Anchor
forall a. IsString a => String -> a
fromString (String -> Anchor) -> Anchor -> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Anchor
a) Value
val
    EventSequenceStart Tag
tg SequenceStyle
_ Anchor
a -> do
      [Node]
ns <- ConduitT Event o (Eff es) [Node]
forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) [Node]
sinkSequence
      Node -> ConduitT Event o (Eff es) Node
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> ConduitT Event o (Eff es) Node)
-> Node -> ConduitT Event o (Eff es) Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node (Tag -> SchemaTag
parseSchemaTag Tag
tg) (String -> Anchor
forall a. IsString a => String -> a
fromString (String -> Anchor) -> Anchor -> Maybe Anchor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Anchor
a) (Value -> Node) -> Value -> Node
forall a b. (a -> b) -> a -> b
$ [Node] -> Value
Array [Node]
ns
    EventAlias String
a -> do
      Value
val <- Eff es Value -> ConduitT Event o (Eff es) Value
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Value -> ConduitT Event o (Eff es) Value)
-> Eff es Value -> ConduitT Event o (Eff es) Value
forall a b. (a -> b) -> a -> b
$ Anchor -> Eff es Value
forall (es :: [Effect]).
(State Anchors :> es, Error YamlError :> es) =>
Anchor -> Eff es Value
resolveAnchor (Key -> Anchor
Anchor (Key -> Anchor) -> Key -> Anchor
forall a b. (a -> b) -> a -> b
$ String -> Key
pack String
a)
      Node -> ConduitT Event o (Eff es) Node
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> ConduitT Event o (Eff es) Node)
-> Node -> ConduitT Event o (Eff es) Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
forall a. Monoid a => a
mempty Maybe Anchor
forall a. Maybe a
Nothing Value
val
    Event
ev -> Eff es Node -> ConduitT Event o (Eff es) Node
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Node -> ConduitT Event o (Eff es) Node)
-> Eff es Node -> ConduitT Event o (Eff es) Node
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es Node
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Node) -> YamlError -> Eff es Node
forall a b. (a -> b) -> a -> b
$ String -> Event -> YamlError
ExpectedEvent String
"Not Handled" Event
ev

  fromMappings :: forall es. (Error YamlError :> es, Reader [BlockData] :> es) => SchemaTag -> [(Key, Node)] -> Eff es Value
  fromMappings :: forall (es :: [Effect]).
(Error YamlError :> es, Reader [BlockData] :> es) =>
SchemaTag -> Object -> Eff es Value
fromMappings SchemaTag
stag Object
maps = do
    Either CallStack Value
res <- OnEmptyPolicy
-> Eff (NonDet : es) Value -> Eff es (Either CallStack Value)
forall (es :: [Effect]) a.
HasCallStack =>
OnEmptyPolicy -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDet OnEmptyPolicy
OnEmptyKeep (SchemaTag -> Object -> Eff (NonDet : es) Value
forall (es :: [Effect]).
(NonDet :> es, Error YamlError :> es, Reader [BlockData] :> es) =>
SchemaTag -> Object -> Eff es Value
tryNDArray SchemaTag
stag Object
maps Eff (NonDet : es) Value
-> Eff (NonDet : es) Value -> Eff (NonDet : es) Value
forall a.
Eff (NonDet : es) a -> Eff (NonDet : es) a -> Eff (NonDet : es) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object -> Eff (NonDet : es) Value
forall (es :: [Effect]).
(NonDet :> es, Error YamlError :> es) =>
Object -> Eff es Value
tryReference Object
maps) :: Eff es (Either CallStack Value)
    case Either CallStack Value
res of
      Left CallStack
_ -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eff es Value) -> Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
Object Object
maps
      Right Value
val -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
val

  tryNDArray :: (NonDet :> es, Error YamlError :> es, Reader [BlockData] :> es) => SchemaTag -> [(Key, Node)] -> Eff es Value
  tryNDArray :: forall (es :: [Effect]).
(NonDet :> es, Error YamlError :> es, Reader [BlockData] :> es) =>
SchemaTag -> Object -> Eff es Value
tryNDArray SchemaTag
stag Object
maps
    | SchemaTag -> Bool
isNDArray SchemaTag
stag = NDArrayData -> Value
NDArray (NDArrayData -> Value) -> Eff es NDArrayData -> Eff es Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Eff es NDArrayData
forall (es :: [Effect]).
(Error YamlError :> es, Reader [BlockData] :> es) =>
Object -> Eff es NDArrayData
ndArrayDataFromMaps Object
maps
    | Bool
otherwise = Eff es Value
forall a. Eff es a
forall (f :: * -> *) a. Alternative f => f a
empty

  tryReference :: (NonDet :> es, Error YamlError :> es) => [(Key, Node)] -> Eff es Value
  tryReference :: forall (es :: [Effect]).
(NonDet :> es, Error YamlError :> es) =>
Object -> Eff es Value
tryReference Object
maps = do
    case Key -> Object -> Maybe Node
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Key
"$ref" Object
maps of
      Maybe Node
Nothing -> Eff es Value
forall a. Eff es a
forall (f :: * -> *) a. Alternative f => f a
empty
      Just (Node SchemaTag
_ Maybe Anchor
_ (String Key
s)) -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Eff es Value) -> Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ JSONReference -> Value
Reference (JSONReference -> Value) -> JSONReference -> Value
forall a b. (a -> b) -> a -> b
$ Key -> JSONReference
jsonReference Key
s
      Just (Node SchemaTag
_ Maybe Anchor
_ Value
value) -> YamlError -> Eff es Value
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Value) -> YamlError -> Eff es Value
forall a b. (a -> b) -> a -> b
$ Value -> YamlError
InvalidReference Value
value


resolveAnchor :: (State Anchors :> es, Error YamlError :> es) => Anchor -> Eff es Value
resolveAnchor :: forall (es :: [Effect]).
(State Anchors :> es, Error YamlError :> es) =>
Anchor -> Eff es Value
resolveAnchor Anchor
anc = do
  Anchors [(Anchor, Value)]
anchors <- forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
Eff es s
get @Anchors
  case Anchor -> [(Anchor, Value)] -> Maybe Value
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Anchor
anc [(Anchor, Value)]
anchors of
    Maybe Value
Nothing -> YamlError -> Eff es Value
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Value) -> YamlError -> Eff es Value
forall a b. (a -> b) -> a -> b
$ Anchor -> [Anchor] -> YamlError
AnchorUndefined Anchor
anc (((Anchor, Value) -> Anchor) -> [(Anchor, Value)] -> [Anchor]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Anchor, Value) -> Anchor
forall a b. (a, b) -> a
fst [(Anchor, Value)]
anchors)
    Just Value
v -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v


ndArrayDataFromMaps :: forall es. (Error YamlError :> es, Reader [BlockData] :> es) => [(Key, Node)] -> Eff es NDArrayData
ndArrayDataFromMaps :: forall (es :: [Effect]).
(Error YamlError :> es, Reader [BlockData] :> es) =>
Object -> Eff es NDArrayData
ndArrayDataFromMaps Object
maps = do
  ByteString
bytes <- Key -> Eff es Value
require Key
"source" Eff es Value -> (Value -> Eff es ByteString) -> Eff es ByteString
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Eff es ByteString
forall {es :: [Effect]}.
(Reader [BlockData] :> es, Error YamlError :> es) =>
Value -> Eff es ByteString
findSource
  DataType
datatype <- Key -> Eff es Value
require Key
"datatype" Eff es Value -> (Value -> Eff es DataType) -> Eff es DataType
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Eff es DataType
parseDatatype
  ByteOrder
byteorder <- Key -> Eff es Value
require Key
"byteorder" Eff es Value -> (Value -> Eff es ByteOrder) -> Eff es ByteOrder
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Eff es ByteOrder
parseByteorder
  Axes 'Row
shape <- Key -> Eff es Value
require Key
"shape" Eff es Value -> (Value -> Eff es (Axes 'Row)) -> Eff es (Axes 'Row)
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Eff es (Axes 'Row)
forall {es :: [Effect]}.
(Error YamlError :> es) =>
Value -> Eff es (Axes 'Row)
parseShape
  NDArrayData -> Eff es NDArrayData
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NDArrayData -> Eff es NDArrayData)
-> NDArrayData -> Eff es NDArrayData
forall a b. (a -> b) -> a -> b
$ NDArrayData{ByteString
bytes :: ByteString
bytes :: ByteString
bytes, DataType
datatype :: DataType
datatype :: DataType
datatype, ByteOrder
byteorder :: ByteOrder
byteorder :: ByteOrder
byteorder, Axes 'Row
shape :: Axes 'Row
shape :: Axes 'Row
shape}
 where
  require :: Key -> Eff es Value
require Key
key =
    case Key -> Object -> Maybe Node
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Key
key Object
maps of
      Maybe Node
Nothing -> YamlError -> Eff es Value
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Value) -> YamlError -> Eff es Value
forall a b. (a -> b) -> a -> b
$ String -> YamlError
NDArrayMissingKey (Key -> String
unpack Key
key)
      Just (Node SchemaTag
_ Maybe Anchor
_ Value
val) -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
val

  parseDatatype :: Value -> Eff es DataType
parseDatatype = String -> Value -> Eff es DataType
forall a.
(FromAsdf a, Error YamlError :> es) =>
String -> Value -> Eff es a
parseLocal String
"DataType"
  parseByteorder :: Value -> Eff es ByteOrder
parseByteorder = String -> Value -> Eff es ByteOrder
forall a.
(FromAsdf a, Error YamlError :> es) =>
String -> Value -> Eff es a
parseLocal String
"ByteOrder"
  parseShape :: Value -> Eff es (Axes 'Row)
parseShape Value
val =
    case Value
val of
      Array [Node]
ns -> [Int] -> Axes 'Row
axesRowMajor ([Int] -> Axes 'Row) -> Eff es [Int] -> Eff es (Axes 'Row)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Node -> Eff es Int) -> [Node] -> Eff es [Int]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Value -> Eff es Int
forall {a} {es :: [Effect]}.
(Num a, Error YamlError :> es) =>
Value -> Eff es a
parseAxis (Value -> Eff es Int) -> (Node -> Value) -> Node -> Eff es Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.value)) [Node]
ns
      Value
_ -> YamlError -> Eff es (Axes 'Row)
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es (Axes 'Row))
-> YamlError -> Eff es (Axes 'Row)
forall a b. (a -> b) -> a -> b
$ String -> Value -> YamlError
NDArrayExpected String
"Shape" Value
val

  parseAxis :: Value -> Eff es a
parseAxis Value
val =
    case Value
val of
      Integer Integer
n -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Eff es a) -> a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n
      Value
_ -> YamlError -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es a) -> YamlError -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> Value -> YamlError
NDArrayExpected String
"Shape Axis" Value
val

  findSource :: Value -> Eff es ByteString
findSource Value
val =
    case Value
val of
      Integer Integer
s -> do
        [BlockData]
blocks <- Eff es [BlockData]
forall r (es :: [Effect]).
(HasCallStack, Reader r :> es) =>
Eff es r
ask
        case [BlockData]
blocks [BlockData] -> Int -> Maybe BlockData
forall a. [a] -> Int -> Maybe a
!? Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s of
          Maybe BlockData
Nothing -> YamlError -> Eff es ByteString
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es ByteString) -> YamlError -> Eff es ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> YamlError
NDArrayMissingBlock Integer
s
          Just (BlockData ByteString
b) -> ByteString -> Eff es ByteString
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b
      Value
_ -> YamlError -> Eff es ByteString
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es ByteString) -> YamlError -> Eff es ByteString
forall a b. (a -> b) -> a -> b
$ String -> Value -> YamlError
NDArrayExpected String
"Source" Value
val

  parseLocal :: (FromAsdf a, Error YamlError :> es) => String -> Value -> Eff es a
  parseLocal :: forall a.
(FromAsdf a, Error YamlError :> es) =>
String -> Value -> Eff es a
parseLocal String
expected Value
val =
    case Eff '[Parser, Error ParseError] a -> Either ParseError a
forall a. Eff '[Parser, Error ParseError] a -> Either ParseError a
runPureParser (Eff '[Parser, Error ParseError] a -> Either ParseError a)
-> (Eff '[Reader Anchors, Parser, Error ParseError] a
    -> Eff '[Parser, Error ParseError] a)
-> Eff '[Reader Anchors, Parser, Error ParseError] a
-> Either ParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (es :: [Effect]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader @Anchors Anchors
forall a. Monoid a => a
mempty (Eff '[Reader Anchors, Parser, Error ParseError] a
 -> Either ParseError a)
-> Eff '[Reader Anchors, Parser, Error ParseError] a
-> Either ParseError a
forall a b. (a -> b) -> a -> b
$ Value -> Eff '[Reader Anchors, Parser, Error ParseError] a
forall (es :: [Effect]). (Parser :> es) => Value -> Eff es a
forall a (es :: [Effect]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue Value
val of
      Left ParseError
_ -> YamlError -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es a) -> YamlError -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> Value -> YamlError
NDArrayExpected String
expected Value
val
      Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


sinkMapping :: (Error YamlError :> es, Reader [BlockData] :> es, State Anchors :> es) => ConduitT Event o (Eff es) (Key, Node)
sinkMapping :: forall (es :: [Effect]) o.
(Error YamlError :> es, Reader [BlockData] :> es,
 State Anchors :> es) =>
ConduitT Event o (Eff es) (Key, Node)
sinkMapping = do
  Key
k <- ConduitT Event o (Eff es) Key
forall {o}. ConduitT Event o (Eff es) Key
sinkMapKey
  Node
v <- ConduitT Event o (Eff es) Node
forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Node
sinkNode
  (Key, Node) -> ConduitT Event o (Eff es) (Key, Node)
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key
k, Node
v)
 where
  sinkMapKey :: ConduitT Event o (Eff es) Key
sinkMapKey =
    ConduitT Event o (Eff es) Event
forall (es :: [Effect]) i o.
(Error YamlError :> es) =>
ConduitT i o (Eff es) i
event ConduitT Event o (Eff es) Event
-> (Event -> ConduitT Event o (Eff es) Key)
-> ConduitT Event o (Eff es) Key
forall a b.
ConduitT Event o (Eff es) a
-> (a -> ConduitT Event o (Eff es) b)
-> ConduitT Event o (Eff es) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      EventScalar ByteString
s Tag
_ Style
_ Anchor
_ -> Key -> ConduitT Event o (Eff es) Key
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Key -> ConduitT Event o (Eff es) Key)
-> Key -> ConduitT Event o (Eff es) Key
forall a b. (a -> b) -> a -> b
$ ByteString -> Key
decodeUtf8 ByteString
s
      Event
ev -> Eff es Key -> ConduitT Event o (Eff es) Key
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Key -> ConduitT Event o (Eff es) Key)
-> Eff es Key -> ConduitT Event o (Eff es) Key
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es Key
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Key) -> YamlError -> Eff es Key
forall a b. (a -> b) -> a -> b
$ String -> Event -> YamlError
ExpectedEvent String
"Scalar Key" Event
ev


-- we don't have to parse this into an object...
sinkMappings :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Event o (Eff es) [(Key, Node)]
sinkMappings :: forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Object
sinkMappings = do
  (Event -> Bool)
-> ConduitT Event o (Eff es) (Key, Node)
-> ConduitT Event o (Eff es) Object
forall o (es :: [Effect]) a.
(Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile (Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
/= Event
EventMappingEnd) ConduitT Event o (Eff es) (Key, Node)
forall (es :: [Effect]) o.
(Error YamlError :> es, Reader [BlockData] :> es,
 State Anchors :> es) =>
ConduitT Event o (Eff es) (Key, Node)
sinkMapping


-- oh, the event mapping ends aren't being consumed!
sinkWhile :: (Event -> Bool) -> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile :: forall o (es :: [Effect]) a.
(Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile Event -> Bool
p ConduitT Event o (Eff es) a
parse = do
  Maybe Event
e <- ConduitT Event o (Eff es) (Maybe Event)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
peek
  if Bool -> (Event -> Bool) -> Maybe Event -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Event -> Bool
p Maybe Event
e
    then do
      a
a <- ConduitT Event o (Eff es) a
parse
      [a]
as <- (Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
forall o (es :: [Effect]) a.
(Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile Event -> Bool
p ConduitT Event o (Eff es) a
parse
      [a] -> ConduitT Event o (Eff es) [a]
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> ConduitT Event o (Eff es) [a])
-> [a] -> ConduitT Event o (Eff es) [a]
forall a b. (a -> b) -> a -> b
$ a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
    else do
      -- consume the one we matched
      Int -> ConduitT Event o (Eff es) ()
forall (m :: * -> *) a o. Monad m => Int -> ConduitT a o m ()
C.drop Int
1
      [a] -> ConduitT Event o (Eff es) [a]
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


sinkSequence :: (Error YamlError :> es, State Anchors :> es, Reader [BlockData] :> es) => ConduitT Event o (Eff es) [Node]
sinkSequence :: forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) [Node]
sinkSequence = do
  (Event -> Bool)
-> ConduitT Event o (Eff es) Node
-> ConduitT Event o (Eff es) [Node]
forall o (es :: [Effect]) a.
(Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile (Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
/= Event
EventSequenceEnd) ConduitT Event o (Eff es) Node
forall (es :: [Effect]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Node
sinkNode


parseScalar :: (Error YamlError :> es) => Maybe Anchor -> ByteString -> Yaml.Tag -> Eff es Node
parseScalar :: forall (es :: [Effect]).
(Error YamlError :> es) =>
Maybe Anchor -> ByteString -> Tag -> Eff es Node
parseScalar Maybe Anchor
ma ByteString
inp Tag
tg = Tag -> Eff es Node
forall (es :: [Effect]).
(Error YamlError :> es) =>
Tag -> Eff es Node
byTag Tag
tg
 where
  byTag :: (Error YamlError :> es) => Yaml.Tag -> Eff es Node
  byTag :: forall (es :: [Effect]).
(Error YamlError :> es) =>
Tag -> Eff es Node
byTag = \case
    UriTag String
s -> String -> Eff (NonDet : es) Node -> Eff es Node
forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
"Any" (Eff (NonDet : es) Node -> Eff es Node)
-> Eff (NonDet : es) Node -> Eff es Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node (String -> SchemaTag
schemaTag String
s) Maybe Anchor
ma (Value -> Node)
-> Eff (NonDet : es) Value -> Eff (NonDet : es) Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Eff (NonDet : es) Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseMulti ByteString
inp
    Tag
other -> do
      Value
val <- Tag -> Eff es Value
forall (es :: [Effect]).
(Error YamlError :> es) =>
Tag -> Eff es Value
nonUriTagValue Tag
other
      Node -> Eff es Node
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Node -> Eff es Node) -> Node -> Eff es Node
forall a b. (a -> b) -> a -> b
$ SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
forall a. Monoid a => a
mempty Maybe Anchor
ma Value
val

  nonUriTagValue :: (Error YamlError :> es) => Yaml.Tag -> Eff es Value
  nonUriTagValue :: forall (es :: [Effect]).
(Error YamlError :> es) =>
Tag -> Eff es Value
nonUriTagValue = \case
    Tag
StrTag -> ByteString -> Eff es Value
forall {f :: * -> *}. Applicative f => ByteString -> f Value
parseStr ByteString
inp -- always succeeds
    Tag
FloatTag -> String -> Eff (NonDet : es) Value -> Eff es Value
forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
"Float" (Eff (NonDet : es) Value -> Eff es Value)
-> Eff (NonDet : es) Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff (NonDet : es) Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseFloat ByteString
inp
    Tag
IntTag -> String -> Eff (NonDet : es) Value -> Eff es Value
forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
"Int" (Eff (NonDet : es) Value -> Eff es Value)
-> Eff (NonDet : es) Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff (NonDet : es) Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseInt ByteString
inp
    Tag
NullTag -> Value -> Eff es Value
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
Null
    Tag
BoolTag -> String -> Eff (NonDet : es) Value -> Eff es Value
forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
"Bool" (Eff (NonDet : es) Value -> Eff es Value)
-> Eff (NonDet : es) Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff (NonDet : es) Value
forall {a} {f :: * -> *}.
(Eq a, IsString a, Alternative f) =>
a -> f Value
parseBool ByteString
inp
    Tag
NoTag -> String -> Eff (NonDet : es) Value -> Eff es Value
forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
"Any" (Eff (NonDet : es) Value -> Eff es Value)
-> Eff (NonDet : es) Value -> Eff es Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff (NonDet : es) Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseMulti ByteString
inp
    Tag
_ -> YamlError -> Eff es Value
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Value) -> YamlError -> Eff es Value
forall a b. (a -> b) -> a -> b
$ Tag -> ByteString -> YamlError
InvalidScalarTag Tag
tg ByteString
inp

  parseBool :: a -> f Value
parseBool a
"true" = Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool Bool
True
  parseBool a
"false" = Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool Bool
False
  parseBool a
_ = f Value
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
empty

  parseStr :: ByteString -> f Value
parseStr ByteString
s = Value -> f Value
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> f Value) -> Value -> f Value
forall a b. (a -> b) -> a -> b
$ Key -> Value
String (ByteString -> Key
decodeUtf8 ByteString
s)

  parseInt :: ByteString -> Eff es Value
parseInt ByteString
s = Integer -> Value
Integer (Integer -> Value) -> Eff es Integer -> Eff es Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Eff es Integer
forall a (es :: [Effect]).
(Read a, NonDet :> es) =>
ByteString -> Eff es a
parseRead ByteString
s

  parseFloat :: ByteString -> Eff es Value
parseFloat ByteString
s = Scientific -> Value
Number (Scientific -> Value) -> Eff es Scientific -> Eff es Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Eff es Scientific
forall a (es :: [Effect]).
(Read a, NonDet :> es) =>
ByteString -> Eff es a
parseRead ByteString
s

  parseMulti :: ByteString -> Eff es Value
parseMulti ByteString
s =
    ByteString -> Eff es Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseInt ByteString
s Eff es Value -> Eff es Value -> Eff es Value
forall a. Eff es a -> Eff es a -> Eff es a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Eff es Value
forall {es :: [Effect]}.
(NonDet :> es) =>
ByteString -> Eff es Value
parseFloat ByteString
s Eff es Value -> Eff es Value -> Eff es Value
forall a. Eff es a -> Eff es a -> Eff es a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Eff es Value
forall {a} {f :: * -> *}.
(Eq a, IsString a, Alternative f) =>
a -> f Value
parseBool ByteString
s Eff es Value -> Eff es Value -> Eff es Value
forall a. Eff es a -> Eff es a -> Eff es a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Eff es Value
forall {f :: * -> *}. Applicative f => ByteString -> f Value
parseStr ByteString
s

  throwEmpty :: (Error YamlError :> es) => String -> Eff (NonDet : es) a -> Eff es a
  throwEmpty :: forall (es :: [Effect]) a.
(Error YamlError :> es) =>
String -> Eff (NonDet : es) a -> Eff es a
throwEmpty String
expt Eff (NonDet : es) a
eff = do
    Either CallStack a
ec <- OnEmptyPolicy -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
forall (es :: [Effect]) a.
HasCallStack =>
OnEmptyPolicy -> Eff (NonDet : es) a -> Eff es (Either CallStack a)
runNonDet OnEmptyPolicy
OnEmptyKeep Eff (NonDet : es) a
eff
    case Either CallStack a
ec of
      Left CallStack
_ -> YamlError -> Eff es a
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es a) -> YamlError -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> Tag -> ByteString -> YamlError
InvalidScalar String
expt Tag
tg ByteString
inp
      Right a
a -> a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

  parseRead :: (Read a, NonDet :> es) => ByteString -> Eff es a
  parseRead :: forall a (es :: [Effect]).
(Read a, NonDet :> es) =>
ByteString -> Eff es a
parseRead ByteString
s = do
    Eff es a -> (a -> Eff es a) -> Maybe a -> Eff es a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Eff es a
forall a. Eff es a
forall (f :: * -> *) a. Alternative f => f a
empty a -> Eff es a
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Eff es a) -> Maybe a -> Eff es a
forall a b. (a -> b) -> a -> b
$ String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Key -> String
unpack (Key -> String) -> Key -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Key
decodeUtf8 ByteString
s)


-- | Await an event. Throw if out of input
event :: (Error YamlError :> es) => ConduitT i o (Eff es) i
event :: forall (es :: [Effect]) i o.
(Error YamlError :> es) =>
ConduitT i o (Eff es) i
event = do
  Maybe i
e <- ConduitT i o (Eff es) (Maybe i)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
await
  case Maybe i
e of
    Maybe i
Nothing -> Eff es i -> ConduitT i o (Eff es) i
forall (m :: * -> *) a. Monad m => m a -> ConduitT i o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es i -> ConduitT i o (Eff es) i)
-> Eff es i -> ConduitT i o (Eff es) i
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es i
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError YamlError
NoInput
    Just i
a -> i -> ConduitT i o (Eff es) i
forall a. a -> ConduitT i o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure i
a


parseSchemaTag :: Tag -> SchemaTag
parseSchemaTag :: Tag -> SchemaTag
parseSchemaTag (UriTag String
s) =
  let t :: Key
t = String -> Key
pack String
s
      mt :: Maybe Key
mt = Key -> Key -> Maybe Key
T.stripPrefix Key
"tag:stsci.edu:asdf/" Key
t
   in Maybe Key -> SchemaTag
SchemaTag (Maybe Key -> (Key -> Maybe Key) -> Maybe Key -> Maybe Key
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key -> Maybe Key
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Key
t) Key -> Maybe Key
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Key
mt)
parseSchemaTag Tag
_ = SchemaTag
forall a. Monoid a => a
mempty


isNDArray :: SchemaTag -> Bool
isNDArray :: SchemaTag -> Bool
isNDArray (SchemaTag Maybe Key
Nothing) = Bool
False
isNDArray (SchemaTag (Just Key
t)) =
  Key
"core/ndarray" Key -> Key -> Bool
`T.isPrefixOf` Key
t


expect :: (Error YamlError :> es) => Event -> ConduitT Event o (Eff es) ()
expect :: forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
ex = String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
expect' (String
"Exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Event -> String
forall a. Show a => a -> String
show Event
ex) (Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
== Event
ex)


expect' :: (Error YamlError :> es) => String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
expect' :: forall (es :: [Effect]) o.
(Error YamlError :> es) =>
String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
expect' String
ex Event -> Bool
p = do
  Event
e <- ConduitT Event o (Eff es) Event
forall (es :: [Effect]) i o.
(Error YamlError :> es) =>
ConduitT i o (Eff es) i
event
  if Event -> Bool
p Event
e
    then () -> ConduitT Event o (Eff es) ()
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else Eff es () -> ConduitT Event o (Eff es) ()
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es () -> ConduitT Event o (Eff es) ())
-> Eff es () -> ConduitT Event o (Eff es) ()
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es ()
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es ()) -> YamlError -> Eff es ()
forall a b. (a -> b) -> a -> b
$ String -> Event -> YamlError
ExpectedEvent String
ex Event
e


data YamlError
  = NoInput
  | ExpectedEvent String Event
  | InvalidScalar String Tag ByteString
  | InvalidScalarTag Tag ByteString
  | InvalidTree String Value
  | NDArrayMissingKey String
  | NDArrayMissingBlock Integer
  | NDArrayExpected String Value
  | InvalidReference Value
  | AnchorUndefined Anchor [Anchor]
  deriving (Int -> YamlError -> String -> String
[YamlError] -> String -> String
YamlError -> String
(Int -> YamlError -> String -> String)
-> (YamlError -> String)
-> ([YamlError] -> String -> String)
-> Show YamlError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> YamlError -> String -> String
showsPrec :: Int -> YamlError -> String -> String
$cshow :: YamlError -> String
show :: YamlError -> String
$cshowList :: [YamlError] -> String -> String
showList :: [YamlError] -> String -> String
Show)


sinkIndex :: (Error YamlError :> es) => ConduitT Event o (Eff es) BlockIndex
sinkIndex :: forall (es :: [Effect]) o.
(Error YamlError :> es) =>
ConduitT Event o (Eff es) BlockIndex
sinkIndex = do
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventStreamStart
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventDocumentStart
  String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
String -> (Event -> Bool) -> ConduitT Event o (Eff es) ()
expect' String
"EventSequenceStart" Event -> Bool
isSequence
  [Int]
ns <- (Event -> Bool)
-> ConduitT Event o (Eff es) Int -> ConduitT Event o (Eff es) [Int]
forall o (es :: [Effect]) a.
(Event -> Bool)
-> ConduitT Event o (Eff es) a -> ConduitT Event o (Eff es) [a]
sinkWhile (Event -> Event -> Bool
forall a. Eq a => a -> a -> Bool
/= Event
EventSequenceEnd) ConduitT Event o (Eff es) Int
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
ConduitT Event o (Eff es) Int
sinkIndexEntry
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventSequenceEnd
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventDocumentEnd
  Event -> ConduitT Event o (Eff es) ()
forall (es :: [Effect]) o.
(Error YamlError :> es) =>
Event -> ConduitT Event o (Eff es) ()
expect Event
EventStreamEnd
  BlockIndex -> ConduitT Event o (Eff es) BlockIndex
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BlockIndex -> ConduitT Event o (Eff es) BlockIndex)
-> BlockIndex -> ConduitT Event o (Eff es) BlockIndex
forall a b. (a -> b) -> a -> b
$ [Int] -> BlockIndex
BlockIndex [Int]
ns
 where
  isSequence :: Event -> Bool
  isSequence :: Event -> Bool
isSequence EventSequenceStart{} = Bool
True
  isSequence Event
_ = Bool
False

  sinkIndexEntry :: (Error YamlError :> es) => ConduitT Event o (Eff es) Int
  sinkIndexEntry :: forall (es :: [Effect]) o.
(Error YamlError :> es) =>
ConduitT Event o (Eff es) Int
sinkIndexEntry = do
    Event
e <- ConduitT Event o (Eff es) Event
forall (es :: [Effect]) i o.
(Error YamlError :> es) =>
ConduitT i o (Eff es) i
event
    case Event
e of
      EventScalar ByteString
s Tag
t Style
_ Anchor
_ -> do
        case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Key -> String
unpack (Key -> String) -> Key -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Key
decodeUtf8 ByteString
s) of
          Just Int
n -> Int -> ConduitT Event o (Eff es) Int
forall a. a -> ConduitT Event o (Eff es) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
n
          Maybe Int
Nothing -> Eff es Int -> ConduitT Event o (Eff es) Int
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Int -> ConduitT Event o (Eff es) Int)
-> Eff es Int -> ConduitT Event o (Eff es) Int
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es Int
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Int) -> YamlError -> Eff es Int
forall a b. (a -> b) -> a -> b
$ String -> Tag -> ByteString -> YamlError
InvalidScalar String
"Int Index Entry" Tag
t ByteString
s
      Event
_ -> Eff es Int -> ConduitT Event o (Eff es) Int
forall (m :: * -> *) a. Monad m => m a -> ConduitT Event o m a
forall (t :: Effect) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eff es Int -> ConduitT Event o (Eff es) Int)
-> Eff es Int -> ConduitT Event o (Eff es) Int
forall a b. (a -> b) -> a -> b
$ YamlError -> Eff es Int
forall e (es :: [Effect]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (YamlError -> Eff es Int) -> YamlError -> Eff es Int
forall a b. (a -> b) -> a -> b
$ String -> Event -> YamlError
ExpectedEvent String
"Scalar Int" Event
e


addNodeAnchor :: (State Anchors :> es) => Node -> Eff es ()
addNodeAnchor :: forall (es :: [Effect]). (State Anchors :> es) => Node -> Eff es ()
addNodeAnchor Node
n =
  case Node
n.anchor of
    Maybe Anchor
Nothing -> () -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Anchor
a -> (Anchors -> Anchors) -> Eff es ()
forall s (es :: [Effect]).
(HasCallStack, State s :> es) =>
(s -> s) -> Eff es ()
modify ([(Anchor, Value)] -> Anchors
Anchors [(Anchor
a, Node
n.value)] <>)