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

module Data.TrieMap.Regular.Rep where

import Data.TrieMap.Rep
import Data.TrieMap.Rep.TH
import Data.TrieMap.Regular.Base

type instance RepT (K0 a) = K0 (Rep a)
type instance RepT I0 = I0
type instance RepT U0 = U0
type instance RepT (L f) = L (RepT f)
type instance RepT (f :*: g) = RepT f :*: RepT g
type instance RepT (f :+: g) = RepT f :+: RepT g
type instance RepT (f `O` g) = RepT f `O` RepT g

type instance Rep (K0 a b) = RepT (K0 a) b
type instance Rep (I0 a) = I0 (Rep a)
type instance Rep (U0 a) = U0 a
type instance Rep (L f a) = L (RepT f) (Rep a)
type instance Rep ((f :*: g) a) = RepT (f :*: g) (Rep a)
type instance Rep ((f :+: g) a) = RepT (f :+: g) (Rep a)
type instance Rep ((f `O` g) a) = RepT (f `O` g) (Rep a)
type instance Rep (Fix f) = Fix (RepT f)

instance Repr a => ReprT (K0 a) where
	toRepTMap _ (K0 a) = K0 (toRep a)
	fromRepTMap _ (K0 a) = K0 (fromRep a)

instance Repr a => Repr (K0 a b) where
	toRep = toRepT
	fromRep = fromRepT

$(genRepT [d|
   instance ReprT I0 where
	toRepTMap = fmap
	fromRepTMap = fmap |])

instance ReprT U0 where
	toRepTMap _ _ = U0
	fromRepTMap _ _ = U0

instance Repr (U0 a) where
	toRep _ = U0
	fromRep _ = U0

$(genRepT [d|
   instance ReprT f => ReprT (L f) where
	toRepTMap f (List xs) = List (map (toRepTMap f) xs)
	fromRepTMap f (List xs) = List (map (fromRepTMap f) xs) |])

$(genRepT [d|
   instance (ReprT f, ReprT g) => ReprT (f :*: g) where
	toRepTMap f (x :*: y) = toRepTMap f x :*: toRepTMap f y
	fromRepTMap f (x :*: y) = fromRepTMap f x :*: fromRepTMap f y |])

$(genRepT [d|
   instance (ReprT f, ReprT g) => ReprT (f :+: g) where
	toRepTMap f (L a) = L (toRepTMap f a)
	toRepTMap f (R b) = R (toRepTMap f b)
	fromRepTMap f (L a) = L (fromRepTMap f a)
	fromRepTMap f (R b) = R (fromRepTMap f b) |])

$(genRepT [d|
   instance (ReprT f, ReprT g) => ReprT (f `O` g) where
	toRepTMap f (O x) = O (toRepTMap (toRepTMap f) x)
	fromRepTMap f (O x) = O (fromRepTMap (fromRepTMap f) x) |])

instance ReprT f => Repr (Fix f) where
	toRep (In x) = In (toRepTMap toRep x)
	fromRep (In x) = In (fromRepTMap fromRep x)