-- |
--
-- Module      : Raaz.Core.Parse
-- Description : Applicative parsing from buffers.
-- 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
       ( Parser, parseWidth, parseError, runParser
       , parse, parseStorable
       , parseVector, parseStorableVector
       , parseByteString
       , skip
       ) where

import           Data.ByteString           (ByteString)
import           Data.Vector.Generic       (Vector)
import           Foreign.Storable          (Storable, peek)
import           System.IO.Unsafe          (unsafePerformIO)

import           Raaz.Core.Parse.Unsafe
import           Raaz.Core.Prelude
import           Raaz.Core.Types.Endian
import           Raaz.Core.Types.Pointer
import           Raaz.Core.Util.ByteString (createFrom, length, withByteString)

-- | Skip over some data.
skip :: LengthUnit u => u -> Parser ()
skip :: u -> Parser ()
skip = (u -> (Ptr Word8 -> IO ()) -> Parser ())
-> (Ptr Word8 -> IO ()) -> u -> Parser ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip u -> (Ptr Word8 -> IO ()) -> Parser ()
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser Ptr Word8 -> IO ()
forall b. b -> IO ()
doNothing
  where doNothing :: b -> IO ()
doNothing = IO () -> b -> IO ()
forall a b. a -> b -> a
const (IO () -> b -> IO ()) -> IO () -> b -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | A parser that fails with a given error message.
parseError  :: String -> Parser a
parseError :: String -> Parser a
parseError String
msg = BYTES Int -> (Ptr Word8 -> IO a) -> Parser a
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser (BYTES Int
0 :: BYTES Int) ((Ptr Word8 -> IO a) -> Parser a)
-> (Ptr Word8 -> IO a) -> Parser a
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
_ -> String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg

-- | Runs a parser on a byte string. It returns `Nothing` if the byte string is smaller than
-- what the parser would consume.
runParser :: Parser a -> ByteString -> Maybe a
runParser :: Parser a -> ByteString -> Maybe a
runParser Parser a
pr ByteString
bs
  | ByteString -> BYTES Int
length ByteString
bs BYTES Int -> BYTES Int -> Bool
forall a. Ord a => a -> a -> Bool
< Parser a -> BYTES Int
forall a. Parser a -> BYTES Int
parseWidth Parser a
pr = Maybe a
forall a. Maybe a
Nothing
  | Bool
otherwise                 = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ ByteString -> (Ptr Any -> IO a) -> IO a
forall something a. ByteString -> (Ptr something -> IO a) -> IO a
withByteString ByteString
bs ((Ptr Any -> IO a) -> IO a) -> (Ptr Any -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ Parser a -> Ptr Any -> IO a
forall (ptr :: * -> *) a b.
Pointer ptr =>
Parser a -> ptr b -> IO a
unsafeRunParser Parser a
pr

-- | The primary purpose of this function is to satisfy type checkers.
parserToProxy   :: Parser a -> Proxy a
parserToProxy :: Parser a -> Proxy a
parserToProxy Parser a
_ = Proxy a
forall k (t :: k). Proxy t
Proxy

-- | Parses a value which is an instance of Storable. Beware that this
-- parser expects that the value is stored in machine endian. Mostly
-- it is useful in defining the `peek` function in a complicated
-- `Storable` instance.
parseStorable :: Storable a => Parser a
parseStorable :: Parser a
parseStorable = Parser a
pa
  where pa :: Parser a
pa = BYTES Int -> (Ptr Word8 -> IO a) -> Parser a
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser (Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Parser a -> Proxy a
forall a. Parser a -> Proxy a
parserToProxy Parser a
pa) (Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> IO a) -> (Ptr Word8 -> Ptr a) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr a
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer)

-- | Parse a crypto value. Endian safety is take into account
-- here. This is what you would need when you parse packets from an
-- external source. You can also use this to define the `load`
-- function in a complicated `EndianStore` instance.
parse :: EndianStore a => Parser a
parse :: Parser a
parse = Parser a
pa
  where pa :: Parser a
pa = BYTES Int -> (Ptr Word8 -> IO a) -> Parser a
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser (Proxy a -> BYTES Int
forall a. Storable a => Proxy a -> BYTES Int
sizeOf (Proxy a -> BYTES Int) -> Proxy a -> BYTES Int
forall a b. (a -> b) -> a -> b
$ Parser a -> Proxy a
forall a. Parser a -> Proxy a
parserToProxy Parser a
pa) (Ptr a -> IO a
forall w. EndianStore w => Ptr w -> IO w
load (Ptr a -> IO a) -> (Ptr Word8 -> Ptr a) -> Ptr Word8 -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr a
forall (ptr :: * -> *) a b. Pointer ptr => ptr a -> ptr b
castPointer)

-- | Parses a strict bytestring of a given length.
parseByteString :: LengthUnit l => l -> Parser ByteString
parseByteString :: l -> Parser ByteString
parseByteString l
l = l -> (Ptr Word8 -> IO ByteString) -> Parser ByteString
forall l a. LengthUnit l => l -> (Ptr Word8 -> IO a) -> Parser a
unsafeMakeParser l
l ((Ptr Word8 -> IO ByteString) -> Parser ByteString)
-> (Ptr Word8 -> IO ByteString) -> Parser ByteString
forall a b. (a -> b) -> a -> b
$ l -> Ptr Word8 -> IO ByteString
forall l a. LengthUnit l => l -> Ptr a -> IO ByteString
createFrom l
l

-- | Similar to `parseVector` but parses according to the host
-- endian. This function is essentially used to define storable
-- instances of complicated data. It is unlikely to be of use when
-- parsing externally serialised data as one would want to keep track
-- of the endianness of the data.
parseStorableVector :: (Storable a, Vector v a) => Int -> Parser (v a)
parseStorableVector :: Int -> Parser (v a)
parseStorableVector Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0      = String -> Parser (v a)
forall a. String -> Parser a
parseError (String -> Parser (v a)) -> String -> Parser (v a)
forall a b. (a -> b) -> a -> b
$ String
"parseStorableVector on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
                      | Bool
otherwise  = Int -> Parser (v a)
forall a (v :: * -> *).
(Storable a, Vector v a) =>
Int -> Parser (v a)
unsafeParseStorableVector Int
n

-- | Parses a vector of elements. It takes care of the correct endian
-- conversion. This is the function to use while parsing external
-- data.
parseVector :: (EndianStore a, Vector v a) => Int -> Parser (v a)
parseVector :: Int -> Parser (v a)
parseVector Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0      = String -> Parser (v a)
forall a. String -> Parser a
parseError (String -> Parser (v a)) -> String -> Parser (v a)
forall a b. (a -> b) -> a -> b
$ String
"parseVector on " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
              | Bool
otherwise  = Int -> Parser (v a)
forall a (v :: * -> *).
(EndianStore a, Vector v a) =>
Int -> Parser (v a)
unsafeParseVector Int
n