{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, TemplateHaskell, QuasiQuotes, UndecidableInstances #-}

module Data.TrieMap.Rep.TH where

import Language.Haskell.TH
import Data.TrieMap.Rep

genRepr :: Q Type -> Q [Dec]
genRepr typ = do
  t <- typ
  let a = VarT (mkName "a")
  toRepImpl <- [| toRepTMap toRep |]
  fromRepImpl <- [| fromRepTMap fromRep |]
  return [InstanceD [ClassP ''Repr [a]]
		(ConT ''Repr `AppT` (t `AppT` a))
		[TySynInstD ''Rep [t `AppT` a] ((ConT ''RepT `AppT` t) `AppT` (ConT ''Rep `AppT` a)),
			ValD (VarP 'toRep)
				(NormalB toRepImpl) [],
			ValD (VarP 'fromRep)
				(NormalB fromRepImpl) []]]

genTupleRepr :: Int -> Q [Dec]
genTupleRepr n = do
  let ts = [mkName [a] | a <- take n ['a'..]]
  xs <- sequence [newName [a] | a <- take n ['a'..]]
  xReps <- sequence [newName (a:"Rep") | a <- take n ['a'..]]
  let toR = 'toRep
  let fromR = 'fromRep
  let tupleT = foldl AppT (TupleT n) [VarT t | t <- ts]
  return [InstanceD [ClassP ''Repr [VarT t] | t <- ts]
    (ConT ''Repr `AppT` tupleT)
    [TySynInstD ''Rep [tupleT] (foldl AppT (TupleT n) [ConT ''Rep `AppT` VarT t | t <- ts]),
	FunD toR
	  [Clause [TupP [VarP x | x <- xs]]
	    (NormalB (TupE [VarE toR `AppE` VarE x |  x <- xs])) []],
	FunD fromR
	  [Clause [TupP [VarP xRep | xRep <- xReps]]
	    (NormalB (TupE [VarE fromR `AppE` VarE xRep | xRep <- xReps])) []]]]