module Data.Repa.Convert.Internal.Unpacker
        ( Unpacker (..)
        , unsafeRunUnpacker)
where
import Data.IORef
import Data.Word
import GHC.Exts
import Prelude hiding (fail)
import qualified Foreign.Ptr            as F


---------------------------------------------------------------------------------------------------
data Unpacker a
  =  Unpacker 
  {  -- | Takes pointers to the first byte in the buffer; the first byte
     --   after the buffer; a predicate to detect a field terminator;
     --   a failure action; and a continuation.
     -- 
     --   The field terminator is used by variable length encodings where
     --   the length of the encoded data cannot be determined from the
     --   encoding itself.
     --
     --   We try to unpack a value from the buffer.
     --   If unpacking succeeds then call the continuation with a pointer
     --   to the next byte after the unpacked value, and the value itself,
     --   otherwise call the failure action.
     --
     forall a.
Unpacker a
-> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fromUnpacker
        :: Addr#                 -- Start of buffer.
        -> Addr#                 -- Pointer to first byte after end of buffer.
        -> (Word8 -> Bool)       -- Detect a field terminator.
        -> IO ()                 -- Signal failure.
        -> (Addr# -> a -> IO ()) -- Accept an unpacked value.
        -> IO ()
  }


instance Functor Unpacker where
 fmap :: forall a b. (a -> b) -> Unpacker a -> Unpacker b
fmap a -> b
f (Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fx)
  =  (Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> b -> IO ())
 -> IO ())
-> Unpacker b
forall a.
(Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> a -> IO ())
 -> IO ())
-> Unpacker a
Unpacker ((Addr#
  -> Addr#
  -> (Word8 -> Bool)
  -> IO ()
  -> (Addr# -> b -> IO ())
  -> IO ())
 -> Unpacker b)
-> (Addr#
    -> Addr#
    -> (Word8 -> Bool)
    -> IO ()
    -> (Addr# -> b -> IO ())
    -> IO ())
-> Unpacker b
forall a b. (a -> b) -> a -> b
$ \Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> b -> IO ()
eat
  -> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fx Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail ((Addr# -> a -> IO ()) -> IO ()) -> (Addr# -> a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_x a
x 
  -> Addr# -> b -> IO ()
eat Addr#
start_x (a -> b
f a
x)
 {-# INLINE fmap #-}


instance Applicative Unpacker where
 pure :: forall a. a -> Unpacker a
pure  a
x
  =  (Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> a -> IO ())
 -> IO ())
-> Unpacker a
forall a.
(Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> a -> IO ())
 -> IO ())
-> Unpacker a
Unpacker ((Addr#
  -> Addr#
  -> (Word8 -> Bool)
  -> IO ()
  -> (Addr# -> a -> IO ())
  -> IO ())
 -> Unpacker a)
-> (Addr#
    -> Addr#
    -> (Word8 -> Bool)
    -> IO ()
    -> (Addr# -> a -> IO ())
    -> IO ())
-> Unpacker a
forall a b. (a -> b) -> a -> b
$ \Addr#
start Addr#
_end Word8 -> Bool
_fail IO ()
_stop Addr# -> a -> IO ()
eat
  -> Addr# -> a -> IO ()
eat Addr#
start a
x
 {-# INLINE pure #-}

 <*> :: forall a b. Unpacker (a -> b) -> Unpacker a -> Unpacker b
(<*>) (Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> (a -> b) -> IO ())
-> IO ()
ff) (Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fx)
  =  (Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> b -> IO ())
 -> IO ())
-> Unpacker b
forall a.
(Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> a -> IO ())
 -> IO ())
-> Unpacker a
Unpacker ((Addr#
  -> Addr#
  -> (Word8 -> Bool)
  -> IO ()
  -> (Addr# -> b -> IO ())
  -> IO ())
 -> Unpacker b)
-> (Addr#
    -> Addr#
    -> (Word8 -> Bool)
    -> IO ()
    -> (Addr# -> b -> IO ())
    -> IO ())
-> Unpacker b
forall a b. (a -> b) -> a -> b
$ \Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> b -> IO ()
eat
  -> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> (a -> b) -> IO ())
-> IO ()
ff Addr#
start   Addr#
end Word8 -> Bool
stop IO ()
fail ((Addr# -> (a -> b) -> IO ()) -> IO ())
-> (Addr# -> (a -> b) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_f a -> b
f
  -> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fx Addr#
start_f Addr#
end Word8 -> Bool
stop IO ()
fail ((Addr# -> a -> IO ()) -> IO ()) -> (Addr# -> a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_x a
x
  -> Addr# -> b -> IO ()
eat Addr#
start_x (a -> b
f a
x)
 {-# INLINE (<*>) #-}


instance Monad Unpacker where
 return :: forall a. a -> Unpacker a
return = a -> Unpacker a
forall a. a -> Unpacker a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
 {-# INLINE return #-}

 >>= :: forall a b. Unpacker a -> (a -> Unpacker b) -> Unpacker b
(>>=) (Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fa) a -> Unpacker b
mkfb
  =  (Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> b -> IO ())
 -> IO ())
-> Unpacker b
forall a.
(Addr#
 -> Addr#
 -> (Word8 -> Bool)
 -> IO ()
 -> (Addr# -> a -> IO ())
 -> IO ())
-> Unpacker a
Unpacker ((Addr#
  -> Addr#
  -> (Word8 -> Bool)
  -> IO ()
  -> (Addr# -> b -> IO ())
  -> IO ())
 -> Unpacker b)
-> (Addr#
    -> Addr#
    -> (Word8 -> Bool)
    -> IO ()
    -> (Addr# -> b -> IO ())
    -> IO ())
-> Unpacker b
forall a b. (a -> b) -> a -> b
$ \Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> b -> IO ()
eat
  -> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
fa Addr#
start Addr#
end Word8 -> Bool
stop IO ()
fail ((Addr# -> a -> IO ()) -> IO ()) -> (Addr# -> a -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Addr#
start_x a
x
  -> case a -> Unpacker b
mkfb a
x of
        Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> b -> IO ())
-> IO ()
fb
         -> Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> b -> IO ())
-> IO ()
fb Addr#
start_x Addr#
end Word8 -> Bool
stop IO ()
fail Addr# -> b -> IO ()
eat
 {-# INLINE (>>=) #-}


-- | Unpack data from the given buffer.
--
--   PRECONDITION: The buffer must be at least the minimum size of the 
--   format (minSize). This allows us to avoid repeatedly checking for 
--   buffer overrun when unpacking fixed size format. If the buffer
--   is not long enough then you'll get an indeterminate result (bad).
--
unsafeRunUnpacker
        :: Unpacker a           -- ^ Unpacker to run.
        -> F.Ptr Word8          -- ^ Source buffer.
        -> Int                  -- ^ Length of source buffer.
        -> (Word8 -> Bool)      -- ^ Detect a field terminator.
        -> IO (Maybe (a, F.Ptr Word8))  
                -- ^ Unpacked result, and pointer to the byte after the last
                --   one read.

unsafeRunUnpacker :: forall a.
Unpacker a
-> Ptr Word8 -> Int -> (Word8 -> Bool) -> IO (Maybe (a, Ptr Word8))
unsafeRunUnpacker (Unpacker Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
f) (Ptr Addr#
start) (I# Int#
len) Word8 -> Bool
stop
 = do   IORef (Maybe (a, Ptr Word8))
ref     <- Maybe (a, Ptr Word8) -> IO (IORef (Maybe (a, Ptr Word8)))
forall a. a -> IO (IORef a)
newIORef Maybe (a, Ptr Word8)
forall a. Maybe a
Nothing
        Addr#
-> Addr#
-> (Word8 -> Bool)
-> IO ()
-> (Addr# -> a -> IO ())
-> IO ()
f       Addr#
start 
                (Addr# -> Int# -> Addr#
plusAddr# Addr#
start Int#
len)
                Word8 -> Bool
stop
                (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                (\Addr#
addr' a
x -> IORef (Maybe (a, Ptr Word8)) -> Maybe (a, Ptr Word8) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe (a, Ptr Word8))
ref ((a, Ptr Word8) -> Maybe (a, Ptr Word8)
forall a. a -> Maybe a
Just (a
x, (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr'))))
        IORef (Maybe (a, Ptr Word8)) -> IO (Maybe (a, Ptr Word8))
forall a. IORef a -> IO a
readIORef IORef (Maybe (a, Ptr Word8))
ref
{-# INLINE unsafeRunUnpacker #-}