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

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

-- | 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 -> Either DecodeException a
strictDecoder :: Get a -> ByteString -> Either DecodeException a
strictDecoder Get a
get ByteString
bs =
  Get a
-> ByteString
-> (GetResult a -> Ptr Word8 -> IO a)
-> Either DecodeException a
forall e a1 b a.
Exception e =>
Get a1
-> ByteString -> (GetResult a1 -> Ptr b -> IO a) -> Either e a
strictDecoder_ Get a
get ByteString
bs ((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 (m :: * -> *) a. Monad m => a -> m a
return a
a

strictDecoder_ ::
     Exception e
  => Get a1
  -> BS.ByteString
  -> (GetResult a1 -> Ptr b -> IO a)
  -> Either e a
strictDecoder_ :: Get a1
-> ByteString -> (GetResult a1 -> Ptr b -> IO a) -> Either e a
strictDecoder_ Get a1
get (BS.PS ForeignPtr Word8
base Int
off Int
len) 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
0)
           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')


listTDecoder :: Get a -> BS.ByteString -> IO (ListT IO a)
listTDecoder :: 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 (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 (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 (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)