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

import           Control.Exception        (Exception, try)
import qualified Data.ByteString          as B
import qualified Data.ByteString.Internal as BS
import           Flat.Decoder.Prim        (dBool)
import           Flat.Decoder.Types       (DecodeException, Get (runGet),
                                           GetResult (..), S (S), tooMuchSpace)
import           Foreign                  (Ptr, plusPtr, withForeignPtr)
import           ListT                    (ListT (..))
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=
  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 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' forall a. Eq a => a -> a -> Bool
/= Ptr Word8
endPtr Bool -> Bool -> Bool
|| Int
o' forall a. Eq a => a -> a -> Bool
/= Int
0
      then forall a. Ptr Word8 -> S -> IO a
tooMuchSpace Ptr Word8
endPtr S
s'
      else 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 =
  forall a. IO a -> a
unsafePerformIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e a. Exception e => IO a -> IO (Either e a)
try forall a b. (a -> b) -> a -> b
$
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
base forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base0 ->
    let ptr :: Ptr b
ptr = Ptr Word8
base0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
        endPtr :: Ptr b
endPtr = forall {b}. Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
     in do GetResult a1
res <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a1
get forall {b}. Ptr b
endPtr (Ptr Word8 -> Int -> S
S forall {b}. Ptr b
ptr Int
usedBits)
           GetResult a1 -> Ptr b -> IO a
check GetResult a1
res 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) =
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
base forall a b. (a -> b) -> a -> b
$ \Ptr Word8
base0 -> do
        let ptr :: Ptr b
ptr = Ptr Word8
base0 forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
off
            endPtr :: Ptr b
endPtr = forall {b}. Ptr b
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len
            s :: S
s = Ptr Word8 -> Int -> S
S forall {b}. Ptr b
ptr Int
0
            go :: S -> IO (Maybe (a, ListT IO a))
go S
s = do
                GetResult S
s' Bool
b <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get Bool
dBool forall {b}. Ptr b
endPtr S
s
                if Bool
b
                    then do
                        GetResult S
s'' a
a <- forall a. Get a -> Ptr Word8 -> S -> IO (GetResult a)
runGet Get a
get forall {b}. Ptr b
endPtr S
s'
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (a
a, forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ S -> IO (Maybe (a, ListT IO a))
go S
s'')
                    else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (S -> IO (Maybe (a, ListT IO a))
go S
s)