{-# LANGUAGE TemplateHaskell #-}

module Data.TrieMap.Representation.TH  where

import Data.TrieMap.Rep.TH
import Data.TrieMap.Rep
import Data.TrieMap.Regular.Base
import Language.Haskell.TH
import Control.Arrow
import Control.Monad

type RepInfo = (Q Type, Q Exp, Q Exp)
	-- RepInfo t = (t', t -> t', t' -> t)
-- inferRepresentation :: Name -> String -> Q [Dec]
-- inferRepresentation k kRepName = do

-- conToMatch :: Name -> Int -> Q Match
-- conToMatch con [] = return (Match (ConP con []) (NormalB (ConE ''U0)) [])
-- conToMatch con ts = 
-- 	do	varTs <- replicateM ts (newName "a")
-- 		let pat = ConP con (map (VarP . fst) varTs)
-- 		
-- 		let bod = NormalB (prod [ConE 'toRep `AppE` (VarE x) | (x, _) <- varTs])
-- 		return (Match pat bod [])
-- 	where	prod [x] = x
-- 		prod (x:xs) = ConE (mkName ":*:") `AppE` x `AppE` prod xs
-- 
-- infixConToMatch :: Name -> Q Match
-- infixConToMatch con = do
-- 	a <- newName "a"
-- 	b <- newName "b"
-- 	let ae = varE a
-- 	let be = varE b
-- 	b <- [| toRep $ae :*: toRep $be |]
-- 	return (Match (InfixP (VarP a) con (VarP b)) (NormalB b) [])

-- conToRep :: Type -> [Type] -> RepInfo
-- conToRep _ [] = (conT ''U0, [| const U0 |], [| const U0 |])
-- conToRep t [x]
-- 	| x == t	= (conT ''I0, [| I0 |], [| unI0 |])
-- 	| otherwise	= (conT ''K0 `appT` x, [| K0 |], [| unK0 |])
-- conToRep t (arg0:args) = case conToRep t args of
-- 	(tArgs, toArgs, fromArgs)
-- 		| arg0 == t	-> (conT '':*: `appT` conT ''I0 `appT` tArgs, [| \ (a, b) -> (I0 a, $toArgs b) |],
-- 		 			[| \ (I0 a, b) -> (a, $fromArgs b) |])
-- 		| otherwise	-> (conT '':*: `appT` (conT ''K0 `appT` 
-- 	where	toTuple [(_, x), (_, y)] = TupleT 2 `AppT` x `AppT` y
-- 		
-- 
-- product :: Q Exp -> Q Exp -> RepInfo -> RepInfo -> RepInfo
-- product inj outj (t1, to1, from1) (t2, to2, from2) = 
-- 	(tupleT 2 `appT` t1 `appT` t2,
-- 		[| ($to1 *** $to2) . $outj |],
-- 		[| $inj . ($from1 *** $from2) |])
-- 
-- sum :: Q Exp -> Q Exp -> RepInfo -> RepInfo -> RepInfo
-- sum inj outj (t1, to1, from1) (t2, to2, from2) = 
-- 	(conT ''Either `appT` t1 `appT` t2,
-- 		[| ($to1 +++ $to2) . $outj |],
-- 		[| $inj ($from1 +++ $from2) |])
-- repInstances :: Set Name
-- repInstances = fromList [''Int, ''Bool, ''Char, ''Double, ''Int, ''Int8, ''Int16, ''Int32, ''Int64, ''Word, ''Word8,
-- 	''Word16, ''Word32, ''Word64, ''(), ''ByteString, ''IntSet,