{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-- | Types to avoid source destination confusion while copying.
module Raaz.Core.Types.Copying
       (
         -- * Copying.
         -- $copyconvention$
         Src(..), Dest(..), source, destination
       ) where

import Foreign.Storable ( Storable )

-- $copyconvention$
--
-- Consider a copy operation that involves copying data between two
-- entities of the same type. If the source and target is confused
-- this can lead to bugs. The types `Src` and `Dest` helps in avoiding
-- this confusion. The convention that we follow is that copy function
-- mark its destination and source explicitly at the type level. The
-- actual constructors for the type `Src` and `Dest` are not available
-- to users of the library. Instead they use the smart constructors
-- `source` and `destination` when passing arguments to these
-- functions.
--
-- The developers of the raaz library do have access to the
-- constructors. However, it is unlikely one would need it. Since both
-- `Src` and `Dest` derive the underlying `Storable` instance, one can
-- mark `Src` and `Dest` in calls to `FFI` functions as well.


-- | The source of a copy operation.
newtype Src  a = Src { Src a -> a
unSrc :: a } deriving Ptr b -> Int -> IO (Src a)
Ptr b -> Int -> Src a -> IO ()
Ptr (Src a) -> IO (Src a)
Ptr (Src a) -> Int -> IO (Src a)
Ptr (Src a) -> Int -> Src a -> IO ()
Ptr (Src a) -> Src a -> IO ()
Src a -> Int
(Src a -> Int)
-> (Src a -> Int)
-> (Ptr (Src a) -> Int -> IO (Src a))
-> (Ptr (Src a) -> Int -> Src a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Src a))
-> (forall b. Ptr b -> Int -> Src a -> IO ())
-> (Ptr (Src a) -> IO (Src a))
-> (Ptr (Src a) -> Src a -> IO ())
-> Storable (Src a)
forall b. Ptr b -> Int -> IO (Src a)
forall b. Ptr b -> Int -> Src a -> IO ()
forall a. Storable a => Ptr (Src a) -> IO (Src a)
forall a. Storable a => Ptr (Src a) -> Int -> IO (Src a)
forall a. Storable a => Ptr (Src a) -> Int -> Src a -> IO ()
forall a. Storable a => Ptr (Src a) -> Src a -> IO ()
forall a. Storable a => Src a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Src a)
forall a b. Storable a => Ptr b -> Int -> Src a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Src a) -> Src a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Src a) -> Src a -> IO ()
peek :: Ptr (Src a) -> IO (Src a)
$cpeek :: forall a. Storable a => Ptr (Src a) -> IO (Src a)
pokeByteOff :: Ptr b -> Int -> Src a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Src a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Src a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Src a)
pokeElemOff :: Ptr (Src a) -> Int -> Src a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (Src a) -> Int -> Src a -> IO ()
peekElemOff :: Ptr (Src a) -> Int -> IO (Src a)
$cpeekElemOff :: forall a. Storable a => Ptr (Src a) -> Int -> IO (Src a)
alignment :: Src a -> Int
$calignment :: forall a. Storable a => Src a -> Int
sizeOf :: Src a -> Int
$csizeOf :: forall a. Storable a => Src a -> Int
Storable

-- | smart constructor for source
source :: a -> Src a
source :: a -> Src a
source = a -> Src a
forall a. a -> Src a
Src

instance Functor Src where
  fmap :: (a -> b) -> Src a -> Src b
fmap a -> b
f = b -> Src b
forall a. a -> Src a
Src (b -> Src b) -> (Src a -> b) -> Src a -> Src b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Src a -> a) -> Src a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Src a -> a
forall a. Src a -> a
unSrc

-- | The destination of a copy operation.
--
-- Note to Developers of Raaz: Since the `Dest` type inherits the
-- Storable instance of the base type, one can use this type in
-- foreign functions.
newtype Dest a = Dest { Dest a -> a
unDest :: a } deriving Ptr b -> Int -> IO (Dest a)
Ptr b -> Int -> Dest a -> IO ()
Ptr (Dest a) -> IO (Dest a)
Ptr (Dest a) -> Int -> IO (Dest a)
Ptr (Dest a) -> Int -> Dest a -> IO ()
Ptr (Dest a) -> Dest a -> IO ()
Dest a -> Int
(Dest a -> Int)
-> (Dest a -> Int)
-> (Ptr (Dest a) -> Int -> IO (Dest a))
-> (Ptr (Dest a) -> Int -> Dest a -> IO ())
-> (forall b. Ptr b -> Int -> IO (Dest a))
-> (forall b. Ptr b -> Int -> Dest a -> IO ())
-> (Ptr (Dest a) -> IO (Dest a))
-> (Ptr (Dest a) -> Dest a -> IO ())
-> Storable (Dest a)
forall b. Ptr b -> Int -> IO (Dest a)
forall b. Ptr b -> Int -> Dest a -> IO ()
forall a. Storable a => Ptr (Dest a) -> IO (Dest a)
forall a. Storable a => Ptr (Dest a) -> Int -> IO (Dest a)
forall a. Storable a => Ptr (Dest a) -> Int -> Dest a -> IO ()
forall a. Storable a => Ptr (Dest a) -> Dest a -> IO ()
forall a. Storable a => Dest a -> Int
forall a b. Storable a => Ptr b -> Int -> IO (Dest a)
forall a b. Storable a => Ptr b -> Int -> Dest a -> IO ()
forall a.
(a -> Int)
-> (a -> Int)
-> (Ptr a -> Int -> IO a)
-> (Ptr a -> Int -> a -> IO ())
-> (forall b. Ptr b -> Int -> IO a)
-> (forall b. Ptr b -> Int -> a -> IO ())
-> (Ptr a -> IO a)
-> (Ptr a -> a -> IO ())
-> Storable a
poke :: Ptr (Dest a) -> Dest a -> IO ()
$cpoke :: forall a. Storable a => Ptr (Dest a) -> Dest a -> IO ()
peek :: Ptr (Dest a) -> IO (Dest a)
$cpeek :: forall a. Storable a => Ptr (Dest a) -> IO (Dest a)
pokeByteOff :: Ptr b -> Int -> Dest a -> IO ()
$cpokeByteOff :: forall a b. Storable a => Ptr b -> Int -> Dest a -> IO ()
peekByteOff :: Ptr b -> Int -> IO (Dest a)
$cpeekByteOff :: forall a b. Storable a => Ptr b -> Int -> IO (Dest a)
pokeElemOff :: Ptr (Dest a) -> Int -> Dest a -> IO ()
$cpokeElemOff :: forall a. Storable a => Ptr (Dest a) -> Int -> Dest a -> IO ()
peekElemOff :: Ptr (Dest a) -> Int -> IO (Dest a)
$cpeekElemOff :: forall a. Storable a => Ptr (Dest a) -> Int -> IO (Dest a)
alignment :: Dest a -> Int
$calignment :: forall a. Storable a => Dest a -> Int
sizeOf :: Dest a -> Int
$csizeOf :: forall a. Storable a => Dest a -> Int
Storable

-- | smart constructor for destionation.
destination :: a -> Dest a
destination :: a -> Dest a
destination = a -> Dest a
forall a. a -> Dest a
Dest

instance Functor Dest where
  fmap :: (a -> b) -> Dest a -> Dest b
fmap a -> b
f = b -> Dest b
forall a. a -> Dest a
Dest (b -> Dest b) -> (Dest a -> b) -> Dest a -> Dest b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Dest a -> a) -> Dest a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dest a -> a
forall a. Dest a -> a
unDest