{-
This should be in the standard library.
-}
module Foreign.Storable.Tuple where

import Data.Orphans ()
import Foreign.Storable (Storable (..), )
import qualified Foreign.Storable.Record as Store
import Control.Applicative (liftA2, liftA3, pure, (<*>), )

import Data.Tuple.HT (fst3, snd3, thd3, )


instance (Storable a, Storable b) => Storable (a,b) where
   sizeOf :: (a, b) -> Int
sizeOf    = Dictionary (a, b) -> (a, b) -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary (a, b)
forall a b. (Storable a, Storable b) => Dictionary (a, b)
storePair
   alignment :: (a, b) -> Int
alignment = Dictionary (a, b) -> (a, b) -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary (a, b)
forall a b. (Storable a, Storable b) => Dictionary (a, b)
storePair
   peek :: Ptr (a, b) -> IO (a, b)
peek      = Dictionary (a, b) -> Ptr (a, b) -> IO (a, b)
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary (a, b)
forall a b. (Storable a, Storable b) => Dictionary (a, b)
storePair
   poke :: Ptr (a, b) -> (a, b) -> IO ()
poke      = Dictionary (a, b) -> Ptr (a, b) -> (a, b) -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary (a, b)
forall a b. (Storable a, Storable b) => Dictionary (a, b)
storePair

{-# INLINE storePair #-}
storePair ::
   (Storable a, Storable b) =>
   Store.Dictionary (a,b)
storePair :: forall a b. (Storable a, Storable b) => Dictionary (a, b)
storePair =
   Access (a, b) (a, b) -> Dictionary (a, b)
forall r. Access r r -> Dictionary r
Store.run (Access (a, b) (a, b) -> Dictionary (a, b))
-> Access (a, b) (a, b) -> Dictionary (a, b)
forall a b. (a -> b) -> a -> b
$
   (a -> b -> (a, b))
-> Access (a, b) a -> Access (a, b) b -> Access (a, b) (a, b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,)
      (((a, b) -> a) -> Access (a, b) a
forall a r. Storable a => (r -> a) -> Access r a
Store.element (a, b) -> a
forall a b. (a, b) -> a
fst)
      (((a, b) -> b) -> Access (a, b) b
forall a r. Storable a => (r -> a) -> Access r a
Store.element (a, b) -> b
forall a b. (a, b) -> b
snd)


instance (Storable a, Storable b, Storable c) => Storable (a,b,c) where
   sizeOf :: (a, b, c) -> Int
sizeOf    = Dictionary (a, b, c) -> (a, b, c) -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary (a, b, c)
forall a b c.
(Storable a, Storable b, Storable c) =>
Dictionary (a, b, c)
storeTriple
   alignment :: (a, b, c) -> Int
alignment = Dictionary (a, b, c) -> (a, b, c) -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary (a, b, c)
forall a b c.
(Storable a, Storable b, Storable c) =>
Dictionary (a, b, c)
storeTriple
   peek :: Ptr (a, b, c) -> IO (a, b, c)
peek      = Dictionary (a, b, c) -> Ptr (a, b, c) -> IO (a, b, c)
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary (a, b, c)
forall a b c.
(Storable a, Storable b, Storable c) =>
Dictionary (a, b, c)
storeTriple
   poke :: Ptr (a, b, c) -> (a, b, c) -> IO ()
poke      = Dictionary (a, b, c) -> Ptr (a, b, c) -> (a, b, c) -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary (a, b, c)
forall a b c.
(Storable a, Storable b, Storable c) =>
Dictionary (a, b, c)
storeTriple

{-# INLINE storeTriple #-}
storeTriple ::
   (Storable a, Storable b, Storable c) =>
   Store.Dictionary (a,b,c)
storeTriple :: forall a b c.
(Storable a, Storable b, Storable c) =>
Dictionary (a, b, c)
storeTriple =
   Access (a, b, c) (a, b, c) -> Dictionary (a, b, c)
forall r. Access r r -> Dictionary r
Store.run (Access (a, b, c) (a, b, c) -> Dictionary (a, b, c))
-> Access (a, b, c) (a, b, c) -> Dictionary (a, b, c)
forall a b. (a -> b) -> a -> b
$
   (a -> b -> c -> (a, b, c))
-> Access (a, b, c) a
-> Access (a, b, c) b
-> Access (a, b, c) c
-> Access (a, b, c) (a, b, c)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,)
      (((a, b, c) -> a) -> Access (a, b, c) a
forall a r. Storable a => (r -> a) -> Access r a
Store.element (a, b, c) -> a
forall a b c. (a, b, c) -> a
fst3)
      (((a, b, c) -> b) -> Access (a, b, c) b
forall a r. Storable a => (r -> a) -> Access r a
Store.element (a, b, c) -> b
forall a b c. (a, b, c) -> b
snd3)
      (((a, b, c) -> c) -> Access (a, b, c) c
forall a r. Storable a => (r -> a) -> Access r a
Store.element (a, b, c) -> c
forall a b c. (a, b, c) -> c
thd3)

instance (Storable a, Storable b, Storable c, Storable d) => Storable (a,b,c,d) where
   sizeOf :: (a, b, c, d) -> Int
sizeOf    = Dictionary (a, b, c, d) -> (a, b, c, d) -> Int
forall r. Dictionary r -> r -> Int
Store.sizeOf Dictionary (a, b, c, d)
forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
Dictionary (a, b, c, d)
storeQuadruple
   alignment :: (a, b, c, d) -> Int
alignment = Dictionary (a, b, c, d) -> (a, b, c, d) -> Int
forall r. Dictionary r -> r -> Int
Store.alignment Dictionary (a, b, c, d)
forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
Dictionary (a, b, c, d)
storeQuadruple
   peek :: Ptr (a, b, c, d) -> IO (a, b, c, d)
peek      = Dictionary (a, b, c, d) -> Ptr (a, b, c, d) -> IO (a, b, c, d)
forall r. Dictionary r -> Ptr r -> IO r
Store.peek Dictionary (a, b, c, d)
forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
Dictionary (a, b, c, d)
storeQuadruple
   poke :: Ptr (a, b, c, d) -> (a, b, c, d) -> IO ()
poke      = Dictionary (a, b, c, d)
-> Ptr (a, b, c, d) -> (a, b, c, d) -> IO ()
forall r. Dictionary r -> Ptr r -> r -> IO ()
Store.poke Dictionary (a, b, c, d)
forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
Dictionary (a, b, c, d)
storeQuadruple

{-# INLINE storeQuadruple #-}
storeQuadruple ::
   (Storable a, Storable b, Storable c, Storable d) =>
   Store.Dictionary (a,b,c,d)
storeQuadruple :: forall a b c d.
(Storable a, Storable b, Storable c, Storable d) =>
Dictionary (a, b, c, d)
storeQuadruple =
   Access (a, b, c, d) (a, b, c, d) -> Dictionary (a, b, c, d)
forall r. Access r r -> Dictionary r
Store.run (Access (a, b, c, d) (a, b, c, d) -> Dictionary (a, b, c, d))
-> Access (a, b, c, d) (a, b, c, d) -> Dictionary (a, b, c, d)
forall a b. (a -> b) -> a -> b
$
   (a -> b -> c -> d -> (a, b, c, d))
-> Access (a, b, c, d) (a -> b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,,)
      Access (a, b, c, d) (a -> b -> c -> d -> (a, b, c, d))
-> Access (a, b, c, d) a
-> Access (a, b, c, d) (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((a, b, c, d) -> a) -> Access (a, b, c, d) a
forall a r. Storable a => (r -> a) -> Access r a
Store.element (((a, b, c, d) -> a) -> Access (a, b, c, d) a)
-> ((a, b, c, d) -> a) -> Access (a, b, c, d) a
forall a b. (a -> b) -> a -> b
$ \(a
x,b
_,c
_,d
_) -> a
x)
      Access (a, b, c, d) (b -> c -> d -> (a, b, c, d))
-> Access (a, b, c, d) b
-> Access (a, b, c, d) (c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((a, b, c, d) -> b) -> Access (a, b, c, d) b
forall a r. Storable a => (r -> a) -> Access r a
Store.element (((a, b, c, d) -> b) -> Access (a, b, c, d) b)
-> ((a, b, c, d) -> b) -> Access (a, b, c, d) b
forall a b. (a -> b) -> a -> b
$ \(a
_,b
x,c
_,d
_) -> b
x)
      Access (a, b, c, d) (c -> d -> (a, b, c, d))
-> Access (a, b, c, d) c -> Access (a, b, c, d) (d -> (a, b, c, d))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((a, b, c, d) -> c) -> Access (a, b, c, d) c
forall a r. Storable a => (r -> a) -> Access r a
Store.element (((a, b, c, d) -> c) -> Access (a, b, c, d) c)
-> ((a, b, c, d) -> c) -> Access (a, b, c, d) c
forall a b. (a -> b) -> a -> b
$ \(a
_,b
_,c
x,d
_) -> c
x)
      Access (a, b, c, d) (d -> (a, b, c, d))
-> Access (a, b, c, d) d -> Access (a, b, c, d) (a, b, c, d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (((a, b, c, d) -> d) -> Access (a, b, c, d) d
forall a r. Storable a => (r -> a) -> Access r a
Store.element (((a, b, c, d) -> d) -> Access (a, b, c, d) d)
-> ((a, b, c, d) -> d) -> Access (a, b, c, d) d
forall a b. (a -> b) -> a -> b
$ \(a
_,b
_,c
_,d
x) -> d
x)
{-
   liftA4 (,,,)
      (Store.element $ \(x,_,_,_) -> x)
      (Store.element $ \(_,x,_,_) -> x)
      (Store.element $ \(_,_,x,_) -> x)
      (Store.element $ \(_,_,_,x) -> x)
-}


{-
{- Why is this allowed? -}
test :: Char
test = const 'a' undefined

{- Why is type defaulting applied here? The type of 'c' should be fixed. -}
test1 :: (Integral a, RealField.C a) => a
test1 =
   let c = undefined
   in  asTypeOf (round c) c
-}