module Telescope.Asdf.Encoding where

import Conduit
import Data.Binary.Get
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as BL
import Data.Function ((&))
import Effectful
import Effectful.Error.Static
import Effectful.Reader.Dynamic
import Effectful.Resource
import Effectful.State.Static.Local
import Telescope.Asdf.Class
import Telescope.Asdf.Core
import Telescope.Asdf.Encoding.File
import Telescope.Asdf.Encoding.Stream
import Telescope.Asdf.Error
import Telescope.Asdf.Node
import Telescope.Data.Parser (ParseError, runParser)
import Text.Libyaml qualified as Yaml


-- | Encode a 'ToAsdf' to a 'ByteString'
encodeM :: (ToAsdf a, MonadIO m, MonadThrow m) => a -> m ByteString
encodeM :: forall a (m :: * -> *).
(ToAsdf a, MonadIO m, MonadThrow m) =>
a -> m ByteString
encodeM a
a = Eff '[Error AsdfError, IOE] ByteString -> m ByteString
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
Eff '[Error AsdfError, IOE] a -> m a
runAsdfM (Eff '[Error AsdfError, IOE] ByteString -> m ByteString)
-> Eff '[Error AsdfError, IOE] ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ a -> Eff '[Error AsdfError, IOE] ByteString
forall a (es :: [(* -> *) -> * -> *]).
(ToAsdf a, IOE :> es, Error AsdfError :> es) =>
a -> Eff es ByteString
encode a
a


-- | Encode a 'ToAsdf' to a 'ByteString'
encode :: (ToAsdf a, IOE :> es, Error AsdfError :> es) => a -> Eff es ByteString
encode :: forall a (es :: [(* -> *) -> * -> *]).
(ToAsdf a, IOE :> es, Error AsdfError :> es) =>
a -> Eff es ByteString
encode a
a = do
  Asdf
asdf <- a -> Eff es Asdf
forall a (es :: [(* -> *) -> * -> *]).
(ToAsdf a, Error AsdfError :> es) =>
a -> Eff es Asdf
toAsdfDoc a
a
  AsdfFile
file <- Asdf -> Eff es AsdfFile
forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
Asdf -> Eff es AsdfFile
encodeAsdf Asdf
asdf
  ByteString -> Eff es ByteString
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Eff es ByteString)
-> ByteString -> Eff es ByteString
forall a b. (a -> b) -> a -> b
$ AsdfFile -> ByteString
concatAsdfFile AsdfFile
file


-- | Encode an 'Asdf' document to a 'ByteString'
encodeAsdf :: (IOE :> es, Error AsdfError :> es) => Asdf -> Eff es AsdfFile
encodeAsdf :: forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
Asdf -> Eff es AsdfFile
encodeAsdf Asdf
a = do
  (ByteString
doc, [BlockData]
bds) <- Node -> Eff es (ByteString, [BlockData])
forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
Node -> Eff es (ByteString, [BlockData])
encodeNode (Asdf -> Node
forall a. ToAsdf a => a -> Node
toNode Asdf
a)
  let tree :: Encoded Tree
tree = ByteString -> Encoded Tree
encodeTree ByteString
doc
  let blocks :: [Encoded Block]
blocks = (BlockData -> Encoded Block) -> [BlockData] -> [Encoded Block]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockData -> Encoded Block
encodeBlock [BlockData]
bds
  let index :: Encoded Index
index = BlockIndex -> Encoded Index
encodeIndex (BlockIndex -> Encoded Index) -> BlockIndex -> Encoded Index
forall a b. (a -> b) -> a -> b
$ Encoded Tree -> [Encoded Block] -> BlockIndex
blockIndex Encoded Tree
tree [Encoded Block]
blocks
  AsdfFile -> Eff es AsdfFile
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AsdfFile -> Eff es AsdfFile) -> AsdfFile -> Eff es AsdfFile
forall a b. (a -> b) -> a -> b
$ AsdfFile{Encoded Tree
tree :: Encoded Tree
tree :: Encoded Tree
tree, [Encoded Block]
blocks :: [Encoded Block]
blocks :: [Encoded Block]
blocks, Encoded Index
index :: Encoded Index
index :: Encoded Index
index}


-- | Low-level encoding of a node to a Yaml tree, without required headers, etc
encodeNode :: (IOE :> es, Error AsdfError :> es) => Node -> Eff es (ByteString, [BlockData])
encodeNode :: forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
Node -> Eff es (ByteString, [BlockData])
encodeNode Node
node = do
  Eff (Error YamlError : es) (ByteString, [BlockData])
-> Eff es (ByteString, [BlockData])
forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error YamlError : es) a -> Eff es a
runYamlError (Eff (Error YamlError : es) (ByteString, [BlockData])
 -> Eff es (ByteString, [BlockData]))
-> Eff (Error YamlError : es) (ByteString, [BlockData])
-> Eff es (ByteString, [BlockData])
forall a b. (a -> b) -> a -> b
$ ConduitT
  ()
  Event
  (Eff
     (State Anchors
        : State [BlockData] : Resource : Error YamlError : es))
  ()
-> Eff (Error YamlError : es) (ByteString, [BlockData])
forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
-> Eff es (ByteString, [BlockData])
encodeStream (ConduitT
  ()
  Event
  (Eff
     (State Anchors
        : State [BlockData] : Resource : Error YamlError : es))
  ()
-> ConduitT
     ()
     Event
     (Eff
        (State Anchors
           : State [BlockData] : Resource : Error YamlError : es))
     ()
forall (es :: [(* -> *) -> * -> *]) a.
(State [BlockData] :> es, IOE :> es) =>
ConduitT a Event (Eff es) () -> ConduitT a Event (Eff es) ()
yieldDocumentStream (ConduitT
   ()
   Event
   (Eff
      (State Anchors
         : State [BlockData] : Resource : Error YamlError : es))
   ()
 -> ConduitT
      ()
      Event
      (Eff
         (State Anchors
            : State [BlockData] : Resource : Error YamlError : es))
      ())
-> ConduitT
     ()
     Event
     (Eff
        (State Anchors
           : State [BlockData] : Resource : Error YamlError : es))
     ()
-> ConduitT
     ()
     Event
     (Eff
        (State Anchors
           : State [BlockData] : Resource : Error YamlError : es))
     ()
forall a b. (a -> b) -> a -> b
$ Node
-> ConduitT
     ()
     Event
     (Eff
        (State Anchors
           : State [BlockData] : Resource : Error YamlError : es))
     ()
forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es, State [BlockData] :> es, State Anchors :> es,
 Error YamlError :> es) =>
Node -> ConduitT a Event (Eff es) ()
yieldNode Node
node)


-- | Create a stream of yaml events
encodeStream :: (IOE :> es, Error AsdfError :> es) => ConduitT () Yaml.Event (Eff (State Anchors : State [BlockData] : Resource : es)) () -> Eff es (ByteString, [BlockData])
encodeStream :: forall (es :: [(* -> *) -> * -> *]).
(IOE :> es, Error AsdfError :> es) =>
ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
-> Eff es (ByteString, [BlockData])
encodeStream ConduitT
  ()
  Event
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ()
con = do
  ConduitT
  ()
  Void
  (Eff (State Anchors : State [BlockData] : Resource : es))
  ByteString
-> Eff es (ByteString, [BlockData])
forall (es :: [(* -> *) -> * -> *]) 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))
   ByteString
 -> Eff es (ByteString, [BlockData]))
-> ConduitT
     ()
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     ByteString
-> Eff es (ByteString, [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))
     ByteString
-> ConduitT
     ()
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     ByteString
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| FormatOptions
-> ConduitT
     Event
     Void
     (Eff (State Anchors : State [BlockData] : Resource : es))
     ByteString
forall (m :: * -> *) o.
MonadResource m =>
FormatOptions -> ConduitM Event o m ByteString
Yaml.encodeWith FormatOptions
format
 where
  format :: FormatOptions
format =
    FormatOptions
Yaml.defaultFormatOptions
      FormatOptions -> (FormatOptions -> FormatOptions) -> FormatOptions
forall a b. a -> (a -> b) -> b
& (Event -> TagRender) -> FormatOptions -> FormatOptions
Yaml.setTagRendering Event -> TagRender
Yaml.renderUriTags
      FormatOptions -> (FormatOptions -> FormatOptions) -> FormatOptions
forall a b. a -> (a -> b) -> b
& Maybe Int -> FormatOptions -> FormatOptions
Yaml.setWidth (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100)


-- | Decode a 'ByteString' to a 'FromAsdf'
decodeM :: (FromAsdf a, MonadIO m, MonadThrow m) => ByteString -> m a
decodeM :: forall a (m :: * -> *).
(FromAsdf a, MonadIO m, MonadThrow m) =>
ByteString -> m a
decodeM ByteString
bs = Eff '[Error AsdfError, IOE] a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadThrow m) =>
Eff '[Error AsdfError, IOE] a -> m a
runAsdfM (Eff '[Error AsdfError, IOE] a -> m a)
-> Eff '[Error AsdfError, IOE] a -> m a
forall a b. (a -> b) -> a -> b
$ ByteString -> Eff '[Error AsdfError, IOE] a
forall a (es :: [(* -> *) -> * -> *]).
(FromAsdf a, IOE :> es, Error AsdfError :> es) =>
ByteString -> Eff es a
decode ByteString
bs


-- | Decode a 'ByteString' to a 'FromAsdf'
decodeEither :: forall a m. (FromAsdf a, MonadIO m) => ByteString -> m (Either String a)
decodeEither :: forall a (m :: * -> *).
(FromAsdf a, MonadIO m) =>
ByteString -> m (Either String a)
decodeEither ByteString
bs = do
  Either AsdfError a
res <- IO (Either AsdfError a) -> m (Either AsdfError a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either AsdfError a) -> m (Either AsdfError a))
-> IO (Either AsdfError a) -> m (Either AsdfError a)
forall a b. (a -> b) -> a -> b
$ Eff '[IOE] (Either AsdfError a) -> IO (Either AsdfError a)
forall a. HasCallStack => Eff '[IOE] a -> IO a
runEff (Eff '[IOE] (Either AsdfError a) -> IO (Either AsdfError a))
-> Eff '[IOE] (Either AsdfError a) -> IO (Either AsdfError a)
forall a b. (a -> b) -> a -> b
$ forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
Eff (Error e : es) a -> Eff es (Either e a)
runErrorNoCallStack @AsdfError (Eff '[Error AsdfError, IOE] a -> Eff '[IOE] (Either AsdfError a))
-> Eff '[Error AsdfError, IOE] a -> Eff '[IOE] (Either AsdfError a)
forall a b. (a -> b) -> a -> b
$ forall a (es :: [(* -> *) -> * -> *]).
(FromAsdf a, IOE :> es, Error AsdfError :> es) =>
ByteString -> Eff es a
decode @a ByteString
bs
  Either String a -> m (Either String a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> m (Either String a))
-> Either String a -> m (Either String a)
forall a b. (a -> b) -> a -> b
$ (AsdfError -> Either String a)
-> (a -> Either String a) -> Either AsdfError a -> Either String a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a)
-> (AsdfError -> String) -> AsdfError -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsdfError -> String
forall a. Show a => a -> String
show) a -> Either String a
forall a b. b -> Either a b
Right Either AsdfError a
res


-- | Decode a 'ByteString' to a 'FromAsdf'
decode :: (FromAsdf a, IOE :> es, Error AsdfError :> es) => ByteString -> Eff es a
decode :: forall a (es :: [(* -> *) -> * -> *]).
(FromAsdf a, IOE :> es, Error AsdfError :> es) =>
ByteString -> Eff es a
decode ByteString
bs = do
  AsdfFile
f <- ByteString -> Eff es AsdfFile
forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es) =>
ByteString -> Eff es AsdfFile
splitAsdfFile ByteString
bs
  Tree
tree <- Encoded Tree -> [Encoded Block] -> Eff es Tree
forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, IOE :> es) =>
Encoded Tree -> [Encoded Block] -> Eff es Tree
parseAsdfTree AsdfFile
f.tree AsdfFile
f.blocks
  Tree -> Eff es a
forall a (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, FromAsdf a) =>
Tree -> Eff es a
decodeFromTree Tree
tree


-- | Decode a 'Tree' to a 'FromAsdf'
decodeFromTree :: forall a es. (Error AsdfError :> es) => (FromAsdf a) => Tree -> Eff es a
decodeFromTree :: forall a (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, FromAsdf a) =>
Tree -> Eff es a
decodeFromTree (Tree Object
o) = do
  Eff (Error ParseError : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error ParseError : es) a -> Eff es a
runParseError (Eff (Error ParseError : es) a -> Eff es a)
-> Eff (Error ParseError : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Eff (Parser : Error ParseError : es) a
-> Eff (Error ParseError : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(Error ParseError :> es) =>
Eff (Parser : es) a -> Eff es a
runParser (Eff (Parser : Error ParseError : es) a
 -> Eff (Error ParseError : es) a)
-> Eff (Parser : Error ParseError : es) a
-> Eff (Error ParseError : es) a
forall a b. (a -> b) -> a -> b
$ forall a (es :: [(* -> *) -> * -> *]).
(FromAsdf a, Parser :> es) =>
Value -> Eff es a
parseValue @a (Object -> Value
Object Object
o)


-- | Parse the asdf file parts into a 'Tree'
parseAsdfTree :: (Error AsdfError :> es, IOE :> es) => Encoded Tree -> [Encoded Block] -> Eff es Tree
parseAsdfTree :: forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, IOE :> es) =>
Encoded Tree -> [Encoded Block] -> Eff es Tree
parseAsdfTree Encoded Tree
etree [Encoded Block]
eblks = do
  (Object
root, Anchors
_) <- Encoded Tree -> [Encoded Block] -> Eff es (Object, Anchors)
forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, IOE :> es) =>
Encoded Tree -> [Encoded Block] -> Eff es (Object, Anchors)
streamAsdfFile Encoded Tree
etree [Encoded Block]
eblks
  Tree -> Eff es Tree
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tree -> Eff es Tree) -> Tree -> Eff es Tree
forall a b. (a -> b) -> a -> b
$ Object -> Tree
Tree Object
root


streamAsdfFile :: (Error AsdfError :> es, IOE :> es) => Encoded Tree -> [Encoded Block] -> Eff es (Object, Anchors)
streamAsdfFile :: forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, IOE :> es) =>
Encoded Tree -> [Encoded Block] -> Eff es (Object, Anchors)
streamAsdfFile (Encoded ByteString
inp) [Encoded Block]
ebks = do
  [BlockData]
blocks <- (Encoded Block -> Eff es BlockData)
-> [Encoded Block] -> Eff es [BlockData]
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 Encoded Block -> Eff es BlockData
forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es) =>
Encoded Block -> Eff es BlockData
decodeBlock [Encoded Block]
ebks
  Eff (Error ParseError : es) (Object, Anchors)
-> Eff es (Object, Anchors)
forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error ParseError : es) a -> Eff es a
runParseError (Eff (Error ParseError : es) (Object, Anchors)
 -> Eff es (Object, Anchors))
-> (Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
    -> Eff (Error ParseError : es) (Object, Anchors))
-> Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
-> Eff es (Object, Anchors)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
-> Eff (Error ParseError : es) (Object, Anchors)
forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error YamlError : es) a -> Eff es a
runYamlError (Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
 -> Eff es (Object, Anchors))
-> Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
-> Eff es (Object, Anchors)
forall a b. (a -> b) -> a -> b
$ do
    [BlockData]
-> Eff
     (Reader [BlockData] : Error YamlError : Error ParseError : es)
     (Object, Anchors)
-> Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
forall r (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
r -> Eff (Reader r : es) a -> Eff es a
runReader [BlockData]
blocks (Eff
   (Reader [BlockData] : Error YamlError : Error ParseError : es)
   (Object, Anchors)
 -> Eff (Error YamlError : Error ParseError : es) (Object, Anchors))
-> (ConduitT
      ()
      Void
      (Eff
         (Resource
            : State Anchors : Reader [BlockData] : Error YamlError
            : Error ParseError : es))
      Object
    -> Eff
         (Reader [BlockData] : Error YamlError : Error ParseError : es)
         (Object, Anchors))
-> ConduitT
     ()
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
-> Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
s -> Eff (State s : es) a -> Eff es (a, s)
runState @Anchors Anchors
forall a. Monoid a => a
mempty (Eff
   (State Anchors
      : Reader [BlockData] : Error YamlError : Error ParseError : es)
   Object
 -> Eff
      (Reader [BlockData] : Error YamlError : Error ParseError : es)
      (Object, Anchors))
-> (ConduitT
      ()
      Void
      (Eff
         (Resource
            : State Anchors : Reader [BlockData] : Error YamlError
            : Error ParseError : es))
      Object
    -> Eff
         (State Anchors
            : Reader [BlockData] : Error YamlError : Error ParseError : es)
         Object)
-> ConduitT
     ()
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
-> Eff
     (Reader [BlockData] : Error YamlError : Error ParseError : es)
     (Object, Anchors)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff
  (Resource
     : State Anchors : Reader [BlockData] : Error YamlError
     : Error ParseError : es)
  Object
-> Eff
     (State Anchors
        : Reader [BlockData] : Error YamlError : Error ParseError : es)
     Object
forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es) =>
Eff (Resource : es) a -> Eff es a
runResource (Eff
   (Resource
      : State Anchors : Reader [BlockData] : Error YamlError
      : Error ParseError : es)
   Object
 -> Eff
      (State Anchors
         : Reader [BlockData] : Error YamlError : Error ParseError : es)
      Object)
-> (ConduitT
      ()
      Void
      (Eff
         (Resource
            : State Anchors : Reader [BlockData] : Error YamlError
            : Error ParseError : es))
      Object
    -> Eff
         (Resource
            : State Anchors : Reader [BlockData] : Error YamlError
            : Error ParseError : es)
         Object)
-> ConduitT
     ()
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
-> Eff
     (State Anchors
        : Reader [BlockData] : Error YamlError : Error ParseError : es)
     Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT
  ()
  Void
  (Eff
     (Resource
        : State Anchors : Reader [BlockData] : Error YamlError
        : Error ParseError : es))
  Object
-> Eff
     (Resource
        : State Anchors : Reader [BlockData] : Error YamlError
        : Error ParseError : es)
     Object
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT
   ()
   Void
   (Eff
      (Resource
         : State Anchors : Reader [BlockData] : Error YamlError
         : Error ParseError : es))
   Object
 -> Eff (Error YamlError : Error ParseError : es) (Object, Anchors))
-> ConduitT
     ()
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
-> Eff (Error YamlError : Error ParseError : es) (Object, Anchors)
forall a b. (a -> b) -> a -> b
$ ByteString
-> ConduitM
     ()
     Event
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     ()
forall (m :: * -> *) i.
MonadResource m =>
ByteString -> ConduitM i Event m ()
Yaml.decode ByteString
inp ConduitM
  ()
  Event
  (Eff
     (Resource
        : State Anchors : Reader [BlockData] : Error YamlError
        : Error ParseError : es))
  ()
-> ConduitT
     Event
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
-> ConduitT
     ()
     Void
     (Eff
        (Resource
           : State Anchors : Reader [BlockData] : Error YamlError
           : Error ParseError : es))
     Object
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
     (Resource
        : State Anchors : Reader [BlockData] : Error YamlError
        : Error ParseError : es))
  Object
forall (es :: [(* -> *) -> * -> *]) o.
(Error YamlError :> es, State Anchors :> es,
 Reader [BlockData] :> es) =>
ConduitT Event o (Eff es) Object
sinkTree


decodeBlock :: (Error AsdfError :> es) => Encoded Block -> Eff es BlockData
decodeBlock :: forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es) =>
Encoded Block -> Eff es BlockData
decodeBlock (Encoded ByteString
blk) = do
  case Get BlockData
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, BlockData)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
runGetOrFail Get BlockData
getBlock (ByteString -> ByteString
BL.fromStrict ByteString
blk) of
    Left (ByteString
_, ByteOffset
num, String
err) -> AsdfError -> Eff es BlockData
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (AsdfError -> Eff es BlockData) -> AsdfError -> Eff es BlockData
forall a b. (a -> b) -> a -> b
$ String -> AsdfError
BlockError (String -> AsdfError) -> String -> AsdfError
forall a b. (a -> b) -> a -> b
$ String
"at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteOffset -> String
forall a. Show a => a -> String
show ByteOffset
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
    Right (ByteString
"", ByteOffset
_, BlockData
b) -> BlockData -> Eff es BlockData
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure BlockData
b
    Right (ByteString
rest, ByteOffset
_, BlockData
_) -> AsdfError -> Eff es BlockData
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (AsdfError -> Eff es BlockData) -> AsdfError -> Eff es BlockData
forall a b. (a -> b) -> a -> b
$ String -> AsdfError
BlockError (String -> AsdfError) -> String -> AsdfError
forall a b. (a -> b) -> a -> b
$ String
"Unused bytes: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
rest


-- | Decode the BlockIndex
decodeBlockIndex :: (Error AsdfError :> es, IOE :> es) => ByteString -> Eff es BlockIndex
decodeBlockIndex :: forall (es :: [(* -> *) -> * -> *]).
(Error AsdfError :> es, IOE :> es) =>
ByteString -> Eff es BlockIndex
decodeBlockIndex ByteString
inp =
  Eff (Error YamlError : es) BlockIndex -> Eff es BlockIndex
forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error YamlError : es) a -> Eff es a
runYamlError (Eff (Error YamlError : es) BlockIndex -> Eff es BlockIndex)
-> (ConduitT
      () Void (Eff (Resource : Error YamlError : es)) BlockIndex
    -> Eff (Error YamlError : es) BlockIndex)
-> ConduitT
     () Void (Eff (Resource : Error YamlError : es)) BlockIndex
-> Eff es BlockIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Eff (Resource : Error YamlError : es) BlockIndex
-> Eff (Error YamlError : es) BlockIndex
forall (es :: [(* -> *) -> * -> *]) a.
(IOE :> es) =>
Eff (Resource : es) a -> Eff es a
runResource (Eff (Resource : Error YamlError : es) BlockIndex
 -> Eff (Error YamlError : es) BlockIndex)
-> (ConduitT
      () Void (Eff (Resource : Error YamlError : es)) BlockIndex
    -> Eff (Resource : Error YamlError : es) BlockIndex)
-> ConduitT
     () Void (Eff (Resource : Error YamlError : es)) BlockIndex
-> Eff (Error YamlError : es) BlockIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (Eff (Resource : Error YamlError : es)) BlockIndex
-> Eff (Resource : Error YamlError : es) BlockIndex
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT
   () Void (Eff (Resource : Error YamlError : es)) BlockIndex
 -> Eff es BlockIndex)
-> ConduitT
     () Void (Eff (Resource : Error YamlError : es)) BlockIndex
-> Eff es BlockIndex
forall a b. (a -> b) -> a -> b
$ ByteString
-> ConduitM () Event (Eff (Resource : Error YamlError : es)) ()
forall (m :: * -> *) i.
MonadResource m =>
ByteString -> ConduitM i Event m ()
Yaml.decode ByteString
inp ConduitM () Event (Eff (Resource : Error YamlError : es)) ()
-> ConduitT
     Event Void (Eff (Resource : Error YamlError : es)) BlockIndex
-> ConduitT
     () Void (Eff (Resource : Error YamlError : es)) BlockIndex
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 (Resource : Error YamlError : es)) BlockIndex
forall (es :: [(* -> *) -> * -> *]) o.
(Error YamlError :> es) =>
ConduitT Event o (Eff es) BlockIndex
sinkIndex


runYamlError :: (Error AsdfError :> es) => Eff (Error YamlError : es) a -> Eff es a
runYamlError :: forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error YamlError : es) a -> Eff es a
runYamlError = forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorNoCallStackWith @YamlError (AsdfError -> Eff es a
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (AsdfError -> Eff es a)
-> (YamlError -> AsdfError) -> YamlError -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AsdfError
YamlError (String -> AsdfError)
-> (YamlError -> String) -> YamlError -> AsdfError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. YamlError -> String
forall a. Show a => a -> String
show)


runParseError :: (Error AsdfError :> es) => Eff (Error ParseError : es) a -> Eff es a
runParseError :: forall (es :: [(* -> *) -> * -> *]) a.
(Error AsdfError :> es) =>
Eff (Error ParseError : es) a -> Eff es a
runParseError = forall e (es :: [(* -> *) -> * -> *]) a.
HasCallStack =>
(e -> Eff es a) -> Eff (Error e : es) a -> Eff es a
runErrorNoCallStackWith @ParseError (AsdfError -> Eff es a
forall e (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, Error e :> es, Show e) =>
e -> Eff es a
throwError (AsdfError -> Eff es a)
-> (ParseError -> AsdfError) -> ParseError -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> AsdfError
ParseError (String -> AsdfError)
-> (ParseError -> String) -> ParseError -> AsdfError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show)