module Raaz.Core.Parse.Applicative
( Parser, parseWidth, parseError
, unsafeRunParser
, parse, parseStorable
, parseVector, parseStorableVector
, unsafeParseVector, unsafeParseStorableVector
, parseByteString
) where
import Data.ByteString (ByteString)
import Data.Monoid (Sum(..))
import Data.Vector.Generic (Vector, generateM)
import Foreign.Ptr (castPtr)
import Foreign.Storable (Storable, peek, peekElemOff)
import Raaz.Core.MonoidalAction
import Raaz.Core.Types.Endian
import Raaz.Core.Types.Pointer
import Raaz.Core.Util.ByteString (createFrom)
type BytesMonoid = Sum (BYTES Int)
type ParseAction = FieldM IO Pointer
type Parser = TwistRF ParseAction BytesMonoid
makeParser :: LengthUnit l => l -> (Pointer -> IO a) -> Parser a
makeParser l action = TwistRF (liftToFieldM action) (Sum $ inBytes l)
parseError :: String -> Parser a
parseError msg = makeParser (0 :: BYTES Int) $ \ _ -> fail msg
parseWidth :: Parser a -> BYTES Int
parseWidth = getSum . twistMonoidValue
unsafeRunParser :: Parser a -> Pointer -> IO a
unsafeRunParser = runFieldM . twistFunctorValue
undefParse :: Parser a -> a
undefParse _ = undefined
parseStorable :: Storable a => Parser a
parseStorable = pa
where pa = makeParser (byteSize $ undefParse pa) (peek . castPtr)
parse :: EndianStore a => Parser a
parse = pa
where pa = makeParser (byteSize $ undefParse pa) load
parseByteString :: LengthUnit l => l -> Parser ByteString
parseByteString l = makeParser l $ createFrom l
unsafeParseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a)
unsafeParseStorableVector n = pvec
where pvec = makeParser width $ \ cptr -> generateM n (getA cptr)
width = fromIntegral n * byteSize (undefA pvec)
undefA :: (Storable a, Vector v a)=> Parser (v a) -> a
undefA _ = undefined
getA = peekElemOff . castPtr
unsafeParseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a)
unsafeParseVector n = pvec
where pvec = makeParser width $ \ cptr -> generateM n (loadFromIndex cptr)
width = fromIntegral n * byteSize (undefA pvec)
undefA :: (EndianStore a, Vector v a)=> Parser (v a) -> a
undefA _ = undefined
parseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a)
parseStorableVector n | n < 0 = parseError $ "parseStorableVector on " ++ show n
| otherwise = unsafeParseStorableVector n
parseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a)
parseVector n | n < 0 = parseError $ "parseVector on " ++ show n
| otherwise = unsafeParseVector n