{-# LANGUAGE UnboxedTuples, TypeFamilies #-} module Data.TrieMap.ReverseMap (reverse, unreverse) where import Data.TrieMap.TrieKey import Data.TrieMap.Modifiers import Data.TrieMap.Applicative import Control.Applicative import Prelude hiding (reverse) import qualified Data.List as L instance TrieKey k => TrieKey (Rev k) where newtype TrieMap (Rev k) a = RMap (TrieMap k a) emptyM = RMap emptyM singletonM s (Rev k) a = RMap (singletonM s k a) nullM (RMap m) = nullM m sizeM s (RMap m) = sizeM s m lookupM (Rev k) (RMap m) = lookupM k m traverseWithKeyM s f (RMap m) = RMap <$> runDual (traverseWithKeyM s (\ k a -> Dual (f (Rev k) a)) m) alterM s f (Rev k) (RMap m) = RMap (alterM s f k m) alterLookupM s f (Rev k) (RMap m) = onUnboxed RMap (alterLookupM s f k) m splitLookupM s f (Rev k) (RMap m) = sides RMap (splitLookupM s f' k) m where f' x = case f x of (# xL, ans, xR #) -> (# xR, ans, xL #) mapMaybeM s f (RMap m) = RMap (mapMaybeM s (f . Rev) m) mapEitherM s1 s2 f (RMap m) = both RMap RMap (mapEitherM s1 s2 (f . Rev)) m foldWithKeyM f (RMap m) = foldlWithKeyM (flip . f . Rev) m foldlWithKeyM f (RMap m) = foldWithKeyM (flip . f . Rev) m unionM s f (RMap m1) (RMap m2) = RMap (unionM s (f . Rev) m1 m2) isectM s f (RMap m1) (RMap m2) = RMap (isectM s (f . Rev) m1 m2) diffM s f (RMap m1) (RMap m2) = RMap (diffM s (f . Rev) m1 m2) extractM s f (RMap m) = fmap RMap <$> runDual (extractM s (\ k a -> Dual (f (Rev k) a)) m) isSubmapM (<=) (RMap m1) (RMap m2) = isSubmapM (<=) m1 m2 fromListM s f xs = RMap (fromListM s (f . Rev) [(k, a) | (Rev k, a) <- xs]) fromAscListM s f xs = RMap (fromAscListM s (\ k -> flip (f (Rev k))) [(k, a) | (Rev k, a) <- L.reverse xs]) fromDistAscListM s xs = RMap (fromDistAscListM s [(k, a) | (Rev k, a) <- L.reverse xs]) reverse :: TrieMap k a -> TrieMap (Rev k) a reverse = RMap unreverse :: TrieMap (Rev k) a -> TrieMap k a unreverse (RMap m) = m