{-# LANGUAGE UndecidableInstances, TemplateHaskell, KindSignatures, TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}

module Data.TrieMap.MultiRec.UnitMap () where

import Data.TrieMap.MultiRec.Class
import Data.TrieMap.MultiRec.Eq
import Data.TrieMap.Applicative
import Data.TrieMap.TrieKey
-- import Data.TrieMap.Rep
-- import Data.TrieMap.Rep.Instances
-- import Data.TrieMap.Rep.TH

import Control.Applicative
import Control.Arrow
-- import Control.Monad

import Data.Maybe
import Data.Monoid
import Data.Foldable
import Data.Traversable
import Generics.MultiRec

import Prelude hiding (foldr, foldl)

newtype UMap (phi :: * -> *) (r :: * -> *) ix a = UMap (Maybe a)
type instance HTrieMapT phi U = UMap phi
-- type instance HTrieMap phi (U r) = UMap phi r

-- type instance RepT (UMap phi r ix) = RepT Maybe
-- type instance Rep (UMap phi r ix a) = RepT Maybe (Rep a)
-- 
-- -- $(genRepT [d|
--   instance ReprT (UMap phi r ix) where
-- 	toRepT (UMap m) = toRepT m
-- 	fromRepT = UMap . fromRepT |])

instance HTrieKeyT phi U (UMap phi) where
	emptyH _ = UMap Nothing
	nullH _ (UMap m) = isNothing m
	sizeH _ s (UMap m) = maybe 0 s m
	lookupH _ _ (UMap m) = m
	lookupIxH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
	assocAtH _ _ _ (UMap m) = (mempty, Asc 0 U <$> m, mempty)
-- 	updateAtH _ s r f i (UMap m)
-- 		| r == (i >= 0)
-- 			= UMap (m >>= f 0 U)
-- 		| otherwise
-- 			= UMap m
	alterH _ _ f _ (UMap m) = UMap (f m)
	alterLookupH _ _ f _ (UMap m) = UMap <$> f m
	traverseWithKeyH _ _ f (UMap m) = UMap <$> traverse (f U) m
	foldWithKeyH _ f (UMap m) z = foldr (f U) z m
	foldlWithKeyH _ f (UMap m) z = foldl (f U) z m
	mapEitherH _ _ _ f (UMap m) = (UMap *** UMap) (maybe (Nothing, Nothing) (f U) m)
	splitLookupH _ _ f _ (UMap m) = UMap `sides` maybe (Nothing, Nothing, Nothing) f m
	unionH _ _ f (UMap m1) (UMap m2) = UMap (unionMaybe (f U) m1 m2)
	isectH _ _ f (UMap m1) (UMap m2) = UMap (isectMaybe (f U) m1 m2)
	diffH _ _ f (UMap m1) (UMap m2) = UMap (diffMaybe (f U) m1 m2)
	extractH _ _ f (UMap m) = maybe empty (fmap UMap <.> f U) m
-- 	extractMinH _ _ f (UMap m) = fmap (second UMap . f U) (First m)
-- 	extractMaxH _ _ f (UMap m) = fmap (second UMap . f U) (Last m)
-- 	alterMinH _ _ f (UMap m) = (UMap . f U) <$> (First m)
-- 	alterMaxH _ _ f (UMap m) = (UMap . f U) <$> (Last m)
	isSubmapH _ _ (UMap Nothing) _ = True
	isSubmapH _ (<=) (UMap m1) (UMap m2) = subMaybe (<=) m1 m2
	fromListH _ _ f xs = UMap (foldr (\ (_, a) -> Just . maybe a (f U a)) Nothing xs)
	fromAscListH = fromListH
	fromDistAscListH _ _ xs = UMap (fmap snd (listToMaybe xs))