{-# LANGUAGE CPP #-} module Data.IntMap.CharMap2 where #ifdef __GLASGOW_HASKELL__ import GHC.Base(unsafeChr) #else import Data.Char (chr) #endif import Data.Char as C(ord) import Data.List as L (map) import qualified Data.IntMap as M #if MIN_VERSION_containers(0,5,11) import qualified Data.IntMap.Internal.Debug as MD #else import qualified Data.IntMap as MD #endif import qualified Data.IntSet as S(IntSet) import Data.Semigroup as Sem #ifndef __GLASGOW_HASKELL__ unsafeChr = chr #endif newtype CharMap a = CharMap {forall a. CharMap a -> IntMap a unCharMap :: M.IntMap a} deriving (CharMap a -> CharMap a -> Bool (CharMap a -> CharMap a -> Bool) -> (CharMap a -> CharMap a -> Bool) -> Eq (CharMap a) forall a. Eq a => CharMap a -> CharMap a -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: forall a. Eq a => CharMap a -> CharMap a -> Bool == :: CharMap a -> CharMap a -> Bool $c/= :: forall a. Eq a => CharMap a -> CharMap a -> Bool /= :: CharMap a -> CharMap a -> Bool Eq,Eq (CharMap a) Eq (CharMap a) => (CharMap a -> CharMap a -> Ordering) -> (CharMap a -> CharMap a -> Bool) -> (CharMap a -> CharMap a -> Bool) -> (CharMap a -> CharMap a -> Bool) -> (CharMap a -> CharMap a -> Bool) -> (CharMap a -> CharMap a -> CharMap a) -> (CharMap a -> CharMap a -> CharMap a) -> Ord (CharMap a) CharMap a -> CharMap a -> Bool CharMap a -> CharMap a -> Ordering CharMap a -> CharMap a -> CharMap a forall a. Eq a => (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a forall a. Ord a => Eq (CharMap a) forall a. Ord a => CharMap a -> CharMap a -> Bool forall a. Ord a => CharMap a -> CharMap a -> Ordering forall a. Ord a => CharMap a -> CharMap a -> CharMap a $ccompare :: forall a. Ord a => CharMap a -> CharMap a -> Ordering compare :: CharMap a -> CharMap a -> Ordering $c< :: forall a. Ord a => CharMap a -> CharMap a -> Bool < :: CharMap a -> CharMap a -> Bool $c<= :: forall a. Ord a => CharMap a -> CharMap a -> Bool <= :: CharMap a -> CharMap a -> Bool $c> :: forall a. Ord a => CharMap a -> CharMap a -> Bool > :: CharMap a -> CharMap a -> Bool $c>= :: forall a. Ord a => CharMap a -> CharMap a -> Bool >= :: CharMap a -> CharMap a -> Bool $cmax :: forall a. Ord a => CharMap a -> CharMap a -> CharMap a max :: CharMap a -> CharMap a -> CharMap a $cmin :: forall a. Ord a => CharMap a -> CharMap a -> CharMap a min :: CharMap a -> CharMap a -> CharMap a Ord,ReadPrec [CharMap a] ReadPrec (CharMap a) Int -> ReadS (CharMap a) ReadS [CharMap a] (Int -> ReadS (CharMap a)) -> ReadS [CharMap a] -> ReadPrec (CharMap a) -> ReadPrec [CharMap a] -> Read (CharMap a) forall a. Read a => ReadPrec [CharMap a] forall a. Read a => ReadPrec (CharMap a) forall a. Read a => Int -> ReadS (CharMap a) forall a. Read a => ReadS [CharMap a] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a $creadsPrec :: forall a. Read a => Int -> ReadS (CharMap a) readsPrec :: Int -> ReadS (CharMap a) $creadList :: forall a. Read a => ReadS [CharMap a] readList :: ReadS [CharMap a] $creadPrec :: forall a. Read a => ReadPrec (CharMap a) readPrec :: ReadPrec (CharMap a) $creadListPrec :: forall a. Read a => ReadPrec [CharMap a] readListPrec :: ReadPrec [CharMap a] Read,Int -> CharMap a -> ShowS [CharMap a] -> ShowS CharMap a -> String (Int -> CharMap a -> ShowS) -> (CharMap a -> String) -> ([CharMap a] -> ShowS) -> Show (CharMap a) forall a. Show a => Int -> CharMap a -> ShowS forall a. Show a => [CharMap a] -> ShowS forall a. Show a => CharMap a -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: forall a. Show a => Int -> CharMap a -> ShowS showsPrec :: Int -> CharMap a -> ShowS $cshow :: forall a. Show a => CharMap a -> String show :: CharMap a -> String $cshowList :: forall a. Show a => [CharMap a] -> ShowS showList :: [CharMap a] -> ShowS Show) instance Sem.Semigroup (CharMap a) where CharMap IntMap a x <> :: CharMap a -> CharMap a -> CharMap a <> CharMap IntMap a y = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (IntMap a x IntMap a -> IntMap a -> IntMap a forall a. Monoid a => a -> a -> a `mappend` IntMap a y) instance Monoid (CharMap a) where mempty :: CharMap a mempty = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a forall a. Monoid a => a mempty mappend :: CharMap a -> CharMap a -> CharMap a mappend = CharMap a -> CharMap a -> CharMap a forall a. Semigroup a => a -> a -> a (<>) instance Functor CharMap where fmap :: forall a b. (a -> b) -> CharMap a -> CharMap b fmap a -> b f (CharMap IntMap a m) = IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap ((a -> b) -> IntMap a -> IntMap b forall a b. (a -> b) -> IntMap a -> IntMap b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap a -> b f IntMap a m) type Key = Char (!) :: CharMap a -> Key -> a ! :: forall a. CharMap a -> Key -> a (!) (CharMap IntMap a m) Key k = IntMap a -> Int -> a forall a. IntMap a -> Int -> a (M.!) IntMap a m (Key -> Int C.ord Key k) (\\) :: CharMap a -> CharMap b -> CharMap a \\ :: forall a b. CharMap a -> CharMap b -> CharMap a (\\) (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (IntMap a -> IntMap b -> IntMap a forall a b. IntMap a -> IntMap b -> IntMap a (M.\\) IntMap a m1 IntMap b m2) null :: CharMap a -> Bool null :: forall a. CharMap a -> Bool null (CharMap IntMap a m) = IntMap a -> Bool forall a. IntMap a -> Bool M.null IntMap a m size :: CharMap a -> Int size :: forall a. CharMap a -> Int size (CharMap IntMap a m) = IntMap a -> Int forall a. IntMap a -> Int M.size IntMap a m member :: Key -> CharMap a -> Bool member :: forall a. Key -> CharMap a -> Bool member Key k (CharMap IntMap a m) = Int -> IntMap a -> Bool forall a. Int -> IntMap a -> Bool M.member (Key -> Int C.ord Key k) IntMap a m notMember :: Key -> CharMap a -> Bool notMember :: forall a. Key -> CharMap a -> Bool notMember Key k (CharMap IntMap a m) = Int -> IntMap a -> Bool forall a. Int -> IntMap a -> Bool M.notMember (Key -> Int C.ord Key k) IntMap a m lookup :: Key -> CharMap a -> Maybe a lookup :: forall a. Key -> CharMap a -> Maybe a lookup Key k (CharMap IntMap a m) = Int -> IntMap a -> Maybe a forall a. Int -> IntMap a -> Maybe a M.lookup (Key -> Int C.ord Key k) IntMap a m findWithDefault :: a -> Key -> CharMap a -> a findWithDefault :: forall a. a -> Key -> CharMap a -> a findWithDefault a a Key k (CharMap IntMap a m) = a -> Int -> IntMap a -> a forall a. a -> Int -> IntMap a -> a M.findWithDefault a a (Key -> Int C.ord Key k) IntMap a m empty :: CharMap a empty :: forall a. CharMap a empty = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a forall a. IntMap a M.empty singleton :: Key -> a -> CharMap a singleton :: forall a. Key -> a -> CharMap a singleton Key k a a = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (Int -> a -> IntMap a forall a. Int -> a -> IntMap a M.singleton (Key -> Int C.ord Key k) a a) insert :: Key -> a -> CharMap a -> CharMap a insert :: forall a. Key -> a -> CharMap a -> CharMap a insert Key k a a (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (Int -> a -> IntMap a -> IntMap a forall a. Int -> a -> IntMap a -> IntMap a M.insert (Key -> Int C.ord Key k) a a IntMap a m) insertWith :: (a -> a -> a) -> Key -> a -> CharMap a -> CharMap a insertWith :: forall a. (a -> a -> a) -> Key -> a -> CharMap a -> CharMap a insertWith a -> a -> a f Key k a a (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a -> a) -> Int -> a -> IntMap a -> IntMap a forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a M.insertWith a -> a -> a f (Key -> Int C.ord Key k) a a IntMap a m) insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> CharMap a -> CharMap a insertWithKey :: forall a. (Key -> a -> a -> a) -> Key -> a -> CharMap a -> CharMap a insertWithKey Key -> a -> a -> a f Key k a a (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a M.insertWithKey Int -> a -> a -> a f' (Key -> Int C.ord Key k) a a IntMap a m) where f' :: Int -> a -> a -> a f' Int b a a1 a a2 = Key -> a -> a -> a f (Int -> Key unsafeChr Int b) a a1 a a2 insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> CharMap a -> (Maybe a, CharMap a) insertLookupWithKey :: forall a. (Key -> a -> a -> a) -> Key -> a -> CharMap a -> (Maybe a, CharMap a) insertLookupWithKey Key -> a -> a -> a f Key k a a (CharMap IntMap a m) = (Maybe a ma,IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m') where (Maybe a ma,IntMap a m') = (Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a) forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a) M.insertLookupWithKey Int -> a -> a -> a f' (Key -> Int C.ord Key k) a a IntMap a m f' :: Int -> a -> a -> a f' Int b a a1 a a2 = Key -> a -> a -> a f (Int -> Key unsafeChr Int b) a a1 a a2 delete :: Key -> CharMap a -> CharMap a delete :: forall a. Key -> CharMap a -> CharMap a delete Key k (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (Int -> IntMap a -> IntMap a forall a. Int -> IntMap a -> IntMap a M.delete (Key -> Int C.ord Key k) IntMap a m) adjust :: (a -> a) -> Key -> CharMap a -> CharMap a adjust :: forall a. (a -> a) -> Key -> CharMap a -> CharMap a adjust a -> a f Key k (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a) -> Int -> IntMap a -> IntMap a forall a. (a -> a) -> Int -> IntMap a -> IntMap a M.adjust a -> a f (Key -> Int C.ord Key k) IntMap a m) adjustWithKey :: (Key -> a -> a) -> Key -> CharMap a -> CharMap a adjustWithKey :: forall a. (Key -> a -> a) -> Key -> CharMap a -> CharMap a adjustWithKey Key -> a -> a f Key k (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> a) -> Int -> IntMap a -> IntMap a forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a M.adjustWithKey Int -> a -> a f' (Key -> Int C.ord Key k) IntMap a m) where f' :: Int -> a -> a f' Int b a a = Key -> a -> a f (Int -> Key unsafeChr Int b) a a update :: (a -> Maybe a) -> Key -> CharMap a -> CharMap a update :: forall a. (a -> Maybe a) -> Key -> CharMap a -> CharMap a update a -> Maybe a f Key k (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> Maybe a) -> Int -> IntMap a -> IntMap a forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a M.update a -> Maybe a f (Key -> Int C.ord Key k) IntMap a m) updateWithKey :: (Key -> a -> Maybe a) -> Key -> CharMap a -> CharMap a updateWithKey :: forall a. (Key -> a -> Maybe a) -> Key -> CharMap a -> CharMap a updateWithKey Key -> a -> Maybe a f Key k (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a M.updateWithKey Int -> a -> Maybe a f' (Key -> Int C.ord Key k) IntMap a m) where f' :: Int -> a -> Maybe a f' Int b a a = Key -> a -> Maybe a f (Int -> Key unsafeChr Int b) a a updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> CharMap a -> (Maybe a, CharMap a) updateLookupWithKey :: forall a. (Key -> a -> Maybe a) -> Key -> CharMap a -> (Maybe a, CharMap a) updateLookupWithKey Key -> a -> Maybe a f Key k (CharMap IntMap a m) = (Maybe a a,IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m') where (Maybe a a,IntMap a m') = (Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a) forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a) M.updateLookupWithKey Int -> a -> Maybe a f' (Key -> Int C.ord Key k) IntMap a m f' :: Int -> a -> Maybe a f' Int b a a1 = Key -> a -> Maybe a f (Int -> Key unsafeChr Int b) a a1 union :: CharMap a -> CharMap a -> CharMap a union :: forall a. CharMap a -> CharMap a -> CharMap a union (CharMap IntMap a m1) (CharMap IntMap a m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (IntMap a -> IntMap a -> IntMap a forall a. IntMap a -> IntMap a -> IntMap a M.union IntMap a m1 IntMap a m2) unionWith :: (a -> a -> a) -> CharMap a -> CharMap a -> CharMap a unionWith :: forall a. (a -> a -> a) -> CharMap a -> CharMap a -> CharMap a unionWith a -> a -> a f (CharMap IntMap a m1) (CharMap IntMap a m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a -> a) -> IntMap a -> IntMap a -> IntMap a forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a M.unionWith a -> a -> a f IntMap a m1 IntMap a m2) unionWithKey :: (Key -> a -> a -> a) -> CharMap a -> CharMap a -> CharMap a unionWithKey :: forall a. (Key -> a -> a -> a) -> CharMap a -> CharMap a -> CharMap a unionWithKey Key -> a -> a -> a f (CharMap IntMap a m1) (CharMap IntMap a m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a forall a. (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a M.unionWithKey Int -> a -> a -> a f' IntMap a m1 IntMap a m2) where f' :: Int -> a -> a -> a f' Int b a a1 a a2 = Key -> a -> a -> a f (Int -> Key unsafeChr Int b) a a1 a a2 unions :: [CharMap a] -> CharMap a unions :: forall a. [CharMap a] -> CharMap a unions [CharMap a] cs = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ([IntMap a] -> IntMap a forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a M.unions ((CharMap a -> IntMap a) -> [CharMap a] -> [IntMap a] forall a b. (a -> b) -> [a] -> [b] L.map CharMap a -> IntMap a forall a. CharMap a -> IntMap a unCharMap [CharMap a] cs)) unionsWith :: (a -> a -> a) -> [CharMap a] -> CharMap a unionsWith :: forall a. (a -> a -> a) -> [CharMap a] -> CharMap a unionsWith a -> a -> a f [CharMap a] cs = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a -> a) -> [IntMap a] -> IntMap a forall (f :: * -> *) a. Foldable f => (a -> a -> a) -> f (IntMap a) -> IntMap a M.unionsWith a -> a -> a f ((CharMap a -> IntMap a) -> [CharMap a] -> [IntMap a] forall a b. (a -> b) -> [a] -> [b] L.map CharMap a -> IntMap a forall a. CharMap a -> IntMap a unCharMap [CharMap a] cs)) difference :: CharMap a -> CharMap b -> CharMap a difference :: forall a b. CharMap a -> CharMap b -> CharMap a difference (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (IntMap a -> IntMap b -> IntMap a forall a b. IntMap a -> IntMap b -> IntMap a M.difference IntMap a m1 IntMap b m2) differenceWith :: (a -> b -> Maybe a) -> CharMap a -> CharMap b -> CharMap a differenceWith :: forall a b. (a -> b -> Maybe a) -> CharMap a -> CharMap b -> CharMap a differenceWith a -> b -> Maybe a f (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a M.differenceWith a -> b -> Maybe a f IntMap a m1 IntMap b m2) differenceWithKey :: (Key -> a -> b -> Maybe a) -> CharMap a -> CharMap b -> CharMap a differenceWithKey :: forall a b. (Key -> a -> b -> Maybe a) -> CharMap a -> CharMap b -> CharMap a differenceWithKey Key -> a -> b -> Maybe a f (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a forall a b. (Int -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a M.differenceWithKey Int -> a -> b -> Maybe a f' IntMap a m1 IntMap b m2) where f' :: Int -> a -> b -> Maybe a f' Int b a a1 b a2 = Key -> a -> b -> Maybe a f (Int -> Key unsafeChr Int b) a a1 b a2 intersection :: CharMap a -> CharMap b -> CharMap a intersection :: forall a b. CharMap a -> CharMap b -> CharMap a intersection (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap (IntMap a -> IntMap b -> IntMap a forall a b. IntMap a -> IntMap b -> IntMap a M.intersection IntMap a m1 IntMap b m2) intersectionWith :: (a -> b -> a) -> CharMap a -> CharMap b -> CharMap a intersectionWith :: forall a b. (a -> b -> a) -> CharMap a -> CharMap b -> CharMap a intersectionWith a -> b -> a f (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> b -> a) -> IntMap a -> IntMap b -> IntMap a forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c M.intersectionWith a -> b -> a f IntMap a m1 IntMap b m2) intersectionWithKey :: (Key -> a -> b -> a) -> CharMap a -> CharMap b -> CharMap a intersectionWithKey :: forall a b. (Key -> a -> b -> a) -> CharMap a -> CharMap b -> CharMap a intersectionWithKey Key -> a -> b -> a f (CharMap IntMap a m1) (CharMap IntMap b m2) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> b -> a) -> IntMap a -> IntMap b -> IntMap a forall a b c. (Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c M.intersectionWithKey Int -> a -> b -> a f' IntMap a m1 IntMap b m2) where f' :: Int -> a -> b -> a f' Int b a a1 b a2 = Key -> a -> b -> a f (Int -> Key unsafeChr Int b) a a1 b a2 map :: (a -> b) -> CharMap a -> CharMap b map :: forall a b. (a -> b) -> CharMap a -> CharMap b map a -> b f (CharMap IntMap a m) = IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap ((a -> b) -> IntMap a -> IntMap b forall a b. (a -> b) -> IntMap a -> IntMap b M.map a -> b f IntMap a m) mapWithKey :: (Key -> a -> b) -> CharMap a -> CharMap b mapWithKey :: forall a b. (Key -> a -> b) -> CharMap a -> CharMap b mapWithKey Key -> a -> b f (CharMap IntMap a m) = IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap ((Int -> a -> b) -> IntMap a -> IntMap b forall a b. (Int -> a -> b) -> IntMap a -> IntMap b M.mapWithKey Int -> a -> b f' IntMap a m) where f' :: Int -> a -> b f' Int b a a = Key -> a -> b f (Int -> Key unsafeChr Int b) a a mapAccum :: (a -> b -> (a, c)) -> a -> CharMap b -> (a, CharMap c) mapAccum :: forall a b c. (a -> b -> (a, c)) -> a -> CharMap b -> (a, CharMap c) mapAccum a -> b -> (a, c) f a a (CharMap IntMap b m) = (a a',IntMap c -> CharMap c forall a. IntMap a -> CharMap a CharMap IntMap c m') where (a a',IntMap c m') = (a -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c) forall a b c. (a -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c) M.mapAccum a -> b -> (a, c) f a a IntMap b m mapAccumWithKey :: (a -> Key -> b -> (a, c)) -> a -> CharMap b -> (a, CharMap c) mapAccumWithKey :: forall a b c. (a -> Key -> b -> (a, c)) -> a -> CharMap b -> (a, CharMap c) mapAccumWithKey a -> Key -> b -> (a, c) f a a (CharMap IntMap b m) = (a a',IntMap c -> CharMap c forall a. IntMap a -> CharMap a CharMap IntMap c m') where (a a',IntMap c m') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c) forall a b c. (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c) M.mapAccumWithKey a -> Int -> b -> (a, c) f' a a IntMap b m f' :: a -> Int -> b -> (a, c) f' a a1 Int b b a2 = a -> Key -> b -> (a, c) f a a1 (Int -> Key unsafeChr Int b) b a2 fold :: (a -> b -> b) -> b -> CharMap a -> b fold :: forall a b. (a -> b -> b) -> b -> CharMap a -> b fold a -> b -> b f b a (CharMap IntMap a m) = (a -> b -> b) -> b -> IntMap a -> b forall a b. (a -> b -> b) -> b -> IntMap a -> b M.foldr a -> b -> b f b a IntMap a m foldWithKey :: (Key -> a -> b -> b) -> b -> CharMap a -> b foldWithKey :: forall a b. (Key -> a -> b -> b) -> b -> CharMap a -> b foldWithKey Key -> a -> b -> b f b a (CharMap IntMap a m) = (Int -> a -> b -> b) -> b -> IntMap a -> b forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b M.foldrWithKey Int -> a -> b -> b f' b a IntMap a m where f' :: Int -> a -> b -> b f' Int b a a1 b a2 = Key -> a -> b -> b f (Int -> Key unsafeChr Int b) a a1 b a2 elems :: CharMap a -> [a] elems :: forall a. CharMap a -> [a] elems (CharMap IntMap a m) = IntMap a -> [a] forall a. IntMap a -> [a] M.elems IntMap a m keys :: CharMap a -> [Key] keys :: forall a. CharMap a -> String keys (CharMap IntMap a m) = (Int -> Key) -> [Int] -> String forall a b. (a -> b) -> [a] -> [b] L.map Int -> Key unsafeChr (IntMap a -> [Int] forall a. IntMap a -> [Int] M.keys IntMap a m) keysSet :: CharMap a -> S.IntSet keysSet :: forall a. CharMap a -> IntSet keysSet (CharMap IntMap a m) = IntMap a -> IntSet forall a. IntMap a -> IntSet M.keysSet IntMap a m assocs :: CharMap a -> [(Key, a)] assocs :: forall a. CharMap a -> [(Key, a)] assocs (CharMap IntMap a m) = ((Int, a) -> (Key, a)) -> [(Int, a)] -> [(Key, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Int b,a a) -> (Int -> Key unsafeChr Int b,a a)) (IntMap a -> [(Int, a)] forall a. IntMap a -> [(Int, a)] M.assocs IntMap a m) toList :: CharMap a -> [(Key, a)] toList :: forall a. CharMap a -> [(Key, a)] toList (CharMap IntMap a m) = ((Int, a) -> (Key, a)) -> [(Int, a)] -> [(Key, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Int b,a a) -> (Int -> Key unsafeChr Int b,a a)) (IntMap a -> [(Int, a)] forall a. IntMap a -> [(Int, a)] M.toList IntMap a m) fromList :: [(Key, a)] -> CharMap a fromList :: forall a. [(Key, a)] -> CharMap a fromList [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ([(Int, a)] -> IntMap a forall a. [(Int, a)] -> IntMap a M.fromList (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) fromListWith :: (a -> a -> a) -> [(Key, a)] -> CharMap a fromListWith :: forall a. (a -> a -> a) -> [(Key, a)] -> CharMap a fromListWith a -> a -> a f [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a -> a) -> [(Int, a)] -> IntMap a forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a M.fromListWith a -> a -> a f (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) fromListWithKey :: (Key -> a -> a -> a) -> [(Key, a)] -> CharMap a fromListWithKey :: forall a. (Key -> a -> a -> a) -> [(Key, a)] -> CharMap a fromListWithKey Key -> a -> a -> a f [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> a -> a) -> [(Int, a)] -> IntMap a forall a. (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a M.fromListWithKey Int -> a -> a -> a f' (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) where f' :: Int -> a -> a -> a f' Int b a a1 a a2 = Key -> a -> a -> a f (Int -> Key unsafeChr Int b) a a1 a a2 toAscList :: CharMap a -> [(Key, a)] toAscList :: forall a. CharMap a -> [(Key, a)] toAscList (CharMap IntMap a m) = ((Int, a) -> (Key, a)) -> [(Int, a)] -> [(Key, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Int b,a a) -> (Int -> Key unsafeChr Int b,a a)) (IntMap a -> [(Int, a)] forall a. IntMap a -> [(Int, a)] M.toAscList IntMap a m) fromAscList :: [(Key, a)] -> CharMap a fromAscList :: forall a. [(Key, a)] -> CharMap a fromAscList [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ([(Int, a)] -> IntMap a forall a. [(Int, a)] -> IntMap a M.fromAscList (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) fromAscListWith :: (a -> a -> a) -> [(Key, a)] -> CharMap a fromAscListWith :: forall a. (a -> a -> a) -> [(Key, a)] -> CharMap a fromAscListWith a -> a -> a f [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> a -> a) -> [(Int, a)] -> IntMap a forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a M.fromAscListWith a -> a -> a f (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key, a)] -> CharMap a fromAscListWithKey :: forall a. (Key -> a -> a -> a) -> [(Key, a)] -> CharMap a fromAscListWithKey Key -> a -> a -> a f [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> a -> a) -> [(Int, a)] -> IntMap a forall a. (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a M.fromAscListWithKey Int -> a -> a -> a f' (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) where f' :: Int -> a -> a -> a f' Int b a a1 a a2 = Key -> a -> a -> a f (Int -> Key unsafeChr Int b) a a1 a a2 fromDistinctAscList :: [(Key, a)] -> CharMap a fromDistinctAscList :: forall a. [(Key, a)] -> CharMap a fromDistinctAscList [(Key, a)] ka = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ([(Int, a)] -> IntMap a forall a. [(Int, a)] -> IntMap a M.fromDistinctAscList (((Key, a) -> (Int, a)) -> [(Key, a)] -> [(Int, a)] forall a b. (a -> b) -> [a] -> [b] L.map (\(Key k,a a) -> (Key -> Int C.ord Key k,a a)) [(Key, a)] ka)) filter :: (a -> Bool) -> CharMap a -> CharMap a filter :: forall a. (a -> Bool) -> CharMap a -> CharMap a filter a -> Bool f (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((a -> Bool) -> IntMap a -> IntMap a forall a. (a -> Bool) -> IntMap a -> IntMap a M.filter a -> Bool f IntMap a m) filterWithKey :: (Key -> a -> Bool) -> CharMap a -> CharMap a filterWithKey :: forall a. (Key -> a -> Bool) -> CharMap a -> CharMap a filterWithKey Key -> a -> Bool f (CharMap IntMap a m) = IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap ((Int -> a -> Bool) -> IntMap a -> IntMap a forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a M.filterWithKey Int -> a -> Bool f' IntMap a m) where f' :: Int -> a -> Bool f' Int b a a = Key -> a -> Bool f (Int -> Key unsafeChr Int b) a a partition :: (a -> Bool) -> CharMap a -> (CharMap a, CharMap a) partition :: forall a. (a -> Bool) -> CharMap a -> (CharMap a, CharMap a) partition a -> Bool f (CharMap IntMap a m) = (IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m1', IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m2') where (IntMap a m1',IntMap a m2') = (a -> Bool) -> IntMap a -> (IntMap a, IntMap a) forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a) M.partition a -> Bool f IntMap a m partitionWithKey :: (Key -> a -> Bool) -> CharMap a -> (CharMap a, CharMap a) partitionWithKey :: forall a. (Key -> a -> Bool) -> CharMap a -> (CharMap a, CharMap a) partitionWithKey Key -> a -> Bool f (CharMap IntMap a m) = (IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m1', IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m2') where (IntMap a m1',IntMap a m2') = (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a) forall a. (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a) M.partitionWithKey Int -> a -> Bool f' IntMap a m f' :: Int -> a -> Bool f' Int b a a = Key -> a -> Bool f (Int -> Key unsafeChr Int b) a a mapMaybe :: (a -> Maybe b) -> CharMap a -> CharMap b mapMaybe :: forall a b. (a -> Maybe b) -> CharMap a -> CharMap b mapMaybe a -> Maybe b f (CharMap IntMap a m) = IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap ((a -> Maybe b) -> IntMap a -> IntMap b forall a b. (a -> Maybe b) -> IntMap a -> IntMap b M.mapMaybe a -> Maybe b f IntMap a m) mapMaybeWithKey :: (Key -> a -> Maybe b) -> CharMap a -> CharMap b mapMaybeWithKey :: forall a b. (Key -> a -> Maybe b) -> CharMap a -> CharMap b mapMaybeWithKey Key -> a -> Maybe b f (CharMap IntMap a m) = IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap ((Int -> a -> Maybe b) -> IntMap a -> IntMap b forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b M.mapMaybeWithKey Int -> a -> Maybe b f' IntMap a m) where f' :: Int -> a -> Maybe b f' Int b a a = Key -> a -> Maybe b f (Int -> Key unsafeChr Int b) a a mapEither :: (a -> Either b c) -> CharMap a -> (CharMap b, CharMap c) mapEither :: forall a b c. (a -> Either b c) -> CharMap a -> (CharMap b, CharMap c) mapEither a -> Either b c f (CharMap IntMap a m) = (IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap IntMap b m1', IntMap c -> CharMap c forall a. IntMap a -> CharMap a CharMap IntMap c m2') where (IntMap b m1',IntMap c m2') = (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) forall a b c. (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) M.mapEither a -> Either b c f IntMap a m mapEitherWithKey :: (Key -> a -> Either b c) -> CharMap a -> (CharMap b, CharMap c) mapEitherWithKey :: forall a b c. (Key -> a -> Either b c) -> CharMap a -> (CharMap b, CharMap c) mapEitherWithKey Key -> a -> Either b c f (CharMap IntMap a m) = (IntMap b -> CharMap b forall a. IntMap a -> CharMap a CharMap IntMap b m1', IntMap c -> CharMap c forall a. IntMap a -> CharMap a CharMap IntMap c m2') where (IntMap b m1',IntMap c m2') = (Int -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) forall a b c. (Int -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c) M.mapEitherWithKey Int -> a -> Either b c f' IntMap a m f' :: Int -> a -> Either b c f' Int b a a = Key -> a -> Either b c f (Int -> Key unsafeChr Int b) a a split :: Key -> CharMap a -> (CharMap a, CharMap a) split :: forall a. Key -> CharMap a -> (CharMap a, CharMap a) split Key k (CharMap IntMap a m) = (IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m1', IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m2') where (IntMap a m1',IntMap a m2') = Int -> IntMap a -> (IntMap a, IntMap a) forall a. Int -> IntMap a -> (IntMap a, IntMap a) M.split (Key -> Int C.ord Key k) IntMap a m splitLookup :: Key -> CharMap a -> (CharMap a, Maybe a, CharMap a) splitLookup :: forall a. Key -> CharMap a -> (CharMap a, Maybe a, CharMap a) splitLookup Key k (CharMap IntMap a m) = (IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m1', Maybe a a, IntMap a -> CharMap a forall a. IntMap a -> CharMap a CharMap IntMap a m2') where (IntMap a m1',Maybe a a,IntMap a m2') = Int -> IntMap a -> (IntMap a, Maybe a, IntMap a) forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a) M.splitLookup (Key -> Int C.ord Key k) IntMap a m isSubmapOf :: Eq a => CharMap a -> CharMap a -> Bool isSubmapOf :: forall a. Eq a => CharMap a -> CharMap a -> Bool isSubmapOf (CharMap IntMap a m1) (CharMap IntMap a m2) = IntMap a -> IntMap a -> Bool forall a. Eq a => IntMap a -> IntMap a -> Bool M.isSubmapOf IntMap a m1 IntMap a m2 isSubmapOfBy :: (a -> b -> Bool) -> CharMap a -> CharMap b -> Bool isSubmapOfBy :: forall a b. (a -> b -> Bool) -> CharMap a -> CharMap b -> Bool isSubmapOfBy a -> b -> Bool f (CharMap IntMap a m1) (CharMap IntMap b m2) = (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool M.isSubmapOfBy a -> b -> Bool f IntMap a m1 IntMap b m2 isProperSubmapOf :: Eq a => CharMap a -> CharMap a -> Bool isProperSubmapOf :: forall a. Eq a => CharMap a -> CharMap a -> Bool isProperSubmapOf (CharMap IntMap a m1) (CharMap IntMap a m2) = IntMap a -> IntMap a -> Bool forall a. Eq a => IntMap a -> IntMap a -> Bool M.isProperSubmapOf IntMap a m1 IntMap a m2 isProperSubmapOfBy :: (a -> b -> Bool) -> CharMap a -> CharMap b -> Bool isProperSubmapOfBy :: forall a b. (a -> b -> Bool) -> CharMap a -> CharMap b -> Bool isProperSubmapOfBy a -> b -> Bool f (CharMap IntMap a m1) (CharMap IntMap b m2) = (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool M.isProperSubmapOfBy a -> b -> Bool f IntMap a m1 IntMap b m2 showTree :: Show a => CharMap a -> String showTree :: forall a. Show a => CharMap a -> String showTree (CharMap IntMap a m) = IntMap a -> String forall a. Show a => IntMap a -> String MD.showTree IntMap a m showTreeWith :: Show a => Bool -> Bool -> CharMap a -> String showTreeWith :: forall a. Show a => Bool -> Bool -> CharMap a -> String showTreeWith Bool b1 Bool b2 (CharMap IntMap a m) = Bool -> Bool -> IntMap a -> String forall a. Show a => Bool -> Bool -> IntMap a -> String MD.showTreeWith Bool b1 Bool b2 IntMap a m {-# INLINE (!) #-} {-# INLINE (\\) #-} {-# INLINE null #-} {-# INLINE size #-} {-# INLINE member #-} {-# INLINE notMember #-} {-# INLINE lookup #-} {-# INLINE findWithDefault #-} {-# INLINE empty #-} {-# INLINE singleton #-} {-# INLINE insert #-} {-# INLINE insertWith #-} {-# INLINE insertWithKey #-} {-# INLINE insertLookupWithKey #-} {-# INLINE delete #-} {-# INLINE adjust #-} {-# INLINE adjustWithKey #-} {-# INLINE update #-} {-# INLINE updateWithKey #-} {-# INLINE updateLookupWithKey #-} {-# INLINE union #-} {-# INLINE unionWith #-} {-# INLINE unionWithKey #-} {-# INLINE unions #-} {-# INLINE unionsWith #-} {-# INLINE difference #-} {-# INLINE differenceWith #-} {-# INLINE differenceWithKey #-} {-# INLINE intersection #-} {-# INLINE intersectionWith #-} {-# INLINE intersectionWithKey #-} {-# INLINE map #-} {-# INLINE mapWithKey #-} {-# INLINE mapAccum #-} {-# INLINE mapAccumWithKey #-} {-# INLINE fold #-} {-# INLINE foldWithKey #-} {-# INLINE elems #-} {-# INLINE keys #-} {-# INLINE keysSet #-} {-# INLINE assocs #-} {-# INLINE toList #-} {-# INLINE fromList #-} {-# INLINE fromListWith #-} {-# INLINE fromListWithKey #-} {-# INLINE toAscList #-} {-# INLINE fromAscList #-} {-# INLINE fromAscListWith #-} {-# INLINE fromAscListWithKey #-} {-# INLINE fromDistinctAscList #-} {-# INLINE filter #-} {-# INLINE filterWithKey #-} {-# INLINE partition #-} {-# INLINE partitionWithKey #-} {-# INLINE mapMaybe #-} {-# INLINE mapMaybeWithKey #-} {-# INLINE mapEither #-} {-# INLINE mapEitherWithKey #-} {-# INLINE split #-} {-# INLINE splitLookup #-} {-# INLINE isSubmapOf #-} {-# INLINE isSubmapOfBy #-} {-# INLINE isProperSubmapOf #-} {-# INLINE isProperSubmapOfBy #-} {-# INLINE showTree #-} {-# INLINE showTreeWith #-}