module PlutusCore.Flat.Decoder.Run(strictDecoder,listTDecoder) where

import Control.Exception (Exception, try)
import Data.ByteString qualified as B
import Data.ByteString.Internal qualified as BS
import Foreign (Ptr, plusPtr, withForeignPtr)
import ListT (ListT (..))
import PlutusCore.Flat.Decoder.Prim (dBool)
import PlutusCore.Flat.Decoder.Types (DecodeException, Get (runGet), GetResult (..), S (S),
                                      tooMuchSpace)
import System.IO.Unsafe (unsafePerformIO)

-- | Given a decoder and an input buffer returns either the decoded value or an error (if the input buffer is not fully consumed)
strictDecoder :: Get a -> B.ByteString -> Int -> Either DecodeException a
strictDecoder :: forall a. Get a -> ByteString -> Int -> Either DecodeException a
strictDecoder Get a
get ByteString
bs Int
usedBits=
  Get a
-> ByteString
-> Int
-> (GetResult a -> Ptr Word8 -> IO a)
-> Either DecodeException a
forall e a1 b a.
Exception e =>
Get a1
-> ByteString
-> Int
-> (GetResult a1 -> Ptr b -> IO a)
-> Either e a
strictDecoder_ Get a
get ByteString
bs Int
usedBits ((GetResult a -> Ptr Word8 -> IO a) -> Either DecodeException a)
-> (GetResult a -> Ptr Word8 -> IO a) -> Either DecodeException a
forall a b. (a -> b) -> a -> b
$ \(GetResult s' :: S
s'@(S Ptr Word8
ptr' Int
o') a
a) Ptr Word8
endPtr ->
    if Ptr Word8
ptr' Ptr Word8 -> Ptr Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Word8
endPtr Bool -> Bool -> Bool
|| Int
o' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
      then Ptr Word8 -> S -> IO a
forall a. Ptr Word8 -> S -> IO a
tooMuchSpace Ptr Word8
endPtr S
s'
      else a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

strictDecoder_ ::
     Exception e
  => Get a1
  -> BS.ByteString
  -> Int
  -> (GetResult a1 -> Ptr b -> IO a)
  -> Either e a
strictDecoder_ :: forall e a1 b a.
Exception e =>
Get a1
-> ByteString
-> Int
-> (GetResult a1 -> Ptr b -> IO a)
-> Either e a
strictDecoder_ Get a1
get (BS.PS ForeignPtr Word8
base Int
off Int
len) Int
usedBits GetResult a1 -> Ptr b -> IO a
check =
  IO (Either e a) -> Either e a
forall a. IO a -> a
unsafePerformIO (IO (Either e a) -> Either e a)
-> (IO a -> IO (Either e a)) -> IO a -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO a -> Either e a) -> IO a -> Either e a
forall a b. (a -> b) -> a -> b
$
  ForeignPtr Word8 -> (Ptr Word8 -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
base ((Ptr Word8 -> IO a) -> IO a) -> (Ptr Word8 -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base0 ->
    let ptr :: Ptr b
ptr = Ptr Word8
base0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
        endPtr :: Ptr b
endPtr = Ptr Any
forall {b}. Ptr b
ptr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
     in do GetResult a1
res <- Get a1 -> Ptr Word8 -> S -> IO (GetResult a1)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a1
get Ptr Word8
forall {b}. Ptr b
endPtr (Ptr Word8 -> Int -> S
S Ptr Word8
forall {b}. Ptr b
ptr Int
usedBits)
           GetResult a1 -> Ptr b -> IO a
check GetResult a1
res Ptr b
forall {b}. Ptr b
endPtr
{-# NOINLINE strictDecoder_ #-}


-- strictRawDecoder :: Exception e => Get t -> B.ByteString -> Either e (t,B.ByteString, NumBits)
-- strictRawDecoder get (BS.PS base off len) = unsafePerformIO . try $
--   withForeignPtr base $ \base0 ->
--     let ptr = base0 `plusPtr` off
--         endPtr = ptr `plusPtr` len
--     in do
--       GetResult (S ptr' o') a <- runGet get endPtr (S ptr 0)
--       return (a, BS.PS base (ptr' `minusPtr` base0) (endPtr `minusPtr` ptr'), o')

{-|
Decode a list of values, one value at a time.

Useful in case that the decoded values takes a lot more memory than the encoded ones.

See <../test/Big.hs> for a test and an example of use.

See also "Flat.AsBin".

@since 0.5
-}
listTDecoder :: Get a -> BS.ByteString -> IO (ListT IO a)
listTDecoder :: forall a. Get a -> ByteString -> IO (ListT IO a)
listTDecoder Get a
get (BS.PS ForeignPtr Word8
base Int
off Int
len) =
    ForeignPtr Word8
-> (Ptr Word8 -> IO (ListT IO a)) -> IO (ListT IO a)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
base ((Ptr Word8 -> IO (ListT IO a)) -> IO (ListT IO a))
-> (Ptr Word8 -> IO (ListT IO a)) -> IO (ListT IO a)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base0 -> do
        let ptr :: Ptr b
ptr = Ptr Word8
base0 Ptr Word8 -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
            endPtr :: Ptr b
endPtr = Ptr Any
forall {b}. Ptr b
ptr Ptr Any -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
            s :: S
s = Ptr Word8 -> Int -> S
S Ptr Word8
forall {b}. Ptr b
ptr Int
0
            go :: S -> IO (Maybe (a, ListT IO a))
go S
s = do
                GetResult S
s' Bool
b <- Get Bool -> Ptr Word8 -> S -> IO (GetResult Bool)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get Bool
dBool Ptr Word8
forall {b}. Ptr b
endPtr S
s
                if Bool
b
                    then do
                        GetResult S
s'' a
a <- Get a -> Ptr Word8 -> S -> IO (GetResult a)
forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
get Ptr Word8
forall {b}. Ptr b
endPtr S
s'
                        Maybe (a, ListT IO a) -> IO (Maybe (a, ListT IO a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, ListT IO a) -> IO (Maybe (a, ListT IO a)))
-> Maybe (a, ListT IO a) -> IO (Maybe (a, ListT IO a))
forall a b. (a -> b) -> a -> b
$ (a, ListT IO a) -> Maybe (a, ListT IO a)
forall a. a -> Maybe a
Just (a
a, IO (Maybe (a, ListT IO a)) -> ListT IO a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (IO (Maybe (a, ListT IO a)) -> ListT IO a)
-> IO (Maybe (a, ListT IO a)) -> ListT IO a
forall a b. (a -> b) -> a -> b
$ S -> IO (Maybe (a, ListT IO a))
go S
s'')
                    else Maybe (a, ListT IO a) -> IO (Maybe (a, ListT IO a))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, ListT IO a)
forall a. Maybe a
Nothing
        ListT IO a -> IO (ListT IO a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ListT IO a -> IO (ListT IO a)) -> ListT IO a -> IO (ListT IO a)
forall a b. (a -> b) -> a -> b
$ IO (Maybe (a, ListT IO a)) -> ListT IO a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (S -> IO (Maybe (a, ListT IO a))
go S
s)