{-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, TemplateHaskell, QuasiQuotes #-}

module Data.TrieMap.Regular.TH where

import Data.TrieMap.Regular.Class
import Data.TrieMap.TrieKey
import Language.Haskell.TH

deriveM :: Q [Dec] -> Q [Dec]
deriveM decs = do
	iT@(InstanceD cxt (triekeyt `AppT` f `AppT` m) _:_) <- decs
	(InstanceD _ _ myDecs:_) <- [d|
	  instance (TrieKeyT f m, Ord (f k), TrieKey k mm) => TrieKey (f k) (m k) where
		emptyM = emptyT
		nullM = nullT
		lookupM = lookupT
		lookupIxM = lookupIxT
		assocAtM = assocAtT
-- 		updateAtM = updateAtT
		alterM = alterT
		traverseWithKeyM = traverseWithKeyT
		foldWithKeyM = foldWithKeyT
		foldlWithKeyM = foldlWithKeyT
		mapEitherM = mapEitherT
		splitLookupM = splitLookupT
		unionM = unionT
		isectM = isectT
		diffM = diffT
		extractM = extractT
-- 		extractMinM = extractMinT
-- 		extractMaxM = extractMaxT
-- 		alterMinM = alterMinT
-- 		alterMaxM = alterMaxT
		isSubmapM = isSubmapT
		fromListM = fromListT
		fromAscListM = fromAscListT
		fromDistAscListM = fromDistAscListT |]
	k <- mkVar "k"
	let triekey = ConT ''TrieKey
	let triemap = ConT ''TrieMap
	let ordT = ConT ''Ord
	return (InstanceD (triekey `AppT` k `AppT` (triemap `AppT` k):ordT `AppT` (f `AppT` k):cxt)
			(triekey `AppT` (f `AppT` k) `AppT` (m `AppT` k)) myDecs:iT)

mkVar :: String -> TypeQ
mkVar x = varT =<< newName x