git.iko.soy/patch
on ef344d9 help sign in
patch/src/Data/FastMutableIntMap.hs
100 lines 3.3 kB history raw
1{-# LANGUAGE DeriveFunctor #-}
2{-# LANGUAGE DeriveFoldable #-}
3{-# LANGUAGE DeriveTraversable #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE TypeFamilies #-}
6module Data.FastMutableIntMap
7 ( FastMutableIntMap
8 , new
9 , newEmpty
10 , insert
11 , isEmpty
12 , getFrozenAndClear
13 , size
14 , applyPatch
15 , PatchIntMap (..)
16 , traverseIntMapPatchWithKey
17 , lookup
18 , forIntersectionWithImmutable_
19 , for_
20 , patchIntMapNewElements
21 , patchIntMapNewElementsMap
22 , getDeletions
23 ) where
25--TODO: Pure JS version
26--TODO: Fast copy to FastIntMap
27--TODO: Fast patch type
29import Prelude hiding (lookup)
30import Data.IORef
31import Data.IntMap.Strict (IntMap)
32import qualified Data.IntMap.Strict as IntMap
33import Data.Maybe
34import Reflex.Patch.Class
35import Data.Foldable (traverse_)
36import Control.Monad.IO.Class
38newtype FastMutableIntMap a = FastMutableIntMap (IORef (IntMap a))
40new :: IntMap a -> IO (FastMutableIntMap a)
41new m = FastMutableIntMap <$> newIORef m
43newEmpty :: IO (FastMutableIntMap a)
44newEmpty = FastMutableIntMap <$> newIORef IntMap.empty
46insert :: FastMutableIntMap a -> Int -> a -> IO ()
47insert (FastMutableIntMap r) k v = modifyIORef' r $ IntMap.insert k v
49lookup :: FastMutableIntMap a -> Int -> IO (Maybe a)
50lookup (FastMutableIntMap r) k = IntMap.lookup k <$> readIORef r
52forIntersectionWithImmutable_ :: MonadIO m => FastMutableIntMap a -> IntMap b -> (a -> b -> m ()) -> m ()
53forIntersectionWithImmutable_ (FastMutableIntMap r) b f = do
54 a <- liftIO $ readIORef r
55 traverse_ (uncurry f) $ IntMap.intersectionWith (,) a b
57for_ :: MonadIO m => FastMutableIntMap a -> (a -> m ()) -> m ()
58for_ (FastMutableIntMap r) f = do
59 a <- liftIO $ readIORef r
60 traverse_ f a
62isEmpty :: FastMutableIntMap a -> IO Bool
63isEmpty (FastMutableIntMap r) = IntMap.null <$> readIORef r
65size :: FastMutableIntMap a -> IO Int
66size (FastMutableIntMap r) = IntMap.size <$> readIORef r
68-- | Make an immutable snapshot of the datastructure and clear it
69getFrozenAndClear :: FastMutableIntMap a -> IO (IntMap a)
70getFrozenAndClear (FastMutableIntMap r) = do
71 result <- readIORef r
72 writeIORef r IntMap.empty
73 return result
75applyPatch :: FastMutableIntMap a -> PatchIntMap a -> IO (IntMap a)
76applyPatch (FastMutableIntMap r) p@(PatchIntMap m) = do
77 v <- readIORef r
78 writeIORef r $! applyAlways p v
79 return $ IntMap.intersection v m
81newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)
83instance Patch (PatchIntMap a) where
84 type PatchTarget (PatchIntMap a) = IntMap a
85 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $
86 let removes = IntMap.filter isNothing p
87 adds = IntMap.mapMaybe id p
88 in IntMap.union adds $ v `IntMap.difference` removes
90traverseIntMapPatchWithKey :: Applicative t => (Int -> a -> t b) -> PatchIntMap a -> t (PatchIntMap b)
91traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m
93patchIntMapNewElements :: PatchIntMap a -> [a]
94patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m
96patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a
97patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m
99getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'
100getDeletions (PatchIntMap m) v = IntMap.intersection v m