-- |
--
-- Module      : Raaz.Core.Parse.Unsafe
-- Copyright   : (c) Piyush P Kurur, 2019
-- License     : Apache-2.0 OR BSD-3-Clause
-- Maintainer  : Piyush P Kurur <ppk@iitpkd.ac.in>
-- Stability   : experimental
--

module Raaz.Core.Parse.Unsafe
       ( Parser, parseWidth
       , unsafeMakeParser
       , unsafeRunParser
       , unsafeParseVector, unsafeParseStorableVector
       ) where

import           Data.Vector.Generic       (Vector, generateM)
import           Foreign.Storable          (Storable, peekElemOff)
import           Raaz.Core.Prelude
import           Raaz.Core.MonoidalAction
import           Raaz.Core.Types.Endian
import           Raaz.Core.Types.Pointer


type BytesMonoid   = BYTES Int
type ParseAction   = FieldM IO (Ptr Word8)

-- | An applicative parser type for reading data from a pointer.
type Parser = TwistRF ParseAction BytesMonoid

-- | Run the parser without checking the length constraints.
unsafeRunParser :: Pointer ptr
                => Parser a
                -> ptr b
                -> IO a
unsafeRunParser :: Parser a -> ptr b -> IO a
unsafeRunParser Parser a
prsr = (Ptr Word8 -> IO a) -> ptr b -> IO a
forall (ptr :: * -> *) a b something.
Pointer ptr =>
(Ptr a -> b) -> ptr something -> b
unsafeWithPointerCast ((Ptr Word8 -> IO a) -> ptr b -> IO a)
-> (Ptr Word8 -> IO a) -> ptr b -> IO a
forall a b. (a -> b) -> a -> b
$ Parser a -> Ptr Word8 -> IO a
forall (monad :: * -> *) space m b.
TwistRF (WrappedArrow (Kleisli monad) space) m b
-> space -> monad b
runIt Parser a
prsr
  where runIt :: TwistRF (WrappedArrow (Kleisli monad) space) m b
-> space -> monad b
runIt = FieldM monad space b -> space -> monad b
forall (monad :: * -> *) space b.
FieldM monad space b -> space -> monad b
runFieldM (FieldM monad space b -> space -> monad b)
-> (TwistRF (WrappedArrow (Kleisli monad) space) m b
    -> FieldM monad space b)
-> TwistRF (WrappedArrow (Kleisli monad) space) m b
-> space
-> monad b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TwistRF (WrappedArrow (Kleisli monad) space) m b
-> FieldM monad space b
forall (f :: * -> *) m a. TwistRF f m a -> f a
twistFunctorValue

-- | Return the bytes that this parser will read.
parseWidth :: Parser a -> BYTES Int
parseWidth :: Parser a -> BYTES Int
parseWidth =  Parser a -> BYTES Int
forall (f :: * -> *) m a. TwistRF f m a -> m
twistMonoidValue

-- | Make an parser out of its action and the length of the buffer
-- that it acts on.
unsafeMakeParser :: LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser :: l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser l
l Ptr Word8 -> IO a
action = WrappedArrow (Kleisli IO) (Ptr Word8) a -> BYTES Int -> Parser a
forall (f :: * -> *) m a. f a -> m -> TwistRF f m a
TwistRF ((Ptr Word8 -> IO a) -> WrappedArrow (Kleisli IO) (Ptr Word8) a
forall a (m :: * -> *) b. (a -> m b) -> FieldM m a b
liftToFieldM Ptr Word8 -> IO a
action) (BYTES Int -> Parser a) -> BYTES Int -> Parser a
forall a b. (a -> b) -> a -> b
$ l -> BYTES Int
forall u. LengthUnit u => u -> BYTES Int
inBytes l
l

-- | Similar to @unsafeParseVector@ but assumes the elements are
-- encoded in host endian
unsafeParseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a)
unsafeParseStorableVector :: Int -> Parser (v a)
unsafeParseStorableVector Int
n = Parser (v a)
pvec
  where pvec :: Parser (v a)
pvec      = BYTES Int -> (Ptr Word8 -> IO (v a)) -> Parser (v a)
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser  BYTES Int
width ((Ptr Word8 -> IO (v a)) -> Parser (v a))
-> (Ptr Word8 -> IO (v a)) -> Parser (v a)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
cptr -> Int -> (Int -> IO a) -> IO (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> (Int -> m a) -> m (v a)
generateM Int
n (Ptr Word8 -> Int -> IO a
forall a. Ptr a -> Int -> IO a
getA Ptr Word8
cptr)
        width :: BYTES Int
width     = Int -> BYTES Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
* Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Parser (v a) -> Proxy a
forall a (v :: * -> *). Storable a => Parser (v a) -> Proxy a
thisProxy Parser (v a)
pvec)
        getA :: Ptr a -> Int -> IO a
getA      = Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr a -> Int -> IO a) -> (Ptr a -> Ptr a) -> Ptr a -> Int -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr a
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer
        thisProxy    :: Storable a => Parser (v a) -> Proxy a
        thisProxy :: Parser (v a) -> Proxy a
thisProxy Parser (v a)
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

-- | Parse a vector of elements making sure the proper endian
-- conversion is done. It does not check whether the length parameter
-- is non-negative and hence is unsafe. Use it only if you can prove
-- that the length parameter is non-negative.
unsafeParseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a)
unsafeParseVector :: Int -> Parser (v a)
unsafeParseVector Int
n = Parser (v a)
pvec
  where pvec :: Parser (v a)
pvec     = BYTES Int -> (Ptr Word8 -> IO (v a)) -> Parser (v a)
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser  BYTES Int
width ((Ptr Word8 -> IO (v a)) -> Parser (v a))
-> (Ptr Word8 -> IO (v a)) -> Parser (v a)
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
cptr -> Int -> (Int -> IO a) -> IO (v a)
forall (m :: * -> *) (v :: * -> *) a.
(Monad m, Vector v a) =>
Int -> (Int -> m a) -> m (v a)
generateM Int
n (Ptr a -> Int -> IO a
forall w. EndianStore w => Ptr w -> Int -> IO w
loadFromIndex (Ptr Word8 -> Ptr a
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer Ptr Word8
cptr))
        width :: BYTES Int
width    = Int -> BYTES Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
* Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Parser (v a) -> Proxy a
forall a (v :: * -> *). Storable a => Parser (v a) -> Proxy a
thisProxy Parser (v a)
pvec)
        thisProxy    :: Storable a => Parser (v a) -> Proxy a
        thisProxy :: Parser (v a) -> Proxy a
thisProxy Parser (v a)
_ = Proxy a
forall k (t :: k). Proxy t
Proxy