{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE ScopedTypeVariables, RankNTypes, TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses, AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, DerivingStrategies #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Foreign.Storable.Generic.Internal (G(..), W(..)) where

import GHC.Generics
import Foreign.Ptr
import Foreign.Storable
import Foreign.Storable.PeekPoke
import Data.Kind

class G a where
	gSizeOf :: a -> Int
	gAlignment :: a -> Int
	gPeek :: Ptr a -> IO a
	gPoke :: Ptr a -> a -> IO ()

	default gSizeOf :: MapTypeVal2 Sizable (Flatten (Rep a)) => a -> Int
	gSizeOf a
_ = (Offset, Offset) -> Offset
forall a b. (a, b) -> a
fst (forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => (Offset, Offset)
wholeSizeAlignmentNew @a)

	default gAlignment :: MapTypeVal2 Sizable (Flatten (Rep a)) => a -> Int
	gAlignment a
_ = (Offset, Offset) -> Offset
forall a b. (a, b) -> b
snd (forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => (Offset, Offset)
wholeSizeAlignmentNew @a)

	default gPeek :: (Generic a, Gg (Rep a)) => Ptr a -> IO a
	gPeek = (Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> IO (Rep a Any) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (Rep a Any) -> IO a)
-> (Ptr a -> IO (Rep a Any)) -> Ptr a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (Rep a Any) -> IO (Rep a Any)
forall a. Ptr (Rep a a) -> IO (Rep a a)
forall (f :: * -> *) a. Gg f => Ptr (f a) -> IO (f a)
ggPeek (Ptr (Rep a Any) -> IO (Rep a Any))
-> (Ptr a -> Ptr (Rep a Any)) -> Ptr a -> IO (Rep a Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> Ptr (Rep a Any)
forall a b. Ptr a -> Ptr b
castPtr

	default gPoke :: (Generic a, Gg (Rep a)) => Ptr a -> a -> IO ()
	gPoke Ptr a
p = Ptr (Rep a Any) -> Rep a Any -> IO ()
forall a. Ptr (Rep a a) -> Rep a a -> IO ()
forall (f :: * -> *) a. Gg f => Ptr (f a) -> f a -> IO ()
ggPoke (Ptr a -> Ptr (Rep a Any)
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p) (Rep a Any -> IO ()) -> (a -> Rep a Any) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from

class Gg f where
	ggSizeOf :: f a -> Int -> Int
	ggAlignment :: f a -> Int
	ggHeadAlignment :: f a -> Int
	ggPeek :: Ptr (f a) -> IO (f a)
	ggPoke :: Ptr (f a) -> f a -> IO ()

instance Gg U1 where
	ggSizeOf :: forall a. U1 a -> Offset -> Offset
ggSizeOf U1 a
_ Offset
sz = Offset
sz
	ggAlignment :: forall a. U1 a -> Offset
ggAlignment U1 a
_ = Offset
1
	ggHeadAlignment :: forall a. U1 a -> Offset
ggHeadAlignment U1 a
_ = Offset
1
	ggPeek :: forall a. Ptr (U1 a) -> IO (U1 a)
ggPeek Ptr (U1 a)
_ = U1 a -> IO (U1 a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
	ggPoke :: forall a. Ptr (U1 a) -> U1 a -> IO ()
ggPoke Ptr (U1 a)
_ U1 a
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (Storable a, Gg b) => Gg (K1 _i a :*: b) where
	ggSizeOf :: forall a. (:*:) (K1 _i a) b a -> Offset -> Offset
ggSizeOf (:*:) (K1 _i a) b a
_ Offset
sz = forall (f :: * -> *) a. Gg f => f a -> Offset -> Offset
ggSizeOf @b b Any
forall a. HasCallStack => a
undefined (((Offset
sz Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Offset
sizeOf @a a
forall a. HasCallStack => a
undefined Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
1) Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
`div` Offset
a Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1) Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
* Offset
a)
		where a :: Offset
a = forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment @b b Any
forall a. HasCallStack => a
undefined
	ggAlignment :: forall a. (:*:) (K1 _i a) b a -> Offset
ggAlignment (:*:) (K1 _i a) b a
_ = forall a. Storable a => a -> Offset
alignment @a a
forall a. HasCallStack => a
undefined Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
`lcm` forall (f :: * -> *) a. Gg f => f a -> Offset
ggAlignment @b b Any
forall a. HasCallStack => a
undefined
	ggHeadAlignment :: forall a. (:*:) (K1 _i a) b a -> Offset
ggHeadAlignment (:*:) (K1 _i a) b a
_ = forall a. Storable a => a -> Offset
alignment @a a
forall a. HasCallStack => a
undefined
	ggPeek :: forall a. Ptr ((:*:) (K1 _i a) b a) -> IO ((:*:) (K1 _i a) b a)
ggPeek Ptr ((:*:) (K1 _i a) b a)
p = K1 _i a a -> b a -> (:*:) (K1 _i a) b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (K1 _i a a -> b a -> (:*:) (K1 _i a) b a)
-> IO (K1 _i a a) -> IO (b a -> (:*:) (K1 _i a) b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> K1 _i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 _i a a) -> IO a -> IO (K1 _i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr ((:*:) (K1 _i a) b a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (K1 _i a) b a)
p)) IO (b a -> (:*:) (K1 _i a) b a)
-> IO (b a) -> IO ((:*:) (K1 _i a) b a)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr (b a) -> IO (b a)
forall a. Ptr (b a) -> IO (b a)
forall (f :: * -> *) a. Gg f => Ptr (f a) -> IO (f a)
ggPeek (Ptr Any -> Ptr (b a)
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
p')
		where
		ip :: IntPtr
ip = Ptr ((:*:) (K1 _i a) b a) -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr ((:*:) (K1 _i a) b a)
p
		p' :: Ptr Any
p' = IntPtr -> Ptr Any
forall a. IntPtr -> Ptr a
intPtrToPtr (IntPtr -> Ptr Any) -> IntPtr -> Ptr Any
forall a b. (a -> b) -> a -> b
$ ((IntPtr
ip IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
+ (Offset -> IntPtr
IntPtr (Offset -> IntPtr) -> Offset -> IntPtr
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Offset
sizeOf @a a
forall a. HasCallStack => a
undefined) IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
- IntPtr
1) IntPtr -> IntPtr -> IntPtr
forall a. Integral a => a -> a -> a
`div` IntPtr
a IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
+ IntPtr
1) IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
* IntPtr
a
		a :: IntPtr
a = Offset -> IntPtr
IntPtr (Offset -> IntPtr) -> Offset -> IntPtr
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment @b b Any
forall a. HasCallStack => a
undefined
	ggPoke :: forall a. Ptr ((:*:) (K1 _i a) b a) -> (:*:) (K1 _i a) b a -> IO ()
ggPoke Ptr ((:*:) (K1 _i a) b a)
p (K1 a
x :*: b a
y) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr ((:*:) (K1 _i a) b a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (K1 _i a) b a)
p) a
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Ptr (b a) -> b a -> IO ()
forall a. Ptr (b a) -> b a -> IO ()
forall (f :: * -> *) a. Gg f => Ptr (f a) -> f a -> IO ()
ggPoke (Ptr Any -> Ptr (b a)
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
p') b a
y
		where
		ip :: IntPtr
ip = Ptr ((:*:) (K1 _i a) b a) -> IntPtr
forall a. Ptr a -> IntPtr
ptrToIntPtr Ptr ((:*:) (K1 _i a) b a)
p
		p' :: Ptr Any
p' = IntPtr -> Ptr Any
forall a. IntPtr -> Ptr a
intPtrToPtr (IntPtr -> Ptr Any) -> IntPtr -> Ptr Any
forall a b. (a -> b) -> a -> b
$ ((IntPtr
ip IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
+ (Offset -> IntPtr
IntPtr (Offset -> IntPtr) -> Offset -> IntPtr
forall a b. (a -> b) -> a -> b
$ forall a. Storable a => a -> Offset
sizeOf @a a
forall a. HasCallStack => a
undefined) IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
- IntPtr
1) IntPtr -> IntPtr -> IntPtr
forall a. Integral a => a -> a -> a
`div` IntPtr
a IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
+ IntPtr
1) IntPtr -> IntPtr -> IntPtr
forall a. Num a => a -> a -> a
* IntPtr
a
		a :: IntPtr
a = Offset -> IntPtr
IntPtr (Offset -> IntPtr) -> Offset -> IntPtr
forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment @b b Any
forall a. HasCallStack => a
undefined

instance Gg (a :*: b) => Gg (M1 _i _c a :*: b) where
	ggSizeOf :: forall a. (:*:) (M1 _i _c a) b a -> Offset -> Offset
ggSizeOf (:*:) (M1 _i _c a) b a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset -> Offset
ggSizeOf @(a :*: b) (:*:) a b Any
forall a. HasCallStack => a
undefined
	ggAlignment :: forall a. (:*:) (M1 _i _c a) b a -> Offset
ggAlignment (:*:) (M1 _i _c a) b a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset
ggAlignment @(a :*: b) (:*:) a b Any
forall a. HasCallStack => a
undefined
	ggHeadAlignment :: forall a. (:*:) (M1 _i _c a) b a -> Offset
ggHeadAlignment (:*:) (M1 _i _c a) b a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment @(a :*: b) (:*:) a b Any
forall a. HasCallStack => a
undefined
	ggPeek :: forall a.
Ptr ((:*:) (M1 _i _c a) b a) -> IO ((:*:) (M1 _i _c a) b a)
ggPeek Ptr ((:*:) (M1 _i _c a) b a)
p = (\(a a
x :*: b a
y) -> (a a -> M1 _i _c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 a a
x M1 _i _c a a -> b a -> (:*:) (M1 _i _c a) b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
y)) ((:*:) a b a -> (:*:) (M1 _i _c a) b a)
-> IO ((:*:) a b a) -> IO ((:*:) (M1 _i _c a) b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ((:*:) a b a) -> IO ((:*:) a b a)
forall a. Ptr ((:*:) a b a) -> IO ((:*:) a b a)
forall (f :: * -> *) a. Gg f => Ptr (f a) -> IO (f a)
ggPeek (Ptr ((:*:) (M1 _i _c a) b a) -> Ptr ((:*:) a b a)
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (M1 _i _c a) b a)
p)
	ggPoke :: forall a.
Ptr ((:*:) (M1 _i _c a) b a) -> (:*:) (M1 _i _c a) b a -> IO ()
ggPoke Ptr ((:*:) (M1 _i _c a) b a)
p (M1 a a
x :*: b a
y) = Ptr ((:*:) a b a) -> (:*:) a b a -> IO ()
forall a. Ptr ((:*:) a b a) -> (:*:) a b a -> IO ()
forall (f :: * -> *) a. Gg f => Ptr (f a) -> f a -> IO ()
ggPoke (Ptr ((:*:) (M1 _i _c a) b a) -> Ptr ((:*:) a b a)
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (M1 _i _c a) b a)
p) (a a
x a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
y)

instance Gg (a :*: (b :*: c)) => Gg ((a :*: b) :*: c) where
	ggSizeOf :: forall a. (:*:) (a :*: b) c a -> Offset -> Offset
ggSizeOf (:*:) (a :*: b) c a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset -> Offset
ggSizeOf @(a :*: (b :*: c)) (:*:) a (b :*: c) Any
forall a. HasCallStack => a
undefined
	ggAlignment :: forall a. (:*:) (a :*: b) c a -> Offset
ggAlignment (:*:) (a :*: b) c a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset
ggAlignment @(a :*: (b :*: c)) (:*:) a (b :*: c) Any
forall a. HasCallStack => a
undefined
	ggHeadAlignment :: forall a. (:*:) (a :*: b) c a -> Offset
ggHeadAlignment (:*:) (a :*: b) c a
_ = forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment @(a :*: (b :*: c)) (:*:) a (b :*: c) Any
forall a. HasCallStack => a
undefined
	ggPeek :: forall a. Ptr ((:*:) (a :*: b) c a) -> IO ((:*:) (a :*: b) c a)
ggPeek Ptr ((:*:) (a :*: b) c a)
p = (\(a a
x :*: (b a
y :*: c a
z)) -> (a a
x a a -> b a -> (:*:) a b a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: b a
y) (:*:) a b a -> c a -> (:*:) (a :*: b) c a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: c a
z) ((:*:) a (b :*: c) a -> (:*:) (a :*: b) c a)
-> IO ((:*:) a (b :*: c) a) -> IO ((:*:) (a :*: b) c a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr ((:*:) a (b :*: c) a) -> IO ((:*:) a (b :*: c) a)
forall a. Ptr ((:*:) a (b :*: c) a) -> IO ((:*:) a (b :*: c) a)
forall (f :: * -> *) a. Gg f => Ptr (f a) -> IO (f a)
ggPeek (Ptr ((:*:) (a :*: b) c a) -> Ptr ((:*:) a (b :*: c) a)
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (a :*: b) c a)
p)
	ggPoke :: forall a. Ptr ((:*:) (a :*: b) c a) -> (:*:) (a :*: b) c a -> IO ()
ggPoke Ptr ((:*:) (a :*: b) c a)
p ((a a
x :*: b a
y) :*: c a
z) = Ptr ((:*:) a (b :*: c) a) -> (:*:) a (b :*: c) a -> IO ()
forall a. Ptr ((:*:) a (b :*: c) a) -> (:*:) a (b :*: c) a -> IO ()
forall (f :: * -> *) a. Gg f => Ptr (f a) -> f a -> IO ()
ggPoke (Ptr ((:*:) (a :*: b) c a) -> Ptr ((:*:) a (b :*: c) a)
forall a b. Ptr a -> Ptr b
castPtr Ptr ((:*:) (a :*: b) c a)
p) (a a
x a a -> (:*:) b c a -> (:*:) a (b :*: c) a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (b a
y b a -> c a -> (:*:) b c a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: c a
z))

{-
instance (Gg a, Gg b) => Gg (a :*: b) where
	ggSizeOf _ = ((ggSizeOf @a undefined - 1) `div` a + 1) * a + ggSizeOf @b undefined
		where a = ggAlignment @b undefined
	ggAlignment _ = ggAlignment @a undefined `lcm` ggAlignment @b undefined
	ggPeek p = (:*:) <$> ggPeek (castPtr p) <*> ggPeek (castPtr p')
		where
		p' = p `plusPtr` (((ggSizeOf @a undefined - 1) `div` a + 1) * a)
		a = ggAlignment @b undefined
	ggPoke p (x :*: y) = ggPoke (castPtr p) x >> ggPoke (castPtr p') y
		where
		p' = p `plusPtr` (((ggSizeOf @a undefined - 1) `div` a + 1) * a)
		a = ggAlignment @b undefined
		-}

{-
instance (Gg a, Gg b) => Gg (a :+: b) where
	ggSizeOf _ = ggSizeOf @a undefined `max` ggSizeOf @b undefined
	ggAlignment _ = ggAlignment @a undefined `lcm` ggAlignment @b undefined
	-}

instance Gg a => Gg (M1 i c a) where
	ggSizeOf :: forall a. M1 i c a a -> Offset -> Offset
ggSizeOf (M1 a a
x) = a a -> Offset -> Offset
forall a. a a -> Offset -> Offset
forall (f :: * -> *) a. Gg f => f a -> Offset -> Offset
ggSizeOf a a
x
	ggAlignment :: forall a. M1 i c a a -> Offset
ggAlignment (M1 a a
x) = a a -> Offset
forall a. a a -> Offset
forall (f :: * -> *) a. Gg f => f a -> Offset
ggAlignment a a
x
	ggHeadAlignment :: forall a. M1 i c a a -> Offset
ggHeadAlignment (M1 a a
x) = a a -> Offset
forall a. a a -> Offset
forall (f :: * -> *) a. Gg f => f a -> Offset
ggHeadAlignment a a
x
	ggPeek :: forall a. Ptr (M1 i c a a) -> IO (M1 i c a a)
ggPeek = (a a -> M1 i c a a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a a -> M1 i c a a) -> IO (a a) -> IO (M1 i c a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO (a a) -> IO (M1 i c a a))
-> (Ptr (M1 i c a a) -> IO (a a))
-> Ptr (M1 i c a a)
-> IO (M1 i c a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (a a) -> IO (a a)
forall a. Ptr (a a) -> IO (a a)
forall (f :: * -> *) a. Gg f => Ptr (f a) -> IO (f a)
ggPeek (Ptr (a a) -> IO (a a))
-> (Ptr (M1 i c a a) -> Ptr (a a)) -> Ptr (M1 i c a a) -> IO (a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (M1 i c a a) -> Ptr (a a)
forall a b. Ptr a -> Ptr b
castPtr
	ggPoke :: forall a. Ptr (M1 i c a a) -> M1 i c a a -> IO ()
ggPoke Ptr (M1 i c a a)
p (M1 a a
x) = Ptr (a a) -> a a -> IO ()
forall a. Ptr (a a) -> a a -> IO ()
forall (f :: * -> *) a. Gg f => Ptr (f a) -> f a -> IO ()
ggPoke (Ptr (M1 i c a a) -> Ptr (a a)
forall a b. Ptr a -> Ptr b
castPtr Ptr (M1 i c a a)
p) a a
x

instance Storable a => Gg (K1 i a) where
	ggSizeOf :: forall a. K1 i a a -> Offset -> Offset
ggSizeOf (K1 a
x) Offset
sz = Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
align (a -> Offset
forall a. Storable a => a -> Offset
alignment a
x) Offset
sz Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ a -> Offset
forall a. Storable a => a -> Offset
sizeOf a
x
	ggAlignment :: forall a. K1 i a a -> Offset
ggAlignment (K1 a
x) = a -> Offset
forall a. Storable a => a -> Offset
alignment a
x
	ggHeadAlignment :: forall a. K1 i a a -> Offset
ggHeadAlignment (K1 a
x) = a -> Offset
forall a. Storable a => a -> Offset
alignment a
x
	ggPeek :: forall a. Ptr (K1 i a a) -> IO (K1 i a a)
ggPeek = (a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a) -> IO a -> IO (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO a -> IO (K1 i a a))
-> (Ptr (K1 i a a) -> IO a) -> Ptr (K1 i a a) -> IO (K1 i a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr a -> IO a)
-> (Ptr (K1 i a a) -> Ptr a) -> Ptr (K1 i a a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (K1 i a a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr
	ggPoke :: forall a. Ptr (K1 i a a) -> K1 i a a -> IO ()
ggPoke Ptr (K1 i a a)
p (K1 a
x) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (K1 i a a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (K1 i a a)
p) a
x

newtype W a = W { forall a. W a -> a
unW :: a }
	deriving (Offset -> W a -> ShowS
[W a] -> ShowS
W a -> String
(Offset -> W a -> ShowS)
-> (W a -> String) -> ([W a] -> ShowS) -> Show (W a)
forall a. Show a => Offset -> W a -> ShowS
forall a. Show a => [W a] -> ShowS
forall a. Show a => W a -> String
forall a.
(Offset -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Offset -> W a -> ShowS
showsPrec :: Offset -> W a -> ShowS
$cshow :: forall a. Show a => W a -> String
show :: W a -> String
$cshowList :: forall a. Show a => [W a] -> ShowS
showList :: [W a] -> ShowS
Show, W a -> W a -> Bool
(W a -> W a -> Bool) -> (W a -> W a -> Bool) -> Eq (W a)
forall a. Eq a => W a -> W a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => W a -> W a -> Bool
== :: W a -> W a -> Bool
$c/= :: forall a. Eq a => W a -> W a -> Bool
/= :: W a -> W a -> Bool
Eq, Eq (W a)
Eq (W a) =>
(W a -> W a -> Ordering)
-> (W a -> W a -> Bool)
-> (W a -> W a -> Bool)
-> (W a -> W a -> Bool)
-> (W a -> W a -> Bool)
-> (W a -> W a -> W a)
-> (W a -> W a -> W a)
-> Ord (W a)
W a -> W a -> Bool
W a -> W a -> Ordering
W a -> W a -> W a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (W a)
forall a. Ord a => W a -> W a -> Bool
forall a. Ord a => W a -> W a -> Ordering
forall a. Ord a => W a -> W a -> W a
$ccompare :: forall a. Ord a => W a -> W a -> Ordering
compare :: W a -> W a -> Ordering
$c< :: forall a. Ord a => W a -> W a -> Bool
< :: W a -> W a -> Bool
$c<= :: forall a. Ord a => W a -> W a -> Bool
<= :: W a -> W a -> Bool
$c> :: forall a. Ord a => W a -> W a -> Bool
> :: W a -> W a -> Bool
$c>= :: forall a. Ord a => W a -> W a -> Bool
>= :: W a -> W a -> Bool
$cmax :: forall a. Ord a => W a -> W a -> W a
max :: W a -> W a -> W a
$cmin :: forall a. Ord a => W a -> W a -> W a
min :: W a -> W a -> W a
Ord, Offset -> W a
W a -> Offset
W a -> [W a]
W a -> W a
W a -> W a -> [W a]
W a -> W a -> W a -> [W a]
(W a -> W a)
-> (W a -> W a)
-> (Offset -> W a)
-> (W a -> Offset)
-> (W a -> [W a])
-> (W a -> W a -> [W a])
-> (W a -> W a -> [W a])
-> (W a -> W a -> W a -> [W a])
-> Enum (W a)
forall a. Enum a => Offset -> W a
forall a. Enum a => W a -> Offset
forall a. Enum a => W a -> [W a]
forall a. Enum a => W a -> W a
forall a. Enum a => W a -> W a -> [W a]
forall a. Enum a => W a -> W a -> W a -> [W a]
forall a.
(a -> a)
-> (a -> a)
-> (Offset -> a)
-> (a -> Offset)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: forall a. Enum a => W a -> W a
succ :: W a -> W a
$cpred :: forall a. Enum a => W a -> W a
pred :: W a -> W a
$ctoEnum :: forall a. Enum a => Offset -> W a
toEnum :: Offset -> W a
$cfromEnum :: forall a. Enum a => W a -> Offset
fromEnum :: W a -> Offset
$cenumFrom :: forall a. Enum a => W a -> [W a]
enumFrom :: W a -> [W a]
$cenumFromThen :: forall a. Enum a => W a -> W a -> [W a]
enumFromThen :: W a -> W a -> [W a]
$cenumFromTo :: forall a. Enum a => W a -> W a -> [W a]
enumFromTo :: W a -> W a -> [W a]
$cenumFromThenTo :: forall a. Enum a => W a -> W a -> W a -> [W a]
enumFromThenTo :: W a -> W a -> W a -> [W a]
Enum)
	deriving newtype (forall x. W a -> Rep (W a) x)
-> (forall x. Rep (W a) x -> W a) -> Generic (W a)
forall a x. Generic a => Rep (W a) x -> W a
forall a x. Generic a => W a -> Rep (W a) x
forall x. Rep (W a) x -> W a
forall x. W a -> Rep (W a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall a x. Generic a => W a -> Rep (W a) x
from :: forall x. W a -> Rep (W a) x
$cto :: forall a x. Generic a => Rep (W a) x -> W a
to :: forall x. Rep (W a) x -> W a
Generic

instance G a => Storable (W a) where
	sizeOf :: W a -> Offset
sizeOf = a -> Offset
forall a. G a => a -> Offset
gSizeOf (a -> Offset) -> (W a -> a) -> W a -> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W a -> a
forall a. W a -> a
unW
	alignment :: W a -> Offset
alignment = a -> Offset
forall a. G a => a -> Offset
gAlignment (a -> Offset) -> (W a -> a) -> W a -> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W a -> a
forall a. W a -> a
unW
	peek :: Ptr (W a) -> IO (W a)
peek = (a -> W a
forall a. a -> W a
W (a -> W a) -> IO a -> IO (W a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO a -> IO (W a)) -> (Ptr (W a) -> IO a) -> Ptr (W a) -> IO (W a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr a -> IO a
forall a. G a => Ptr a -> IO a
gPeek (Ptr a -> IO a) -> (Ptr (W a) -> Ptr a) -> Ptr (W a) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr (W a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr
	poke :: Ptr (W a) -> W a -> IO ()
poke Ptr (W a)
p = Ptr a -> a -> IO ()
forall a. G a => Ptr a -> a -> IO ()
gPoke (Ptr (W a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (W a)
p) (a -> IO ()) -> (W a -> a) -> W a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. W a -> a
forall a. W a -> a
unW

{-
instance {-# OVERLAPPABLE #-} G a => Storable a where
	sizeOf = gSizeOf
	alignment = gAlignment
	peek = gPeek
	poke = gPoke
	-}

wholeSizeAlignmentNew ::
	forall a . MapTypeVal2 Sizable (Flatten (Rep a)) => SizeAlignment
wholeSizeAlignmentNew :: forall a. MapTypeVal2 Sizable (Flatten (Rep a)) => (Offset, Offset)
wholeSizeAlignmentNew = let sas :: [(Offset, Offset)]
sas = forall a.
MapTypeVal2 Sizable (Flatten (Rep a)) =>
[(Offset, Offset)]
sizeAlignmentListNew @a in
	([(Offset, Offset)] -> Offset
calcWholeSize [(Offset, Offset)]
sas, [(Offset, Offset)] -> Offset
calcWholeAlignment [(Offset, Offset)]
sas)

calcWholeAlignment :: [SizeAlignment] -> Alignment
calcWholeAlignment :: [(Offset, Offset)] -> Offset
calcWholeAlignment = (Offset -> Offset -> Offset) -> Offset -> [Offset] -> Offset
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
lcm Offset
1 ([Offset] -> Offset)
-> ([(Offset, Offset)] -> [Offset]) -> [(Offset, Offset)] -> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Offset, Offset) -> Offset
forall a b. (a, b) -> b
snd ((Offset, Offset) -> Offset) -> [(Offset, Offset)] -> [Offset]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

calcWholeSize :: [SizeAlignment] -> Size
calcWholeSize :: [(Offset, Offset)] -> Offset
calcWholeSize = (Offset -> (Offset, Offset) -> Offset)
-> Offset -> [(Offset, Offset)] -> Offset
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Offset -> (Offset, Offset) -> Offset
next Offset
0 ([(Offset, Offset)] -> Offset)
-> ([(Offset, Offset)] -> [(Offset, Offset)])
-> [(Offset, Offset)]
-> Offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Offset, Offset)] -> [(Offset, Offset)]
rotateAlignmentL

next :: Offset -> SizeAlignment -> Offset
next :: Offset -> (Offset, Offset) -> Offset
next Offset
os (Offset
sz, Offset
algn) = ((Offset
os Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
sz Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
- Offset
1) Offset -> Offset -> Offset
forall a. Integral a => a -> a -> a
`div` Offset
algn Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
+ Offset
1) Offset -> Offset -> Offset
forall a. Num a => a -> a -> a
* Offset
algn

type Offset = Int

rotateAlignmentL :: [SizeAlignment] -> [SizeAlignment]
rotateAlignmentL :: [(Offset, Offset)] -> [(Offset, Offset)]
rotateAlignmentL [] = String -> [(Offset, Offset)]
forall a. HasCallStack => String -> a
error String
"empty size and alignment list"
rotateAlignmentL [(Offset, Offset)]
sas = [Offset] -> [Offset] -> [(Offset, Offset)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Offset]
ss ([Offset]
as [Offset] -> [Offset] -> [Offset]
forall a. [a] -> [a] -> [a]
++ [Offset
a]) where ([Offset]
ss, Offset
a : [Offset]
as) = [(Offset, Offset)] -> ([Offset], [Offset])
forall a b. [(a, b)] -> ([a], [b])
unzip [(Offset, Offset)]
sas

sizeAlignmentListNew ::
	forall a . MapTypeVal2 Sizable (Flatten (Rep a)) => [SizeAlignment]
sizeAlignmentListNew :: forall a.
MapTypeVal2 Sizable (Flatten (Rep a)) =>
[(Offset, Offset)]
sizeAlignmentListNew = forall (as :: [*]). MapTypeVal2 Sizable as => [(Offset, Offset)]
sizeAlignmentTypeList @(Flatten (Rep a))

sizeAlignmentTypeList ::
	forall (as :: [Type]) . MapTypeVal2 Sizable as => [SizeAlignment]
sizeAlignmentTypeList :: forall (as :: [*]). MapTypeVal2 Sizable as => [(Offset, Offset)]
sizeAlignmentTypeList = forall (c :: * -> Constraint) (as :: [*]) b.
MapTypeVal2 c as =>
(forall a. c a => a -> b) -> [b]
mapTypeVal2 @Sizable @as (\(a
_ :: a) -> (forall a. Sizable a => Offset
sizeOf' @a, forall a. Sizable a => Offset
alignment' @a))

type Size = Int
type Alignment = Int
type SizeAlignment = (Size, Alignment)

class MapTypeVal2 c (as :: [Type]) where
	mapTypeVal2 :: (forall a . c a => a -> b) -> [b]

instance MapTypeVal2 c '[] where mapTypeVal2 :: forall b. (forall a. c a => a -> b) -> [b]
mapTypeVal2 forall a. c a => a -> b
_ = []

instance (c a, MapTypeVal2 c as) => MapTypeVal2 c (a ': as) where
	mapTypeVal2 :: forall b. (forall a. c a => a -> b) -> [b]
mapTypeVal2 forall a. c a => a -> b
x = a -> b
forall a. c a => a -> b
x (a
forall a. HasCallStack => a
undefined :: a) b -> [b] -> [b]
forall a. a -> [a] -> [a]
: forall (c :: * -> Constraint) (as :: [*]) b.
MapTypeVal2 c as =>
(forall a. c a => a -> b) -> [b]
mapTypeVal2 @c @as a -> b
forall a. c a => a -> b
x

type family GetType (x :: Type -> Type) :: Type where
	GetType (K1 i a) = a
	GetType (M1 m i a) = GetType a

type family Flatten (x :: Type -> Type) :: [Type] where
	Flatten U1 = '[]
	Flatten (K1 i a) = '[a]
	Flatten (M1 m i a) = Flatten a
	Flatten (M1 m i a :*: t2) = GetType a ': Flatten t2
	Flatten ((t1 :*: t2) :*: t3) = Flatten (t1 :*: t2 :*: t3)

align :: Integral n => n -> n -> n
align :: forall a. Integral a => a -> a -> a
align n
algn n
ofst = ((n
ofst n -> n -> n
forall a. Num a => a -> a -> a
- n
1) n -> n -> n
forall a. Integral a => a -> a -> a
`div` n
algn n -> n -> n
forall a. Num a => a -> a -> a
+ n
1) n -> n -> n
forall a. Num a => a -> a -> a
* n
algn