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

module Data.TrieMap.ReverseMap (reverse, unreverse) where

import Data.TrieMap.TrieKey
import Data.TrieMap.Sized
import Data.TrieMap.Modifiers
import Data.TrieMap.Applicative

import Control.Applicative

import Prelude hiding (reverse)
import qualified Data.List as L

import GHC.Exts

instance TrieKey k => TrieKey (Rev k) where
	newtype TrieMap (Rev k) a = RMap (TrieMap k a)
	newtype Hole (Rev k) a = RHole (Hole k a)
	emptyM = RMap emptyM
	singletonM (Rev k) a = RMap (singletonM k a)
	nullM (RMap m) = nullM m
	sizeM (RMap m) = sizeM m
	lookupM (Rev k) (RMap m) = lookupM k m
	mapWithKeyM f (RMap m) = RMap (mapWithKeyM (f . Rev) m)
	traverseWithKeyM f (RMap m) = RMap <$> runDual (traverseWithKeyM g m)
		where g k a = Dual (f (Rev k) a)
	mapMaybeM f (RMap m) = RMap (mapMaybeM (f . Rev) m)
	mapEitherM f (RMap m) = both RMap RMap (mapEitherM (f . Rev)) m
	foldrWithKeyM f (RMap m) = foldlWithKeyM (flip . f . Rev) m
	foldlWithKeyM f (RMap m) = foldrWithKeyM (flip . f . Rev) m
	unionM f (RMap m1) (RMap m2) = RMap (unionM (f . Rev) m1 m2)
	isectM f (RMap m1) (RMap m2) = RMap (isectM (f . Rev) m1 m2)
	diffM f (RMap m1) (RMap m2) = RMap (diffM (f . Rev) m1 m2)
	isSubmapM (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2
	fromListM f xs = RMap (fromListM (f . Rev) [(k, a) | (Rev k, a) <- xs])
	fromAscListM f xs = RMap (fromAscListM (\ k a1 a2 -> f (Rev k) a2 a1) [(k, a) | (Rev k, a) <- L.reverse xs])
	fromDistAscListM xs = RMap (fromDistAscListM [(k, a) | (Rev k, a) <- L.reverse xs])

	singleHoleM (Rev k) = RHole (singleHoleM k)
	keyM (RHole hole) = Rev (keyM hole)
	beforeM a (RHole hole) = RMap (afterM a hole)
	afterM a (RHole hole) = RMap (beforeM a hole)
	searchM (Rev k) (RMap m) = onUnboxed RHole (searchM k) m
	indexM i# (RMap m) = case indexM (sm# -# 1# -# i#) m of
		(# i'#, v, hole #) -> (# getSize# v -# 1# -# i'#, v, RHole hole #)
		where !sm# = sizeM m
	extractHoleM (RMap m) = do
		(v, hole) <- runDualPlus (extractHoleM m)
		return (v, RHole hole)
	assignM x (RHole hole) = RMap (assignM x hole)
	clearM (RHole hole) = RMap (clearM hole)

reverse :: TrieMap k a -> TrieMap (Rev k) a
reverse = RMap

unreverse :: TrieMap (Rev k) a -> TrieMap k a
unreverse (RMap m) = m