-- |
-- Module      : Streamly.Internal.Data.Binary.Decode
-- Copyright   : (c) 2020 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : pre-release
-- Portability : GHC
--
-- Parsers for binary encoded basic Haskell data types.

module Streamly.Internal.Data.Binary.Decode
    ( unit
    , bool
    , ordering
    , eqWord8
    , word8
    , word16be
    , word16le
    , word32be
    , word32le
    , word64be
    , word64le
    , word64host
    )
where

import Control.Monad.Catch (MonadCatch, throwM)
import Control.Monad.IO.Class (MonadIO)
import Data.Bits ((.|.), unsafeShiftL)
import Data.Word (Word8, Word16, Word32, Word64)
import Streamly.Internal.Data.Parser (Parser)
import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))

import qualified Streamly.Internal.Data.Array.Foreign as A
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser.ParserD as PRD
import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK

-- | A value of type '()' is encoded as @0@ in binary encoding.
--
-- @
-- 0 ==> ()
-- @
--
-- /Pre-release/
--
{-# INLINE unit #-}
unit :: MonadCatch m => Parser m Word8 ()
unit :: forall (m :: * -> *). MonadCatch m => Parser m Word8 ()
unit = forall (m :: * -> *). MonadCatch m => Word8 -> Parser m Word8 Word8
eqWord8 Word8
0 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) b a. MonadCatch m => b -> Parser m a b
PR.fromPure ()

{-# INLINE word8ToBool #-}
word8ToBool :: Word8 -> Either String Bool
word8ToBool :: Word8 -> Either String Bool
word8ToBool Word8
0 = forall a b. b -> Either a b
Right Bool
False
word8ToBool Word8
1 = forall a b. b -> Either a b
Right Bool
True
word8ToBool Word8
w = forall a b. a -> Either a b
Left (String
"Invalid Bool encoding " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
Prelude.show Word8
w)

-- | A value of type 'Bool' is encoded as follows in binary encoding.
--
-- @
-- 0 ==> False
-- 1 ==> True
-- @
--
-- /Pre-release/
--
{-# INLINE bool #-}
bool :: MonadCatch m => Parser m Word8 Bool
bool :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Bool
bool = forall (m :: * -> *) a b.
MonadCatch m =>
(a -> Either String b) -> Parser m a b
PR.either Word8 -> Either String Bool
word8ToBool

{-# INLINE word8ToOrdering #-}
word8ToOrdering :: Word8 -> Either String Ordering
word8ToOrdering :: Word8 -> Either String Ordering
word8ToOrdering Word8
0 = forall a b. b -> Either a b
Right Ordering
LT
word8ToOrdering Word8
1 = forall a b. b -> Either a b
Right Ordering
EQ
word8ToOrdering Word8
2 = forall a b. b -> Either a b
Right Ordering
GT
word8ToOrdering Word8
w = forall a b. a -> Either a b
Left (String
"Invalid Ordering encoding " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
Prelude.show Word8
w)

-- | A value of type 'Ordering' is encoded as follows in binary encoding.
--
-- @
-- 0 ==> LT
-- 1 ==> EQ
-- 2 ==> GT
-- @
--
-- /Pre-release/
--
{-# INLINE ordering #-}
ordering :: MonadCatch m => Parser m Word8 Ordering
ordering :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Ordering
ordering = forall (m :: * -> *) a b.
MonadCatch m =>
(a -> Either String b) -> Parser m a b
PR.either Word8 -> Either String Ordering
word8ToOrdering

-- XXX should go in a Word8 parser module?
-- | Accept the input byte only if it is equal to the specified value.
--
-- /Pre-release/
--
{-# INLINE eqWord8 #-}
eqWord8 :: MonadCatch m => Word8 -> Parser m Word8 Word8
eqWord8 :: forall (m :: * -> *). MonadCatch m => Word8 -> Parser m Word8 Word8
eqWord8 Word8
b = forall (m :: * -> *) a. MonadCatch m => (a -> Bool) -> Parser m a a
PR.satisfy (forall a. Eq a => a -> a -> Bool
== Word8
b)

-- | Accept any byte.
--
-- /Pre-release/
--
{-# INLINE word8 #-}
word8 :: MonadCatch m => Parser m Word8 Word8
word8 :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word8
word8 = forall (m :: * -> *) a. MonadCatch m => (a -> Bool) -> Parser m a a
PR.satisfy (forall a b. a -> b -> a
const Bool
True)

-- | Big endian (MSB first) Word16
{-# INLINE word16beD #-}
word16beD :: MonadCatch m => PRD.Parser m Word8 Word16
word16beD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16beD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {a} {a} {b}.
(Monad m, Integral a, Bits a, Bits b, Num a, Num b) =>
Maybe' b -> a -> m (Step (Maybe' a) b)
step forall {a} {b}. m (Initial (Maybe' a) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Maybe' a) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a. Maybe' a
Nothing'

    step :: Maybe' b -> a -> m (Step (Maybe' a) b)
step Maybe' b
Nothing' a
a =
        -- XXX We can use a non-failing parser or a fold so that we do not
        -- have to buffer for backtracking which is inefficient.
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a. a -> Maybe' a
Just' (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8))
    step (Just' b
w) a
a =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> b -> Step s b
PRD.Done Int
0 (b
w forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word16be: end of input"

-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and
-- second byte is the LSB (big endian representation).
--
-- /Pre-release/
--
{-# INLINE word16be #-}
word16be :: MonadCatch m => Parser m Word8 Word16
word16be :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16be = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16beD

-- | Little endian (LSB first) Word16
{-# INLINE word16leD #-}
word16leD :: MonadCatch m => PRD.Parser m Word8 Word16
word16leD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16leD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {a} {b} {a}.
(Monad m, Integral a, Bits b, Num a, Num b) =>
Maybe' b -> a -> m (Step (Maybe' a) b)
step forall {a} {b}. m (Initial (Maybe' a) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Maybe' a) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a. Maybe' a
Nothing'

    step :: Maybe' b -> a -> m (Step (Maybe' a) b)
step Maybe' b
Nothing' a
a =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a. a -> Maybe' a
Just' (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a))
    step (Just' b
w) a
a =
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. Int -> b -> Step s b
PRD.Done Int
0 (b
w forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
8)

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word16le: end of input"

-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and
-- second byte is the MSB (little endian representation).
--
-- /Pre-release/
--
{-# INLINE word16le #-}
word16le :: MonadCatch m => Parser m Word8 Word16
word16le :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16le = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word16
word16leD

-- | Big endian (MSB first) Word32
{-# INLINE word32beD #-}
word32beD :: MonadCatch m => PRD.Parser m Word8 Word32
word32beD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32beD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {b} {a}.
(Monad m, Bits b, Integral a, Num b) =>
Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step forall {b}. m (Initial (Tuple' Word32 Int) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Tuple' Word32 Int) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Word32
0 Int
24

    step :: Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step (Tuple' b
w Int
sh) a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if Int
sh forall a. Eq a => a -> a -> Bool
/= Int
0
        then
            let w1 :: b
w1 = b
w forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)
             in forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a b. a -> b -> Tuple' a b
Tuple' b
w1 (Int
sh forall a. Num a => a -> a -> a
- Int
8))
        else forall s b. Int -> b -> Step s b
PRD.Done Int
0 (b
w forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word32beD: end of input"

-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
-- and last byte is the LSB (big endian representation).
--
-- /Pre-release/
--
{-# INLINE word32be #-}
word32be :: MonadCatch m => Parser m Word8 Word32
word32be :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32be = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32beD

-- | Little endian (LSB first) Word32
{-# INLINE word32leD #-}
word32leD :: MonadCatch m => PRD.Parser m Word8 Word32
word32leD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32leD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {b} {a}.
(Monad m, Bits b, Integral a, Num b) =>
Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step forall {b}. m (Initial (Tuple' Word32 Int) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Tuple' Word32 Int) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Word32
0 Int
0

    step :: Tuple' b Int -> p -> m (Step (Tuple' b Int) b)
step (Tuple' b
w Int
sh) p
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        let w1 :: b
w1 = b
w forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral p
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)
         in if Int
sh forall a. Eq a => a -> a -> Bool
/= Int
24
            then forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a b. a -> b -> Tuple' a b
Tuple' b
w1 (Int
sh forall a. Num a => a -> a -> a
+ Int
8))
            else forall s b. Int -> b -> Step s b
PRD.Done Int
0 b
w1

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word32leD: end of input"

-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32
-- and last byte is the LSB (big endian representation).
--
-- /Pre-release/
--
{-# INLINE word32le #-}
word32le :: MonadCatch m => Parser m Word8 Word32
word32le :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32le = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word32
word32leD

-- | Big endian (MSB first) Word64
{-# INLINE word64beD #-}
word64beD :: MonadCatch m => PRD.Parser m Word8 Word64
word64beD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64beD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {b} {a}.
(Monad m, Bits b, Integral a, Num b) =>
Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step forall {b}. m (Initial (Tuple' Word64 Int) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Tuple' Word64 Int) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Word64
0 Int
56

    step :: Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step (Tuple' b
w Int
sh) a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        if Int
sh forall a. Eq a => a -> a -> Bool
/= Int
0
        then
            let w1 :: b
w1 = b
w forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)
             in forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a b. a -> b -> Tuple' a b
Tuple' b
w1 (Int
sh forall a. Num a => a -> a -> a
- Int
8))
        else forall s b. Int -> b -> Step s b
PRD.Done Int
0 (b
w forall a. Bits a => a -> a -> a
.|. forall a b. (Integral a, Num b) => a -> b
fromIntegral a
a)

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word64beD: end of input"

-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
-- and last byte is the LSB (big endian representation).
--
-- /Pre-release/
--
{-# INLINE word64be #-}
word64be :: MonadCatch m => Parser m Word8 Word64
word64be :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64be = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64beD

-- | Little endian (LSB first) Word64
{-# INLINE word64leD #-}
word64leD :: MonadCatch m => PRD.Parser m Word8 Word64
word64leD :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64leD = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Initial s b) -> (s -> m b) -> Parser m a b
PRD.Parser forall {m :: * -> *} {b} {a}.
(Monad m, Bits b, Integral a, Num b) =>
Tuple' b Int -> a -> m (Step (Tuple' b Int) b)
step forall {b}. m (Initial (Tuple' Word64 Int) b)
initial forall {m :: * -> *} {p} {a}. MonadThrow m => p -> m a
extract

    where

    initial :: m (Initial (Tuple' Word64 Int) b)
initial = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Initial s b
PRD.IPartial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' Word64
0 Int
0

    step :: Tuple' b Int -> p -> m (Step (Tuple' b Int) b)
step (Tuple' b
w Int
sh) p
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        let w1 :: b
w1 = b
w forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral p
a forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
sh)
         in if Int
sh forall a. Eq a => a -> a -> Bool
/= Int
56
            then forall s b. Int -> s -> Step s b
PRD.Continue Int
0 (forall a b. a -> b -> Tuple' a b
Tuple' b
w1 (Int
sh forall a. Num a => a -> a -> a
+ Int
8))
            else forall s b. Int -> b -> Step s b
PRD.Done Int
0 b
w1

    extract :: p -> m a
extract p
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> ParseError
PRD.ParseError String
"word64leD: end of input"

-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64
-- and last byte is the LSB (big endian representation).
--
-- /Pre-release/
--
{-# INLINE word64le #-}
word64le :: MonadCatch m => Parser m Word8 Word64
word64le :: forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64le = forall (m :: * -> *) a b.
MonadCatch m =>
Parser m a b -> Parser m a b
PRK.toParserK forall (m :: * -> *). MonadCatch m => Parser m Word8 Word64
word64leD

-------------------------------------------------------------------------------
-- Host byte order
-------------------------------------------------------------------------------

-- | Parse eight bytes as a 'Word64' in the host byte order.
--
-- /Pre-release/
--
{-# INLINE word64host #-}
word64host :: (MonadIO m, MonadCatch m) => Parser m Word8 Word64
word64host :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
Parser m Word8 Word64
word64host =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Storable a => Int -> Array a -> a
A.unsafeIndex Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Array a -> Array b
A.unsafeCast) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadCatch m =>
Int -> Fold m a b -> Parser m a b
PR.takeEQ Int
8 (forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m a (Array a)
A.writeN Int
8)