{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnboxedTuples #-}

-- |
-- It is recommended to import this module like so:
--
-- @
-- import qualified Data.Packed.Reader as R
-- @
module Data.Packed.Reader (
    PackedReader (..),
    mkPackedReader,
    runReader,

    -- * Applicative
    pure,
    liftA,
    liftA2,
    (<*>),
    (*>),
    (<*),

    -- * Monad
    (>>=),
    (>>),
    fail,
    return,
    lift,

    -- * Application
    with,
    threadedWith,

    -- * Fragments
    PackedFragment (..),
    castPackedFragment,
) where

import Control.Monad.Identity
import Data.Bifunctor
import Data.ByteString.Internal
import Data.Kind
import Data.Packed.Internal
import Data.Packed.Packed
import Data.Packed.Utils ((:++:))
import Foreign hiding (with)
import Prelude hiding (fail, liftA2, pure, return, (*>), (<*), (<*>), (>>), (>>=))
import qualified Prelude

-- | Basically a function that reads/desrialises a value from a 'Data.Packed.Packed'
--
-- 'p' the types of the packed values to read
--
-- 'r' the packed type after the encoded values to read
--
-- 'v' the type of the value to unpack
--
-- __Note:__ It is an indexed monad.
newtype PackedReader p r v = PackedReader
    { forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep :: PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
    }

-- | Represents position of the cursor in the packed buffer to traverse
data PackedFragment (p :: [Type])
    = PF
        -- | Pointer in the packed buffer
        {-# UNPACK #-} !(Ptr Word8)
        -- | Number of bytes between the cursor's position and the end of the buffer
        {-# UNPACK #-} !Int

{-# INLINE castPackedFragment #-}
castPackedFragment :: PackedFragment p -> PackedFragment t
castPackedFragment :: forall (p :: [*]) (t :: [*]). PackedFragment p -> PackedFragment t
castPackedFragment (PF Ptr Word8
p Int
t) = Ptr Word8 -> Int -> PackedFragment t
forall (p :: [*]). Ptr Word8 -> Int -> PackedFragment p
PF Ptr Word8
p Int
t

{-# INLINE mkPackedReader #-}

-- | Builds a 'Data.Packed.Reader.PackedReader'
mkPackedReader ::
    (PackedFragment (p :++: r) -> Identity (v, PackedFragment r)) ->
    PackedReader p r v
mkPackedReader :: forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
mkPackedReader = (PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader

instance Functor (PackedReader p r) where
    {-# INLINE fmap #-}
    fmap :: forall a b. (a -> b) -> PackedReader p r a -> PackedReader p r b
fmap a -> b
f (PackedReader PackedFragment (p :++: r) -> Identity (a, PackedFragment r)
reader) = (PackedFragment (p :++: r) -> Identity (b, PackedFragment r))
-> PackedReader p r b
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment (p :++: r) -> Identity (b, PackedFragment r))
 -> PackedReader p r b)
-> (PackedFragment (p :++: r) -> Identity (b, PackedFragment r))
-> PackedReader p r b
forall a b. (a -> b) -> a -> b
$ ((a, PackedFragment r) -> (b, PackedFragment r))
-> Identity (a, PackedFragment r) -> Identity (b, PackedFragment r)
forall a b. (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a, PackedFragment r) -> (b, PackedFragment r)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> b
f) (Identity (a, PackedFragment r) -> Identity (b, PackedFragment r))
-> (PackedFragment (p :++: r) -> Identity (a, PackedFragment r))
-> PackedFragment (p :++: r)
-> Identity (b, PackedFragment r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackedFragment (p :++: r) -> Identity (a, PackedFragment r)
reader

-------- Applicative

-- | Similar to 'Control.Applicative.pure'
{-# INLINE pure #-}
pure :: v -> PackedReader '[] r v
pure :: forall v (r :: [*]). v -> PackedReader '[] r v
pure = v -> PackedReader '[] r v
forall v (r :: [*]). v -> PackedReader '[] r v
return

-- | Similar to 'Control.Applicative.liftA'
{-# INLINE liftA #-}
liftA :: (a -> b) -> PackedReader p t a -> PackedReader p t b
liftA :: forall a b (p :: [*]) (t :: [*]).
(a -> b) -> PackedReader p t a -> PackedReader p t b
liftA = (a -> b) -> PackedReader p t a -> PackedReader p t b
forall a b. (a -> b) -> PackedReader p t a -> PackedReader p t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | Similar to 'Control.Applicative.liftA2'
{-# INLINE liftA2 #-}
liftA2 ::
    (v1 -> v2 -> v3) ->
    PackedReader p (r1 :++: r2) v1 ->
    PackedReader r1 r2 v2 ->
    PackedReader (p :++: r1) r2 v3
liftA2 :: forall v1 v2 v3 (p :: [*]) (r1 :: [*]) (r2 :: [*]).
(v1 -> v2 -> v3)
-> PackedReader p (r1 :++: r2) v1
-> PackedReader r1 r2 v2
-> PackedReader (p :++: r1) r2 v3
liftA2 v1 -> v2 -> v3
f PackedReader p (r1 :++: r2) v1
m1 PackedReader r1 r2 v2
m2 = (PackedFragment ((p :++: r1) :++: r2)
 -> Identity (v3, PackedFragment r2))
-> PackedReader (p :++: r1) r2 v3
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment ((p :++: r1) :++: r2)
  -> Identity (v3, PackedFragment r2))
 -> PackedReader (p :++: r1) r2 v3)
-> (PackedFragment ((p :++: r1) :++: r2)
    -> Identity (v3, PackedFragment r2))
-> PackedReader (p :++: r1) r2 v3
forall a b. (a -> b) -> a -> b
$ \PackedFragment ((p :++: r1) :++: r2)
pf -> do
    (!v1, !pf1) <- PackedReader p (r1 :++: r2) v1
-> PackedFragment (p :++: (r1 :++: r2))
-> Identity (v1, PackedFragment (r1 :++: r2))
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader p (r1 :++: r2) v1
m1 (PackedFragment ((p :++: r1) :++: r2)
-> PackedFragment (p :++: (r1 :++: r2))
forall (p :: [*]) (t :: [*]). PackedFragment p -> PackedFragment t
castPackedFragment PackedFragment ((p :++: r1) :++: r2)
pf)
    (!v2, !pf2) <- runReaderStep m2 pf1
    Prelude.return (f v1 v2, pf2)

-- | Similar to 'Control.Applicative.<*>'
{-# INLINE (<*>) #-}
(<*>) :: PackedReader p (r1 :++: r2) (v1 -> v2) -> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
<*> :: forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v1 v2.
PackedReader p (r1 :++: r2) (v1 -> v2)
-> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
(<*>) = ((v1 -> v2) -> v1 -> v2)
-> PackedReader p (r1 :++: r2) (v1 -> v2)
-> PackedReader r1 r2 v1
-> PackedReader (p :++: r1) r2 v2
forall v1 v2 v3 (p :: [*]) (r1 :: [*]) (r2 :: [*]).
(v1 -> v2 -> v3)
-> PackedReader p (r1 :++: r2) v1
-> PackedReader r1 r2 v2
-> PackedReader (p :++: r1) r2 v3
liftA2 (v1 -> v2) -> v1 -> v2
forall a. a -> a
id

-- | Similar to 'Control.Applicative.*>'
{-# INLINE (*>) #-}
(*>) :: PackedReader p (r1 :++: r2) v -> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
*> :: forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v v'.
PackedReader p (r1 :++: r2) v
-> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
(*>) = PackedReader p (r1 :++: r2) v
-> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v v'.
PackedReader p (r1 :++: r2) v
-> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
(>>)

-- | Similar to 'Control.Applicative.<*'
{-# INLINE (<*) #-}
(<*) :: PackedReader p (r1 :++: r2) v2 -> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
<* :: forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v2 v1.
PackedReader p (r1 :++: r2) v2
-> PackedReader r1 r2 v1 -> PackedReader (p :++: r1) r2 v2
(<*) = (v2 -> v1 -> v2)
-> PackedReader p (r1 :++: r2) v2
-> PackedReader r1 r2 v1
-> PackedReader (p :++: r1) r2 v2
forall v1 v2 v3 (p :: [*]) (r1 :: [*]) (r2 :: [*]).
(v1 -> v2 -> v3)
-> PackedReader p (r1 :++: r2) v1
-> PackedReader r1 r2 v2
-> PackedReader (p :++: r1) r2 v3
liftA2 v2 -> v1 -> v2
forall a b. a -> b -> a
const

-------- Monad

-- | Allows bindings 'Data.Packed.Reader.PackedReader' together, in a monad-like manner.
--
-- Similar to 'Prelude.>>='
{-# INLINE (>>=) #-}
(>>=) ::
    PackedReader p (r1 :++: r2) v ->
    (v -> PackedReader r1 r2 v') ->
    PackedReader (p :++: r1) r2 v'
>>= :: forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v v'.
PackedReader p (r1 :++: r2) v
-> (v -> PackedReader r1 r2 v') -> PackedReader (p :++: r1) r2 v'
(>>=) PackedReader p (r1 :++: r2) v
pr1 v -> PackedReader r1 r2 v'
next = (PackedFragment ((p :++: r1) :++: r2)
 -> Identity (v', PackedFragment r2))
-> PackedReader (p :++: r1) r2 v'
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment ((p :++: r1) :++: r2)
  -> Identity (v', PackedFragment r2))
 -> PackedReader (p :++: r1) r2 v')
-> (PackedFragment ((p :++: r1) :++: r2)
    -> Identity (v', PackedFragment r2))
-> PackedReader (p :++: r1) r2 v'
forall a b. (a -> b) -> a -> b
$ \PackedFragment ((p :++: r1) :++: r2)
pf ->
    let Identity (!v
v1, !PackedFragment (r1 :++: r2)
pf1) = PackedReader p (r1 :++: r2) v
-> PackedFragment (p :++: (r1 :++: r2))
-> Identity (v, PackedFragment (r1 :++: r2))
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader p (r1 :++: r2) v
pr1 (PackedFragment ((p :++: r1) :++: r2)
-> PackedFragment (p :++: (r1 :++: r2))
forall (p :: [*]) (t :: [*]). PackedFragment p -> PackedFragment t
castPackedFragment PackedFragment ((p :++: r1) :++: r2)
pf)
        PackedReader !PackedFragment (r1 :++: r2) -> Identity (v', PackedFragment r2)
pr2 = v -> PackedReader r1 r2 v'
next v
v1
     in PackedFragment (r1 :++: r2) -> Identity (v', PackedFragment r2)
pr2 PackedFragment (r1 :++: r2)
pf1

{-# INLINE (>>) #-}

-- | Similar to 'Prelude.>>'
(>>) ::
    PackedReader p (r1 :++: r2) v ->
    PackedReader r1 r2 v' ->
    PackedReader (p :++: r1) r2 v'
>> :: forall (p :: [*]) (r1 :: [*]) (r2 :: [*]) v v'.
PackedReader p (r1 :++: r2) v
-> PackedReader r1 r2 v' -> PackedReader (p :++: r1) r2 v'
(>>) PackedReader p (r1 :++: r2) v
pr1 (PackedReader PackedFragment (r1 :++: r2) -> Identity (v', PackedFragment r2)
pr2) = (PackedFragment ((p :++: r1) :++: r2)
 -> Identity (v', PackedFragment r2))
-> PackedReader (p :++: r1) r2 v'
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment ((p :++: r1) :++: r2)
  -> Identity (v', PackedFragment r2))
 -> PackedReader (p :++: r1) r2 v')
-> (PackedFragment ((p :++: r1) :++: r2)
    -> Identity (v', PackedFragment r2))
-> PackedReader (p :++: r1) r2 v'
forall a b. (a -> b) -> a -> b
$ \PackedFragment ((p :++: r1) :++: r2)
pf ->
    let
        Identity (!v
_, !PackedFragment (r1 :++: r2)
pf1) = PackedReader p (r1 :++: r2) v
-> PackedFragment (p :++: (r1 :++: r2))
-> Identity (v, PackedFragment (r1 :++: r2))
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader p (r1 :++: r2) v
pr1 (PackedFragment ((p :++: r1) :++: r2)
-> PackedFragment (p :++: (r1 :++: r2))
forall (p :: [*]) (t :: [*]). PackedFragment p -> PackedFragment t
castPackedFragment PackedFragment ((p :++: r1) :++: r2)
pf)
     in
        PackedFragment (r1 :++: r2) -> Identity (v', PackedFragment r2)
pr2 PackedFragment (r1 :++: r2)
pf1

{-# INLINE return #-}

-- | Like 'Prelude.return', wraps a value in a 'Data.Packed.Reader.PackedReader' that will not consume its input.
return :: v -> PackedReader '[] r v
return :: forall v (r :: [*]). v -> PackedReader '[] r v
return !v
value = (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
PackedReader ((PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
 -> PackedReader '[] r v)
-> (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \(!PackedFragment ('[] :++: r)
pf) -> (v, PackedFragment r) -> Identity (v, PackedFragment r)
forall a. a -> Identity a
Identity (v
value, PackedFragment r
PackedFragment ('[] :++: r)
pf)

-- | Interrupts a 'Data.Packed.Reader.PackedReader' computation
{-# INLINE fail #-}
fail :: String -> PackedReader '[] r v
fail :: forall (r :: [*]) v. String -> PackedReader '[] r v
fail String
msg = (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
mkPackedReader ((PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
 -> PackedReader '[] r v)
-> (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \PackedFragment ('[] :++: r)
_ -> String -> Identity (v, PackedFragment r)
forall a. HasCallStack => String -> a
error String
msg

-- | Run the reading function using a 'Data.Packed.Packed'.
{-# INLINE runReader #-}
runReader ::
    PackedReader p r v ->
    Packed (p :++: r) ->
    (v, Packed r)
runReader :: forall (p :: [*]) (r :: [*]) v.
PackedReader p r v -> Packed (p :++: r) -> (v, Packed r)
runReader PackedReader p r v
pr (Packed (BS ForeignPtr Word8
fptr Int
l)) =
    IO (v, Packed r) -> (v, Packed r)
forall a. IO a -> a
unsafeDupablePerformIO
        ( ForeignPtr Word8
-> (Ptr Word8 -> IO (v, Packed r)) -> IO (v, Packed r)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (v, Packed r)) -> IO (v, Packed r))
-> (Ptr Word8 -> IO (v, Packed r)) -> IO (v, Packed r)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
            let Identity (!v
v, !(PF Ptr Word8
ptr1 Int
l1)) = PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader p r v
pr (Ptr Word8 -> Int -> PackedFragment (p :++: r)
forall (p :: [*]). Ptr Word8 -> Int -> PackedFragment p
PF (Ptr Word8 -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr) Int
l)
            !fptr1 <- Ptr Word8 -> IO (ForeignPtr Word8)
forall a. Ptr a -> IO (ForeignPtr a)
newForeignPtr_ Ptr Word8
ptr1
            Prelude.return (v, Packed (BS fptr1 l1))
        )

-- | Consumes the input 'Data.Packed.Reader.PackedFragment'.
--
-- To be used inside a 'Data.Packed.Reader.PackedReader' computation.
--
-- Example:
--
-- @
-- sumPacked :: PackedReader '[Tree Int] r Int
-- sumPacked = PackedReader $ \case
--     PackedLeaf l -> reader `with` l
--     PackedNode n -> threadedWith n $ R.do
--         !left <- sumPacked2
--         !right <- sumPacked2
--         let !res = left + right
--         R.return res
-- @
{-# INLINE with #-}
with :: PackedReader p r v -> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
with :: forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
with = PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep

-- | Flipped version of 'with'
{-# INLINE threadedWith #-}
threadedWith :: PackedFragment (p :++: r) -> PackedReader p r v -> Identity (v, PackedFragment r)
threadedWith :: forall (p :: [*]) (r :: [*]) v.
PackedFragment (p :++: r)
-> PackedReader p r v -> Identity (v, PackedFragment r)
threadedWith = (PackedReader p r v
 -> PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedFragment (p :++: r)
-> PackedReader p r v
-> Identity (v, PackedFragment r)
forall a b c. (a -> b -> c) -> b -> a -> c
flip PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
with

-- | Allows running a 'Data.Packed.Reader.PackedReader' computation inside an other
{-# INLINE lift #-}
lift ::
    PackedReader a b v ->
    PackedFragment (a :++: b) ->
    PackedReader '[] r v
lift :: forall (a :: [*]) (b :: [*]) v (r :: [*]).
PackedReader a b v
-> PackedFragment (a :++: b) -> PackedReader '[] r v
lift PackedReader a b v
r PackedFragment (a :++: b)
p = (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(PackedFragment (p :++: r) -> Identity (v, PackedFragment r))
-> PackedReader p r v
mkPackedReader ((PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
 -> PackedReader '[] r v)
-> (PackedFragment ('[] :++: r) -> Identity (v, PackedFragment r))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \PackedFragment ('[] :++: r)
pf ->
    let
        Identity !(!v
res, !PackedFragment b
_) = PackedReader a b v
-> PackedFragment (a :++: b) -> Identity (v, PackedFragment b)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> PackedFragment (p :++: r) -> Identity (v, PackedFragment r)
runReaderStep PackedReader a b v
r PackedFragment (a :++: b)
p
     in
        (v, PackedFragment r) -> Identity (v, PackedFragment r)
forall a. a -> Identity a
Identity (v
res, PackedFragment r
PackedFragment ('[] :++: r)
pf)