{-# LANGUAGE TypeOperators, TypeFamilies, FlexibleContexts, UndecidableInstances #-}

module TrieMap.Reflection where

-- import TrieMap.Fixpoint
import TrieMap.MapTypes
import TrieMap.TrieAlgebraic
import TrieMap.Algebraic
import TrieMap.Applicative
import TrieMap.RadixTrie()
import qualified TrieMap.TrieAlgebraic as TA

instance Algebraic v => Algebraic (Elem v) where
	type AlgRep (Elem v) = AlgRep v
	toAlg (Elem v) = toAlg v
	fromAlg v = Elem (fromAlg v)

-- instance Algebraic (t1 k (m2 v)) => Algebraic (ProdMap m1 m2 v) where
-- 	type AlgRep (ProdMap m1 m2 v) = AlgRep (m1 (m2 v))
-- 	toAlg (PMap m) = toAlg m
-- 	fromAlg = PMap . fromAlg
-- 
-- instance (Ord k, Algebraic k, Sized v, Algebraic v, TrieKey k m) => Algebraic (RadixTrie k m v) where
-- 	type AlgRep (RadixTrie k m v) = AlgRep [([k], v)]
-- 	toAlg m = toAlg (build (\ c n -> foldWithKeyAlg (curry c) n m))
-- 	fromAlg = fromDistAscListAlg . fromAlg

instance (Algebraic k, TrieKey k m) => SAlgebraicT (RadixTrie k m) where
	type SAlgRepT (RadixTrie k m) = AlgRepT ([] `O` ((,) [k]))
	toSAlgT = toAlgT . o . assocsAlg
	fromSAlgT = fromDistAscListAlg . unO . fromAlgT

-- instance (AlgebraicT m, Algebraic k) => SAlgebraicT (Edge k m) where
-- 	type SAlgRepT (Edge k m) = AlgRepT (O Fix (O ((:*:) (Const Int :*: Co{--}nst [k] :*: AlgRepT m)) (O Const Maybe)))


instance (AlgebraicT m, Algebraic k,  Algebraic a) => Algebraic (Edge k m a) where
	type AlgRep (Edge k m a) = Fix (AlgRepT (Const (Int, [k], Maybe a)) :*: AlgRepT m)
	toAlg (Edge s ks v ts) = Fix (toAlgT (Const (s, ks, v)) :*: fmap toAlg (toAlgT ts))
	fromAlg (Fix (a :*: b)) = case (fromAlgT a, fmap fromAlg b) of
		(Const (s, ks, v), ts) ->
			Edge s ks v (fromAlgT ts)

instance (AlgebraicT m, Algebraic k, Algebraic a) => Algebraic (RadixTrie k m a) where
	type AlgRep (RadixTrie k m a) = AlgRep (Maybe (Edge k m a))
	toAlg (Radix e) = toAlg e
	fromAlg = Radix . fromAlg