module Database.Record.InternalTH (
defineTupleInstances
) where
import Control.Applicative ((<$>))
import Data.List (foldl')
import Language.Haskell.TH
(Q, mkName, Name,
conT, varT, tupleT, appT, classP,
Dec, instanceD, )
import Database.Record.Persistable (PersistableWidth)
import Database.Record.FromSql (FromSql)
import Database.Record.ToSql (ToSql)
persistableWidth :: Int -> Q [Dec]
persistableWidth n = do
let vs = [ varT . mkName $ "a" ++ show i | i <- [1 .. n] ]
(:[]) <$> instanceD
(mapM (classP ''PersistableWidth . (:[])) vs)
[t| PersistableWidth $(foldl' appT (tupleT n) vs) |]
[]
tupleInstance2 :: Int -> Name -> Q [Dec]
tupleInstance2 n clazz = do
let vs = [ varT . mkName $ "a" ++ show i | i <- [1 .. n] ]
q = varT $ mkName "q"
(:[]) <$> instanceD
(mapM (\v -> classP clazz [q, v]) vs)
[t| $(conT clazz) $q $(foldl' appT (tupleT n) vs) |]
[]
defineTupleInstances :: Int -> Q [Dec]
defineTupleInstances n =
concat <$> sequence
[ persistableWidth n
, tupleInstance2 n ''FromSql
, tupleInstance2 n ''ToSql ]