{-# LANGUAGE TypeFamilies, UnboxedTuples #-}

module Data.TrieMap.UnitMap where

import Data.TrieMap.TrieKey

import Control.Applicative

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

import Prelude hiding (foldr, foldl)

instance TrieKey () where
	newtype TrieMap () a = Unit {getUnit :: Maybe a}
	emptyM = Unit Nothing
	singletonM _ _ = Unit . Just
	nullM = isNothing . getUnit
	sizeM s = maybe 0 s . getUnit
	lookupM _ (Unit m) = m
	traverseWithKeyM _ f (Unit m) = Unit <$> traverse (f ()) m
	foldWithKeyM f (Unit m) z = foldr (f ()) z m
	foldlWithKeyM f (Unit m) z = foldl (f ()) z m
	mapMaybeM _ f (Unit m) = Unit (m >>= f ())
	mapEitherM _ _ f (Unit (Just a)) = both Unit Unit (f ()) a
	mapEitherM _ _ _ _ = (# emptyM, emptyM #)
	splitLookupM _ f _ (Unit (Just a)) = sides Unit f a
	splitLookupM _ _ _ _ = (# emptyM, Nothing, emptyM #)
	alterM _ f _ (Unit m) = Unit (f m)
	alterLookupM _ f _ (Unit m) = onUnboxed Unit f m
	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)
	extractM _ f (Unit m) = maybe empty (fmap (fmap Unit) . f ()) m
	isSubmapM (<=) (Unit m1) (Unit m2) = subMaybe (<=) m1 m2
	fromListM _ _ [] = Unit Nothing
	fromListM _ f ((_, v):xs) = Unit $ Just (foldl (\ v' -> f () v' . snd) v xs)