    -- |
    -- Module      : Data.ByteArray.Pack.Internal
    -- License     : BSD-Style
    -- Copyright   : Copyright © 2014 Nicolas DI PRIMA
    --
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    -- Stability   : experimental
    -- Portability : unknown
    --
    module Data.ByteArray.Pack.Internal
        ( Result(..)
        , Packer(..)
        , actionPacker
        , actionPackerWithRemain
        ) where

    import           Foreign.Ptr (Ptr)
    import           Data.ByteArray.MemView
    import           Data.Memory.Internal.Imports

    -- | Packing result:
    --
    -- * PackerMore: the next state of Packing with an arbitrary value
    -- * PackerFail: an error happened
    data Result a =
          PackerMore a MemView
        | PackerFail String
        deriving (Int -> Result a -> ShowS
    [Result a] -> ShowS
    Result a -> String
    (Int -> Result a -> ShowS)
    -> (Result a -> String) -> ([Result a] -> ShowS) -> Show (Result a)
    forall a. Show a => Int -> Result a -> ShowS
    forall a. Show a => [Result a] -> ShowS
    forall a. Show a => Result a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> Result a -> ShowS
    showsPrec :: Int -> Result a -> ShowS
    $cshow :: forall a. Show a => Result a -> String
    show :: Result a -> String
    $cshowList :: forall a. Show a => [Result a] -> ShowS
    showList :: [Result a] -> ShowS
    Show)

    -- | Simple ByteArray Packer
    newtype Packer a = Packer { forall a. Packer a -> MemView -> IO (Result a)
    runPacker_ :: MemView -> IO (Result a) }

    instance Functor Packer where
        fmap :: forall a b. (a -> b) -> Packer a -> Packer b
    fmap = (a -> b) -> Packer a -> Packer b
    forall a b. (a -> b) -> Packer a -> Packer b
    fmapPacker

    instance Applicative Packer where
        pure :: forall a. a -> Packer a
    pure  = a -> Packer a
    forall a. a -> Packer a
    returnPacker
        <*> :: forall a b. Packer (a -> b) -> Packer a -> Packer b
    (<*>) = Packer (a -> b) -> Packer a -> Packer b
    forall a b. Packer (a -> b) -> Packer a -> Packer b
    appendPacker

    instance Monad Packer where
        return :: forall a. a -> Packer a
    return = a -> Packer a
    forall a. a -> Packer a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        >>= :: forall a b. Packer a -> (a -> Packer b) -> Packer b
    (>>=)  = Packer a -> (a -> Packer b) -> Packer b
    forall a b. Packer a -> (a -> Packer b) -> Packer b
    bindPacker

    fmapPacker :: (a -> b) -> Packer a -> Packer b
    fmapPacker :: forall a b. (a -> b) -> Packer a -> Packer b
    fmapPacker a -> b
    f Packer a
    p = (MemView -> IO (Result b)) -> Packer b
    forall a. (MemView -> IO (Result a)) -> Packer a
    Packer ((MemView -> IO (Result b)) -> Packer b)
    -> (MemView -> IO (Result b)) -> Packer b
    forall a b. (a -> b) -> a -> b
    $ \MemView
    cache -> do
        rv <- Packer a -> MemView -> IO (Result a)
    forall a. Packer a -> MemView -> IO (Result a)
    runPacker_ Packer a
    p MemView
    cache
        return $ case rv of
            PackerMore a
    v MemView
    cache' -> b -> MemView -> Result b
    forall a. a -> MemView -> Result a
    PackerMore (a -> b
    f a
    v) MemView
    cache'
            PackerFail String
    err      -> String -> Result b
    forall a. String -> Result a
    PackerFail String
    err
    {-# INLINE fmapPacker #-}

    returnPacker :: a -> Packer a
    returnPacker :: forall a. a -> Packer a
    returnPacker a
    v = (MemView -> IO (Result a)) -> Packer a
    forall a. (MemView -> IO (Result a)) -> Packer a
    Packer ((MemView -> IO (Result a)) -> Packer a)
    -> (MemView -> IO (Result a)) -> Packer a
    forall a b. (a -> b) -> a -> b
    $ \MemView
    cache -> Result a -> IO (Result a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
    forall a b. (a -> b) -> a -> b
    $ a -> MemView -> Result a
    forall a. a -> MemView -> Result a
    PackerMore a
    v MemView
    cache
    {-# INLINE returnPacker #-}

    bindPacker :: Packer a -> (a -> Packer b) -> Packer b
    bindPacker :: forall a b. Packer a -> (a -> Packer b) -> Packer b
    bindPacker Packer a
    p a -> Packer b
    fp = (MemView -> IO (Result b)) -> Packer b
    forall a. (MemView -> IO (Result a)) -> Packer a
    Packer ((MemView -> IO (Result b)) -> Packer b)
    -> (MemView -> IO (Result b)) -> Packer b
    forall a b. (a -> b) -> a -> b
    $ \MemView
    cache -> do
        rv <- Packer a -> MemView -> IO (Result a)
    forall a. Packer a -> MemView -> IO (Result a)
    runPacker_ Packer a
    p MemView
    cache
        case rv of
            PackerMore a
    v MemView
    cache' -> Packer b -> MemView -> IO (Result b)
    forall a. Packer a -> MemView -> IO (Result a)
    runPacker_ (a -> Packer b
    fp a
    v) MemView
    cache'
            PackerFail String
    err      -> Result b -> IO (Result b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result b -> IO (Result b)) -> Result b -> IO (Result b)
    forall a b. (a -> b) -> a -> b
    $ String -> Result b
    forall a. String -> Result a
    PackerFail String
    err
    {-# INLINE bindPacker #-}

    appendPacker :: Packer (a -> b) -> Packer a -> Packer b
    appendPacker :: forall a b. Packer (a -> b) -> Packer a -> Packer b
    appendPacker Packer (a -> b)
    p1f Packer a
    p2 = Packer (a -> b)
    p1f Packer (a -> b) -> ((a -> b) -> Packer b) -> Packer b
    forall a b. Packer a -> (a -> Packer b) -> Packer b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a -> b
    p1 -> Packer a
    p2 Packer a -> (a -> Packer b) -> Packer b
    forall a b. Packer a -> (a -> Packer b) -> Packer b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \a
    v -> b -> Packer b
    forall a. a -> Packer a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> b
    p1 a
    v)
    {-# INLINE appendPacker #-}

    -- | run a sized action
    actionPacker :: Int -> (Ptr Word8 -> IO a) -> Packer a
    actionPacker :: forall a. Int -> (Ptr Word8 -> IO a) -> Packer a
    actionPacker Int
    s Ptr Word8 -> IO a
    action = (MemView -> IO (Result a)) -> Packer a
    forall a. (MemView -> IO (Result a)) -> Packer a
    Packer ((MemView -> IO (Result a)) -> Packer a)
    -> (MemView -> IO (Result a)) -> Packer a
    forall a b. (a -> b) -> a -> b
    $ \m :: MemView
    m@(MemView Ptr Word8
    ptr Int
    size) ->
        case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    size Int
    s of
            Ordering
    LT -> Result a -> IO (Result a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
    forall a b. (a -> b) -> a -> b
    $ String -> Result a
    forall a. String -> Result a
    PackerFail String
    "Not enough space in destination"
            Ordering
    _  -> do
                v <- Ptr Word8 -> IO a
    action Ptr Word8
    ptr
                return $ PackerMore v (m `memViewPlus` s)
    {-# INLINE actionPacker #-}

    -- | run a sized action
    actionPackerWithRemain :: Int -> (Ptr Word8 -> Int -> IO (Int, a)) -> Packer a
    actionPackerWithRemain :: forall a. Int -> (Ptr Word8 -> Int -> IO (Int, a)) -> Packer a
    actionPackerWithRemain Int
    s Ptr Word8 -> Int -> IO (Int, a)
    action = (MemView -> IO (Result a)) -> Packer a
    forall a. (MemView -> IO (Result a)) -> Packer a
    Packer ((MemView -> IO (Result a)) -> Packer a)
    -> (MemView -> IO (Result a)) -> Packer a
    forall a b. (a -> b) -> a -> b
    $ \m :: MemView
    m@(MemView Ptr Word8
    ptr Int
    size) ->
        case Int -> Int -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare Int
    size Int
    s of
            Ordering
    LT -> Result a -> IO (Result a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result a -> IO (Result a)) -> Result a -> IO (Result a)
    forall a b. (a -> b) -> a -> b
    $ String -> Result a
    forall a. String -> Result a
    PackerFail String
    "Not enough space in destination"
            Ordering
    _  -> do
                (remain, v) <- Ptr Word8 -> Int -> IO (Int, a)
    action Ptr Word8
    ptr Int
    size
                return $ if remain > s
                    then PackerFail "remaining bytes higher than the destination's size"
                    else PackerMore v (m `memViewPlus` (s+remain))
    {-# INLINE actionPackerWithRemain #-}