observable-sharing 0.2.2.1 → 0.2.3
raw patch · 2 files changed
+48/−38 lines, 2 files
Files
- observable-sharing.cabal +1/−1
- src/Data/Ref/Map.hs +47/−37
observable-sharing.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: observable-sharing-version: 0.2.2.1+version: 0.2.3 synopsis: Simple observable sharing -- description: license: BSD3
src/Data/Ref/Map.hs view
@@ -1,25 +1,27 @@-{-# LANGUAGE GADTs, Rank2Types #-}+{-# LANGUAGE GADTs, ScopedTypeVariables #-} module Data.Ref.Map ( Map , Name- , empty- , singleton- , null- , size- , member- , (!)- , lookup- , insert- , delete- , adjust- , hmap+ + , empty -- :: Map f+ , singleton -- :: Name a -> f a -> Map f + , null -- :: Map f -> Bool+ , size -- :: Map f -> Int+ , member -- :: Name a -> Map f -> Bool+ , (!) -- :: Name a -> Map f -> f a+ , lookup -- :: Name a -> Map f -> Maybe (f a)+ , insert -- :: Ref a -> f a -> Map f -> Map f+ , delete -- :: Name a -> Map f -> Map f+ , adjust -- :: (f a -> f b) -> Name a -> Map f -> Map f+ , hmap -- :: (f a -> h a) -> Map f -> Map h , union , difference , intersection+ -- eehh...- , HideType(..)- , dump+ , Entry(..)+ , elems ) where import Control.Applicative ((<$>))@@ -39,17 +41,15 @@ -- * Reference indexed maps -------------------------------------------------------------------------------- --- | Shorthand+-- | Shorthand for stable names type Name = StableName -- | HideType, for hiding types!-data HideType f- where- Hide :: f a -> HideType f+data HideType f where+ Hide :: f a -> HideType f -- | A reference indexed map.------ useful for associating info with a reference.+-- Useful for associating info with a reference. data Map f = Map (IntMap [(HideType Name, HideType f)]) --------------------------------------------------------------------------------@@ -97,29 +97,34 @@ insert (Ref n _) v (Map m) = Map $ M.insertWith (++) (hashStableName n) [(Hide n, Hide v)] m -- | Removes the associated value of a reference, if any is present in the map.-delete :: Name a -> Map f -> Map f+delete :: forall f a. Name a -> Map f -> Map f delete n map@(Map m) = Map $ M.update del (hashStableName n) m where- del (_:[]) = Nothing- del xs = Just $ deleteBy apa (Hide n, undefined) xs- apa (Hide x, _) (Hide y, _) = eqStableName x y+ del :: [(HideType Name, HideType f)] -> Maybe [(HideType Name, HideType f)]+ del [] = Nothing+ del xs = Just $ deleteBy eq (Hide n, undefined) xs + eq :: (HideType Name, x) -> (HideType Name, y) -> Bool+ eq (Hide x, _) (Hide y, _) = x `eqStableName` y+ -- | Updates the associated value of a reference, if any is present in the map.-adjust :: (f a -> f b) -> Name a -> Map f -> Map f-adjust f n (Map m) = Map $ M.adjust fun (hashStableName n) m+adjust :: forall f a b. (f a -> f b) -> Name a -> Map f -> Map f+adjust f n (Map m) = Map $ M.adjust (fmap open) (hashStableName n) m where- fun xs = flip fmap xs $ \pair@(Hide x, Hide v) ->- if eqStableName x n- then (Hide x, Hide $ f $ unsafeCoerce v)- else pair+ open :: (HideType Name, HideType f) -> (HideType Name, HideType f)+ open pair@(Hide x, Hide v)+ | x `eqStableName` n = (Hide x, Hide $ f $ unsafeCoerce v)+ | otherwise = pair -------------------------------------------------------------------------------- -- ** Traversal -hmap :: (f a -> h a) -> Map f -> Map h-hmap f (Map m) = Map $ M.map (fmap $ fmap h) m+-- | Map over the container types+hmap :: forall f h a. (f a -> h a) -> Map f -> Map h+hmap f (Map m) = Map $ M.map (fmap $ fmap open) m where- h (Hide x) = Hide $ f $ unsafeCoerce x+ open :: HideType f -> HideType h+ open (Hide x) = Hide $ f $ unsafeCoerce x -------------------------------------------------------------------------------- -- ** Combine@@ -137,11 +142,16 @@ intersection (Map m) (Map n) = Map $ M.intersection m n ----------------------------------------------------------------------------------- ** Debug - These are probably not safe+-- Still not sure about these. --- data Entry f = forall a. Entry a (f a)+-- | ...+data Entry f = forall a. Entry (Name a) (f a) -dump :: Map f -> [[(HideType Name, HideType f)]]-dump (Map m) = M.elems m+-- | Fetches all the elements of a map.+elems :: Map f -> [Entry f]+elems (Map m) = fmap pack . concat $ M.elems m+ where+ pack :: (HideType Name, HideType f) -> Entry f+ pack (Hide n, Hide f) = Entry n (unsafeCoerce f) --------------------------------------------------------------------------------