{-# LANGUAGE TypeFamilies, UnboxedTuples, MagicHash #-}

module Data.TrieMap.UnitMap where

import Data.TrieMap.TrieKey
import Data.TrieMap.Sized

import Control.Applicative
import Control.Monad

import Data.Foldable
import Data.Traversable
import Data.Maybe

import Prelude hiding (foldr, foldl)

instance TrieKey () where
	newtype TrieMap () a = Unit {getUnit :: Maybe a}
	data Hole () a = Hole
	
	emptyM = Unit Nothing
	singletonM _ = Unit . Just
	nullM = isNothing . getUnit
	sizeM (Unit (Just a)) = getSize# a
	sizeM _ = 0#
	lookupM _ (Unit m) = m
	traverseWithKeyM f (Unit m) = Unit <$> traverse (f ()) m
	foldrWithKeyM f (Unit m) z = foldr (f ()) z m
	foldlWithKeyM f (Unit m) z = foldl (f ()) z m
	mapWithKeyM f (Unit m) = Unit (f () <$> m)
	mapMaybeM f (Unit m) = Unit (m >>= f ())
	mapEitherM f (Unit (Just a)) = both Unit Unit (f ()) a
	mapEitherM _ _ = (# emptyM, emptyM #)
	unionM f (Unit m1) (Unit m2) = Unit (unionMaybe (f ()) m1 m2)
	isectM f (Unit m1) (Unit m2) = Unit (isectMaybe (f ()) m1 m2)
	diffM f (Unit m1) (Unit m2) = Unit (diffMaybe (f ()) m1 m2)
	isSubmapM (<=) (Unit m1) (Unit m2) = subMaybe (<=) m1 m2
	fromListM _ [] = Unit Nothing
	fromListM f ((_, v):xs) = Unit $ Just (foldl (\ v' -> f () v' . snd) v xs)
	
	singleHoleM _ = Hole
	keyM _ = ()
	beforeM a _ = Unit a
	afterM a _ = Unit a
	searchM _ (Unit m) = (# m, Hole #)

	indexM i (Unit (Just v)) = (# i, v, Hole #)
	indexM _ _ = (# error err, error err, error err #) where
		err = "Error: empty trie"
	
	extractHoleM (Unit (Just v)) = return (v, Hole)
	extractHoleM _ = mzero
	
	assignM v _ = Unit (Just v)
	clearM _ = emptyM