{-# 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