{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}

module Foreign.Storable.Generic.TH (instanceTuples) where

import Language.Haskell.TH
import Foreign.Storable
import Foreign.Storable.Generic.Internal

instanceTuples :: Int -> DecQ
instanceTuples :: Int -> DecQ
instanceTuples Int
n = [Name] -> DecQ
bar ([Name] -> DecQ) -> Q [Name] -> DecQ
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Q Name
forall (m :: * -> *). Quote m => String -> m Name
newName (String -> Q Name) -> [String] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
`mapM` Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
n [String]
vars

bar :: [Name] -> DecQ
bar :: [Name] -> DecQ
bar [Name]
vs = Q Cxt -> Q Type -> [DecQ] -> DecQ
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
	([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt ([Q Type] -> Q Cxt) -> [Q Type] -> Q Cxt
forall a b. (a -> b) -> a -> b
$ (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Storable Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT`) (Q Type -> Q Type) -> (Name -> Q Type) -> Name -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT (Name -> Q Type) -> [Name] -> [Q Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
vs)

	(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''G Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
`appT` ((Q Type -> Name -> Q Type) -> Q Type -> [Name] -> Q Type
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (((Q Type -> Q Type) -> (Name -> Q Type) -> Name -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT) ((Q Type -> Q Type) -> Name -> Q Type)
-> (Q Type -> Q Type -> Q Type) -> Q Type -> Name -> Q Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT) (Int -> Q Type
forall (m :: * -> *). Quote m => Int -> m Type
tupleT (Int -> Q Type) -> Int -> Q Type
forall a b. (a -> b) -> a -> b
$ [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Name]
vs) [Name]
vs))
	[]

vars :: [String]
vars :: [String]
vars = ((Char -> String -> String
forall a. a -> [a] -> [a]
: String
"")
	(Char -> String) -> String -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char
'a' .. Char
'z']) [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
cs String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
c] | String
cs <- [String]
vars, Char
c <- [Char
'a' .. Char
'z'] ]