    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE NoImplicitPrelude #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Foreign.Marshal.Utils
    -- Copyright   :  (c) The FFI task force 2001
    -- License     :  BSD-style (see the file libraries/base/LICENSE)
    --
    -- Maintainer  :  ffi@haskell.org
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- Utilities for primitive marshaling
    --
    -----------------------------------------------------------------------------

    module Foreign.Marshal.Utils (
      -- * General marshalling utilities

      -- ** Combined allocation and marshalling
      --
      with,
      new,

      -- ** Marshalling of Boolean values (non-zero corresponds to 'True')
      --
      fromBool,
      toBool,

      -- ** Marshalling of Maybe values
      --
      maybeNew,
      maybeWith,
      maybePeek,

      -- ** Marshalling lists of storable objects
      --
      withMany,

      -- ** Haskellish interface to memcpy and memmove
      -- | (argument order: destination, source)
      --
      copyBytes,
      moveBytes,

      -- ** Filling up memory area with required values
      --
      fillBytes,
    ) where

    import Data.Maybe
    import Foreign.Ptr              ( Ptr, nullPtr )
    import Foreign.Storable         ( Storable(poke) )
    import Foreign.C.Types          ( CSize(..), CInt(..) )
    import Foreign.Marshal.Alloc    ( malloc, alloca )
    import Data.Word                ( Word8 )

    import GHC.Real                 ( fromIntegral )
    import GHC.Num
    import GHC.Base

    -- combined allocation and marshalling
    -- -----------------------------------

    -- |Allocate a block of memory and marshal a value into it
    -- (the combination of 'malloc' and 'poke').
    -- The size of the area allocated is determined by the 'Foreign.Storable.sizeOf'
    -- method from the instance of 'Storable' for the appropriate type.
    --
    -- The memory may be deallocated using 'Foreign.Marshal.Alloc.free' or
    -- 'Foreign.Marshal.Alloc.finalizerFree' when no longer required.
    --
    new     :: Storable a => a -> IO (Ptr a)
    new :: forall a. Storable a => a -> IO (Ptr a)
    new a
    val  =
      do
        Ptr a
    ptr <- IO (Ptr a)
    forall a. Storable a => IO (Ptr a)
    malloc
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr a
    ptr a
    val
        Ptr a -> IO (Ptr a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr a
    ptr

    -- |@'with' val f@ executes the computation @f@, passing as argument
    -- a pointer to a temporarily allocated block of memory into which
    -- @val@ has been marshalled (the combination of 'alloca' and 'poke').
    --
    -- The memory is freed when @f@ terminates (either normally or via an
    -- exception), so the pointer passed to @f@ must /not/ be used after this.
    --
    with       :: Storable a => a -> (Ptr a -> IO b) -> IO b
    with :: forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
    with a
    val Ptr a -> IO b
    f  =
      (Ptr a -> IO b) -> IO b
    forall a b. Storable a => (Ptr a -> IO b) -> IO b
    alloca ((Ptr a -> IO b) -> IO b) -> (Ptr a -> IO b) -> IO b
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr -> do
        Ptr a -> a -> IO ()
    forall a. Storable a => Ptr a -> a -> IO ()
    poke Ptr a
    ptr a
    val
        Ptr a -> IO b
    f Ptr a
    ptr

    -- marshalling of Boolean values (non-zero corresponds to 'True')
    -- -----------------------------

    -- |Convert a Haskell 'Bool' to its numeric representation
    --
    fromBool       :: Num a => Bool -> a
    fromBool :: forall a. Num a => Bool -> a
    fromBool Bool
    False  = a
    0
    fromBool Bool
    True   = a
    1

    -- |Convert a Boolean in numeric representation to a Haskell value
    --
    toBool :: (Eq a, Num a) => a -> Bool
    toBool :: forall a. (Eq a, Num a) => a -> Bool
    toBool  = (a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    0)

    -- marshalling of Maybe values
    -- ---------------------------

    -- |Allocate storage and marshal a storable value wrapped into a 'Maybe'
    --
    -- * the 'nullPtr' is used to represent 'Nothing'
    --
    maybeNew :: (      a -> IO (Ptr b))
             -> (Maybe a -> IO (Ptr b))
    maybeNew :: forall a b. (a -> IO (Ptr b)) -> Maybe a -> IO (Ptr b)
    maybeNew  = IO (Ptr b) -> (a -> IO (Ptr b)) -> Maybe a -> IO (Ptr b)
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Ptr b -> IO (Ptr b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Ptr b
    forall a. Ptr a
    nullPtr)

    -- |Converts a @withXXX@ combinator into one marshalling a value wrapped
    -- into a 'Maybe', using 'nullPtr' to represent 'Nothing'.
    --
    maybeWith :: (      a -> (Ptr b -> IO c) -> IO c)
              -> (Maybe a -> (Ptr b -> IO c) -> IO c)
    maybeWith :: forall a b c.
    (a -> (Ptr b -> IO c) -> IO c)
    -> Maybe a -> (Ptr b -> IO c) -> IO c
    maybeWith  = ((Ptr b -> IO c) -> IO c)
    -> (a -> (Ptr b -> IO c) -> IO c)
    -> Maybe a
    -> (Ptr b -> IO c)
    -> IO c
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((Ptr b -> IO c) -> Ptr b -> IO c
    forall a b. (a -> b) -> a -> b
    $ Ptr b
    forall a. Ptr a
    nullPtr)

    -- |Convert a peek combinator into a one returning 'Nothing' if applied to a
    -- 'nullPtr'
    --
    maybePeek                           :: (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
    maybePeek :: forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
    maybePeek Ptr a -> IO b
    peek Ptr a
    ptr | Ptr a
    ptr Ptr a -> Ptr a -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ptr a
    forall a. Ptr a
    nullPtr  = Maybe b -> IO (Maybe b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe b
    forall a. Maybe a
    Nothing
                       | Bool
    otherwise       = do b
    a <- Ptr a -> IO b
    peek Ptr a
    ptr; Maybe b -> IO (Maybe b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b -> Maybe b
    forall a. a -> Maybe a
    Just b
    a)

    -- marshalling lists of storable objects
    -- -------------------------------------

    -- |Replicates a @withXXX@ combinator over a list of objects, yielding a list of
    -- marshalled objects
    --
    withMany :: (a -> (b -> res) -> res)  -- withXXX combinator for one object
             -> [a]                       -- storable objects
             -> ([b] -> res)              -- action on list of marshalled obj.s
             -> res
    withMany :: forall a b res.
    (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
    withMany a -> (b -> res) -> res
    _       []     [b] -> res
    f = [b] -> res
    f []
    withMany a -> (b -> res) -> res
    withFoo (a
    x:[a]
    xs) [b] -> res
    f = a -> (b -> res) -> res
    withFoo a
    x ((b -> res) -> res) -> (b -> res) -> res
    forall a b. (a -> b) -> a -> b
    $ \b
    x' ->
                                  (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
    forall a b res.
    (a -> (b -> res) -> res) -> [a] -> ([b] -> res) -> res
    withMany a -> (b -> res) -> res
    withFoo [a]
    xs (\[b]
    xs' -> [b] -> res
    f (b
    x'b -> [b] -> [b]
    forall a. a -> [a] -> [a]
    :[b]
    xs'))

    -- Haskellish interface to memcpy and memmove
    -- ------------------------------------------

    -- |Copies the given number of bytes from the second area (source) into the
    -- first (destination); the copied areas may /not/ overlap
    --
    copyBytes
      :: Ptr a -- ^ Destination
      -> Ptr a -- ^ Source
      -> Int -- ^ Size in bytes
      -> IO ()
    copyBytes :: forall a. Ptr a -> Ptr a -> Int -> IO ()
    copyBytes Ptr a
    dest Ptr a
    src Int
    size = do
      Ptr a
    _ <- Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    memcpy Ptr a
    dest Ptr a
    src (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size)
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- |Copies the given number of bytes from the second area (source) into the
    -- first (destination); the copied areas /may/ overlap
    --
    moveBytes
      :: Ptr a -- ^ Destination
      -> Ptr a -- ^ Source
      -> Int -- ^ Size in bytes
      -> IO ()
    moveBytes :: forall a. Ptr a -> Ptr a -> Int -> IO ()
    moveBytes Ptr a
    dest Ptr a
    src Int
    size = do
      Ptr a
    _ <- Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    forall a. Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    memmove Ptr a
    dest Ptr a
    src (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size)
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- Filling up memory area with required values
    -- -------------------------------------------

    -- |Fill a given number of bytes in memory area with a byte value.
    --
    -- @since 4.8.0.0
    fillBytes               :: Ptr a -> Word8 -> Int -> IO ()
    fillBytes :: forall a. Ptr a -> Word8 -> Int -> IO ()
    fillBytes Ptr a
    dest Word8
    char Int
    size = do
      Ptr a
    _ <- Ptr a -> CInt -> CSize -> IO (Ptr a)
    forall a. Ptr a -> CInt -> CSize -> IO (Ptr a)
    memset Ptr a
    dest (Word8 -> CInt
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word8
    char) (Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    size)
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- auxiliary routines
    -- -------------------

    -- |Basic C routines needed for memory copying
    --
    foreign import ccall unsafe "string.h" memcpy  :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    foreign import ccall unsafe "string.h" memmove :: Ptr a -> Ptr a -> CSize -> IO (Ptr a)
    foreign import ccall unsafe "string.h" memset  :: Ptr a -> CInt  -> CSize -> IO (Ptr a)