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)