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

-- |
-- It is recommended to import this module like so:
--
-- @
-- import qualified Data.Packed.Reader as R
-- @
module Data.Packed.Reader (
    PackedReader (..),
    mkPackedReader,
    runReader,
    (>>=),
    (>>),
    lift,
    fail,
    return,
    ReaderPtr,
    finishReader,
) where

import Data.ByteString.Internal
import Data.Packed.Needs (Needs, finish)
import Data.Packed.Packed
import Data.Packed.Utils ((:++:))
import Data.Word (Word8)
import Foreign.ForeignPtr (newForeignPtr_)
import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
import Foreign.Ptr
import Prelude hiding (fail, return, (>>), (>>=))
import qualified Prelude

type ReaderPtr r = Ptr Word8

-- | 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
-> ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
runPackedReader ::
        ReaderPtr (p :++: r) ->
        Int ->
        IO (v, ReaderPtr r, Int)
    }

{-# INLINE mkPackedReader #-}

-- | Builds a 'PackedReader'
mkPackedReader ::
    ( ReaderPtr (p :++: r) ->
      Int ->
      IO (v, ReaderPtr r, Int)
    ) ->
    PackedReader p r v
mkPackedReader :: forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
mkPackedReader = (ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> 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 ReaderPtr (p :++: r) -> Int -> IO (a, ReaderPtr (p :++: r), Int)
reader) = (ReaderPtr (p :++: r) -> Int -> IO (b, ReaderPtr (p :++: r), Int))
-> PackedReader p r b
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
PackedReader ((ReaderPtr (p :++: r) -> Int -> IO (b, ReaderPtr (p :++: r), Int))
 -> PackedReader p r b)
-> (ReaderPtr (p :++: r)
    -> Int -> IO (b, ReaderPtr (p :++: r), Int))
-> PackedReader p r b
forall a b. (a -> b) -> a -> b
$ \ReaderPtr (p :++: r)
ptr Int
l -> do
        (!n, !rest, !l1) <- ReaderPtr (p :++: r) -> Int -> IO (a, ReaderPtr (p :++: r), Int)
reader ReaderPtr (p :++: r)
ptr Int
l
        Prelude.return (f n, rest, l1)

{-# INLINE (>>=) #-}

-- | Allows bindings 'Data.Packed.Reader.PackedReader' together, in a monad-like manner.
--
-- Similar to 'Prelude.>>='
(>>=) ::
    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
m1 v -> PackedReader r1 r2 v'
m2 = (ReaderPtr (p :++: r) -> Int -> IO (v', ReaderPtr (p :++: r), Int))
-> PackedReader (p :++: r1) r2 v'
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
PackedReader ((ReaderPtr (p :++: r)
  -> Int -> IO (v', ReaderPtr (p :++: r), Int))
 -> PackedReader (p :++: r1) r2 v')
-> (ReaderPtr (p :++: r)
    -> Int -> IO (v', ReaderPtr (p :++: r), Int))
-> PackedReader (p :++: r1) r2 v'
forall a b. (a -> b) -> a -> b
$ \ReaderPtr (p :++: r)
packed Int
l -> do
    (!value, !packed1, !l1) <- PackedReader p (r1 :++: r2) v
-> ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
runPackedReader PackedReader p (r1 :++: r2) v
m1 ReaderPtr (p :++: r)
packed Int
l
    (!res, !rest, !l2) <- runPackedReader (m2 value) packed1 l1
    Prelude.return (res, rest, l2)

{-# 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
m1 PackedReader r1 r2 v'
m2 = (ReaderPtr (p :++: r) -> Int -> IO (v', ReaderPtr (p :++: r), Int))
-> PackedReader (p :++: r1) r2 v'
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
PackedReader ((ReaderPtr (p :++: r)
  -> Int -> IO (v', ReaderPtr (p :++: r), Int))
 -> PackedReader (p :++: r1) r2 v')
-> (ReaderPtr (p :++: r)
    -> Int -> IO (v', ReaderPtr (p :++: r), Int))
-> PackedReader (p :++: r1) r2 v'
forall a b. (a -> b) -> a -> b
$ \ReaderPtr (p :++: r)
packed Int
l -> do
    (!_, !packed1, !l1) <- PackedReader p (r1 :++: r2) v
-> ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v
-> ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
runPackedReader PackedReader p (r1 :++: r2) v
m1 ReaderPtr (p :++: r)
packed Int
l
    runPackedReader m2 packed1 l1

{-# INLINE return #-}

-- | Like 'Prelude.return', wraps a value in a 'PackedReader' that will not consume its input.
return :: v -> PackedReader '[] r v
return :: forall v (r :: [*]). v -> PackedReader '[] r v
return v
value = (ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
PackedReader ((ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
 -> PackedReader '[] r v)
-> (ReaderPtr (p :++: r)
    -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \(!ReaderPtr (p :++: r)
packed) !Int
l ->
    (v, ReaderPtr (p :++: r), Int) -> IO (v, ReaderPtr (p :++: r), Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
Prelude.return (v
value, ReaderPtr (p :++: r)
packed, Int
l)

{-# INLINE fail #-}
fail :: String -> PackedReader '[] r v
fail :: forall (r :: [*]) v. String -> PackedReader '[] r v
fail String
msg = (ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
mkPackedReader ((ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
 -> PackedReader '[] r v)
-> (ReaderPtr (p :++: r)
    -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \ReaderPtr (p :++: r)
_ Int
_ -> String -> IO (v, ReaderPtr (p :++: r), Int)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
Prelude.fail String
msg

-- | Allows reading another packed value in a do-notation.
--
-- The reading of the second stream does not consume anything from the first.
--
-- __Example__:
--
-- @
-- import qualified Data.Packed.Reader as R
-- data Tree a = Leaf | Node (Tree a) a (Tree a)
--
-- packedTreeToList :: 'PackedReader' '[Tree Int] '[] [Int]
-- packedTreeToList = go []
--     where
--         go l =
--             caseTree
--                 (R.return l)
--                 ( R.do
--                     packedLeft <- 'Data.Packed.isolate'
--                     n <- 'Data.Packed.readerWithFieldSize'
--                     packedRight <- 'Data.Packed.isolate'
--                     -- Using lift allows consuming the packedRight value
--                     rightList <- R.'lift' (go l) packedRight
--                     R.'lift' (go $ n : rightList) packedLeft
--                 )
-- @
{-# INLINE lift #-}
lift ::
    PackedReader a b v ->
    Packed (a :++: b) ->
    PackedReader '[] r v
lift :: forall (a :: [*]) (b :: [*]) v (r :: [*]).
PackedReader a b v -> Packed (a :++: b) -> PackedReader '[] r v
lift PackedReader a b v
r Packed (a :++: b)
p = (ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall (p :: [*]) (r :: [*]) v.
(ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader p r v
mkPackedReader ((ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int))
 -> PackedReader '[] r v)
-> (ReaderPtr (p :++: r)
    -> Int -> IO (v, ReaderPtr (p :++: r), Int))
-> PackedReader '[] r v
forall a b. (a -> b) -> a -> b
$ \ReaderPtr (p :++: r)
old Int
l -> do
    (!res, _) <- PackedReader a b v -> Packed (a :++: b) -> IO (v, Packed b)
forall (p :: [*]) (r :: [*]) v.
PackedReader p r v -> Packed (p :++: r) -> IO (v, Packed r)
runReader PackedReader a b v
r Packed (a :++: b)
p
    Prelude.return (res, old, l)

-- | Run the reading function using a ByteString.
{-# INLINE runReader #-}
runReader ::
    PackedReader p r v ->
    Packed (p :++: r) ->
    IO (v, Packed r)
runReader :: forall (p :: [*]) (r :: [*]) v.
PackedReader p r v -> Packed (p :++: r) -> IO (v, Packed r)
runReader (PackedReader ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
f) (Packed (BS ForeignPtr Word8
fptr Int
l)) = do
    (!v, !ptr1, !l1) <- ReaderPtr (p :++: r) -> Int -> IO (v, ReaderPtr (p :++: r), Int)
f (ReaderPtr (p :++: r) -> ReaderPtr (p :++: r)
forall a b. Ptr a -> Ptr b
castPtr (ReaderPtr (p :++: r) -> ReaderPtr (p :++: r))
-> ReaderPtr (p :++: r) -> ReaderPtr (p :++: r)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> ReaderPtr (p :++: r)
forall a. ForeignPtr a -> Ptr a
unsafeForeignPtrToPtr ForeignPtr Word8
fptr) Int
l
    !fptr1 <- newForeignPtr_ ptr1
    Prelude.return (v, Packed (BS fptr1 l1))

{-# INLINE finishReader #-}

-- | Util function that calls 'Data.Packed.finish' on the value produced by the input 'PackedReader'
finishReader :: PackedReader p r (Needs '[] a) -> PackedReader p r (Packed a)
finishReader :: forall (p :: [*]) (r :: [*]) (a :: [*]).
PackedReader p r (Needs '[] a) -> PackedReader p r (Packed a)
finishReader PackedReader p r (Needs '[] a)
r = Needs '[] a -> Packed a
forall (t :: [*]). Needs '[] t -> Packed t
finish (Needs '[] a -> Packed a)
-> PackedReader p r (Needs '[] a) -> PackedReader p r (Packed a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackedReader p r (Needs '[] a)
r