5d72d4f · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Add some docs

5d72d4fRyan Trinkle9 years ago

src/Data/Functor/Misc.hs+5

compare with develop

unifiedsplit

@@ -70,6 +70,7 @@ data Const2 :: * -> x -> x -> * where

70 Const2 :: k -> Const2 k v v

71 deriving (Typeable)

73+-- | Extract the value from a Const2

73unConst2 :: Const2 k v v' -> k

74unConst2 :: Const2 k v v' -> k

74unConst2 (Const2 k) = k

75unConst2 (Const2 k) = k

@@ -126,6 +127,8 @@ instance {-# INCOHERENT #-} Eq k => EqTag (Const2 k v) (Const2 k v) where

126dmapToMap :: DMap (Const2 k v) Identity -> Map k v

127dmapToMap :: DMap (Const2 k v) Identity -> Map k v

127dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList

128dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList

128

129

130+-- | Convert a 'DMap' to a regular 'Map', applying the given function to remove

131+-- the wrapping 'Functor'

129dmapToMapWith :: (f v -> v') -> DMap (Const2 k v) f -> Map k v'

132dmapToMapWith :: (f v -> v') -> DMap (Const2 k v) f -> Map k v'

130dmapToMapWith f = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, f v)) . DMap.toAscList

133dmapToMapWith f = Map.fromDistinctAscList . map (\(Const2 k :=> v) -> (k, f v)) . DMap.toAscList

131

134

@@ -138,6 +141,8 @@ mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v)

138mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f

141mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f

139mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList

142mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList

140

143

144+-- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with

145+-- the keys, using a function to remove the wrapping 'Functor'

141weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'

146weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'

142weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList

147weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList

143

148

src/Data/WeakBag.hs+1−1

@@ -37,7 +37,7 @@ import Prelude hiding (mapM_, traverse)

37-- alive, the 'WeakBag' will continue to refer to them.

38data WeakBag a = WeakBag

39 { _weakBag_nextId :: {-# UNPACK #-} !(IORef Int) --TODO: what if this wraps around?

40− , _weakBag_children :: {-# UNPACK #-} !(IORef (IntMap (Weak a)))

40+ , _weakBag_children :: {-# UNPACK #-} !(IORef (IntMap (Weak a))) -- ^ The items referenced by the WeakBag

41 }

43-- | When inserting an item into a 'WeakBag', a 'WeakBagTicket' is returned. If

src/Reflex/Patch/Class.hs+3−1

@@ -1,4 +1,5 @@

1{-# LANGUAGE TypeFamilies #-}

2+-- | The interface for types which represent changes made to other types

2module Reflex.Patch.Class where

3module Reflex.Patch.Class where

4import Control.Monad.Identity

5import Control.Monad.Identity

@@ -11,10 +12,11 @@ class Patch p where

11 -- 'Nothing'.

12 -- 'Nothing'.

12 apply :: p -> PatchTarget p -> Maybe (PatchTarget p)

13 apply :: p -> PatchTarget p -> Maybe (PatchTarget p)

15+-- | Apply a 'Patch'; if it does nothing, return the original value

14applyAlways :: Patch p => p -> PatchTarget p -> PatchTarget p

16applyAlways :: Patch p => p -> PatchTarget p -> PatchTarget p

15applyAlways p t = fromMaybe t $ apply p t

17applyAlways p t = fromMaybe t $ apply p t

19+-- | 'Identity' can be used as a 'Patch' that always fully replaces the value

17instance Patch (Identity a) where

20instance Patch (Identity a) where

18 type PatchTarget (Identity a) = a

21 type PatchTarget (Identity a) = a

19 apply (Identity a) _ = Just a

22 apply (Identity a) _ = Just a

20−

src/Reflex/Patch/Map.hs+13−1

@@ -1,6 +1,8 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE LambdaCase #-}

3{-# LANGUAGE TypeFamilies #-}

4+-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)

5+-- and deletions

4module Reflex.Patch.Map where

6module Reflex.Patch.Map where

6import Reflex.Patch.Class

8import Reflex.Patch.Class

@@ -11,9 +13,13 @@ import qualified Data.Map as Map

11import Data.Maybe

13import Data.Maybe

13-- | A set of changes to a 'Map'. Any element may be inserted/updated or

15-- | A set of changes to a 'Map'. Any element may be inserted/updated or

14−-- deleted.

16+-- deleted. Insertions are represented as values wrapped in 'Just', while

17+-- deletions are represented as 'Nothing's

15newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

18newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

19+ deriving (Show, Read, Eq, Ord)

21+-- | Applying a 'PatchMap' will update the 'Map' by performing the insertions

22+-- and deletions specified

17instance Ord k => Patch (PatchMap k v) where

23instance Ord k => Patch (PatchMap k v) where

18 type PatchTarget (PatchMap k v) = Map k v

24 type PatchTarget (PatchMap k v) = Map k v

19 {-# INLINABLE apply #-}

25 {-# INLINABLE apply #-}

@@ -24,6 +30,9 @@ instance Ord k => Patch (PatchMap k v) where

24 Nothing -> Just ()

30 Nothing -> Just ()

25 Just _ -> Nothing

31 Just _ -> Nothing

33+-- | @a <> b@ will apply the changes of @b@ and then apply the changes of @a@.

34+-- If the same key is modified by both patches, the one on the left will take

35+-- precedence.

27instance Ord k => Semigroup (PatchMap k v) where

36instance Ord k => Semigroup (PatchMap k v) where

28 PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

37 PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map

29 -- PatchMap is idempotent, so stimes n is id for every n

38 -- PatchMap is idempotent, so stimes n is id for every n

@@ -36,10 +45,13 @@ instance Ord k => Semigroup (PatchMap k v) where

36 GT -> x

45 GT -> x

37#endif

46#endif

48+-- | The empty 'PatchMap' contains no insertions or deletions

39instance Ord k => Monoid (PatchMap k v) where

49instance Ord k => Monoid (PatchMap k v) where

40 mempty = PatchMap mempty

50 mempty = PatchMap mempty

41 mappend = (<>)

51 mappend = (<>)

53+-- | 'fmap'ping a 'PatchMap' will alter all of the values it will insert.

54+-- Deletions are unaffected.

43instance Functor (PatchMap k) where

55instance Functor (PatchMap k) where

44 fmap f = PatchMap . fmap (fmap f) . unPatchMap

56 fmap f = PatchMap . fmap (fmap f) . unPatchMap

src/Reflex/Patch/MapWithMove.hs+36−39

@@ -5,6 +5,8 @@

5{-# LANGUAGE LambdaCase #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

8+-- | 'Patch'es on 'Map' that can insert, delete, and move values from one key to

9+-- another

8module Reflex.Patch.MapWithMove where

10module Reflex.Patch.MapWithMove where

10import Reflex.Patch.Class

12import Reflex.Patch.Class

@@ -20,19 +22,33 @@ import Data.Maybe

20import qualified Data.Set as Set

22import qualified Data.Set as Set

21import Data.Tuple

23import Data.Tuple

23−-- | Patch a DMap with additions, deletions, and moves.

25+-- | Patch a DMap with additions, deletions, and moves. Invariant: If key @k1@

24−-- Invariants:

26+-- is coming from @From_Move k2@, then key @k2@ should be going to @Just k1@,

25−-- * The same source key may not be moved to two destination keys.

27+-- and vice versa. There should never be any unpaired From/To keys.

26−-- * Any key that is the source of a Move must also be edited

27−-- (otherwise, the Move would duplicate it)

28newtype PatchMapWithMove k v = PatchMapWithMove (Map k (NodeInfo k v)) deriving (Show, Eq, Ord, Functor, Foldable, Traversable)

30+-- | Holds the information about each key: where its new value should come from,

31+-- and where its old value should go to

30data NodeInfo k v = NodeInfo

32data NodeInfo k v = NodeInfo

31 { _nodeInfo_from :: !(From k v)

33 { _nodeInfo_from :: !(From k v)

34+ -- ^ Where do we get the new value for this key?

32 , _nodeInfo_to :: !(To k)

35 , _nodeInfo_to :: !(To k)

36+ -- ^ If the old value is being kept (i.e. moved rather than deleted or

37+ -- replaced), where is it going?

33 }

38 }

34 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

39 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

41+-- | Create a 'PatchMapWithMove', validating it

42+patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

43+patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

44+ where valid = forwardLinks == backwardLinks

45+ forwardLinks = Map.mapMaybe _nodeInfo_to m

46+ backwardLinks = Map.fromList $ catMaybes $ flip fmap (Map.toList m) $ \(to, v) ->

47+ case _nodeInfo_from v of

48+ From_Move from -> Just (from, to)

49+ _ -> Nothing

50+

51+-- | Extract the internal representation of the 'PatchMapWithMove'

36unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

52unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

37unPatchMapWithMove (PatchMapWithMove p) = p

53unPatchMapWithMove (PatchMapWithMove p) = p

@@ -41,14 +57,19 @@ unPatchMapWithMove (PatchMapWithMove p) = p

41unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

57unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

42unsafePatchMapWithMove = PatchMapWithMove

58unsafePatchMapWithMove = PatchMapWithMove

60+-- | Describe how a key's new value should be produced

44data From k v

61data From k v

45 = From_Insert v -- ^ Insert the given value here

62 = From_Insert v -- ^ Insert the given value here

46 | From_Delete -- ^ Delete the existing value, if any, from here

63 | From_Delete -- ^ Delete the existing value, if any, from here

47 | From_Move !k -- ^ Move the value here from the given key

64 | From_Move !k -- ^ Move the value here from the given key

48 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

65 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

67+-- | Describe where a key's old value will go. If this is 'Just', that means

68+-- the key's old value will be moved to the given other key; if it is 'Nothing',

69+-- that means it will be deleted.

50type To = Maybe

70type To = Maybe

72+-- | Apply the insertions, deletions, and moves to a given 'Map'

52instance Ord k => Patch (PatchMapWithMove k v) where

73instance Ord k => Patch (PatchMapWithMove k v) where

53 type PatchTarget (PatchMapWithMove k v) = Map k v

74 type PatchTarget (PatchMapWithMove k v) = Map k v

54 apply (PatchMapWithMove p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

75 apply (PatchMapWithMove p) old = Just $! insertions `Map.union` (old `Map.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

@@ -71,40 +92,9 @@ patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

71 From_Move _ -> Nothing

92 From_Move _ -> Nothing

72 From_Delete -> Nothing

93 From_Delete -> Nothing

74−validPatchMapWithMove :: Ord k => PatchMapWithMove k v -> Bool

95+-- | Create a 'PatchMapWithMove' that, if applied to the given 'Map', will sort

75−validPatchMapWithMove (PatchMapWithMove p) =

96+-- its values using the given ordering function. The set keys of the 'Map' is

76− let f ni = case _nodeInfo_from ni of

97+-- not changed.

77− From_Move k -> Just k

78− _ -> Nothing

79− moveSources = catMaybes $ f <$> Map.elems p

80− in and

81− [ -- All Moves must have unique source keys - a single source key can't be moved to two destinations

82− all (==1) $ Map.fromListWith (+) $ fmap (\k -> (k, 1 :: Integer )) moveSources

83− , -- All Move source keys must also be patched - since the value's being moved elsewhere, the original must either be Deleted or replaced (with Insert or Move)

84− all (isJust . flip Map.lookup p) moveSources

85− ]

86−

87−knownValidPatchMapWithMove :: [PatchMapWithMove Int Int]

88−knownValidPatchMapWithMove =

89− [ PatchMapWithMove mempty

90− , PatchMapWithMove $ Map.fromList

91− [ (1, NodeInfo (From_Move 2) $ Just 1)

92− , (2, NodeInfo (From_Move 1) $ Just 2)

93− ]

94− ]

95−

96−knownInvalidPatchMapWithMove :: [PatchMapWithMove Int Int]

97−knownInvalidPatchMapWithMove =

98− [ -- Invalid because we move 2 to 1, but don't specify what to do with 2

99− PatchMapWithMove $ Map.singleton 1 $ NodeInfo (From_Move 2) Nothing

100− , -- Invalid because we have multiple moves from 3

101− PatchMapWithMove $ Map.fromList

102− [ (1, NodeInfo (From_Move 3) Nothing)

103− , (2, NodeInfo (From_Move 3) Nothing)

104− , (3, NodeInfo From_Delete (Just 1))

105− ]

106− ]

107−

108patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v

98patchThatSortsMapWith :: Ord k => (v -> v -> Ordering) -> Map k v -> PatchMapWithMove k v

109patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipWith g unsorted sorted

99patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipWith g unsorted sorted

110 where unsorted = Map.toList m

100 where unsorted = Map.toList m

@@ -116,6 +106,9 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW

116 let Just movingTo = Map.lookup from reverseMapping

106 let Just movingTo = Map.lookup from reverseMapping

117 in Just (to, NodeInfo (From_Move from) $ Just movingTo)

107 in Just (to, NodeInfo (From_Move from) $ Just movingTo)

118

108

109+-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,

110+-- will produce a 'Map' with the same values as the second 'Map' but with the

111+-- values sorted with the given ordering function.

119patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v

112patchThatChangesAndSortsMapWith :: forall k v. (Ord k, Ord v) => (v -> v -> Ordering) -> Map k v -> Map k v -> PatchMapWithMove k v

120patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patch

113patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patch

121 where oldByValue = Map.fromListWith Set.union $ swap . first Set.singleton <$> Map.toList oldByIndex

114 where oldByValue = Map.fromListWith Set.union $ swap . first Set.singleton <$> Map.toList oldByIndex

@@ -149,11 +142,15 @@ patchThatChangesAndSortsMapWith cmp oldByIndex newByIndexUnsorted = patch

149 else Nothing

142 else Nothing

150 patch = unsafePatchMapWithMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex

143 patch = unsafePatchMapWithMove $ Map.filterWithKey (\k -> not . pointlessMove k . _nodeInfo_from) $ Map.mergeWithKey (\k a _ -> Just $ nodeInfoSetTo (keyWasMoved k) a) (Map.mapWithKey $ \k -> nodeInfoSetTo $ keyWasMoved k) (Map.mapWithKey $ \k _ -> NodeInfo From_Delete $ keyWasMoved k) insertsAndMoves oldByIndex

151

144

145+-- | Change the 'From' value of a 'NodeInfo'

152nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v

146nodeInfoMapFrom :: (From k v -> From k v) -> NodeInfo k v -> NodeInfo k v

153nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }

147nodeInfoMapFrom f ni = ni { _nodeInfo_from = f $ _nodeInfo_from ni }

154

148

149+-- | Change the 'From' value of a 'NodeInfo', using a 'Functor' (or

150+-- 'Applicative', 'Monad', etc.) action to get the new value

155nodeInfoMapMFrom :: Functor f => (From k v -> f (From k v)) -> NodeInfo k v -> f (NodeInfo k v)

151nodeInfoMapMFrom :: Functor f => (From k v -> f (From k v)) -> NodeInfo k v -> f (NodeInfo k v)

156nodeInfoMapMFrom f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni

152nodeInfoMapMFrom f ni = fmap (\result -> ni { _nodeInfo_from = result }) $ f $ _nodeInfo_from ni

157

153

154+-- | Set the 'To' field of a 'NodeInfo'

158nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v

155nodeInfoSetTo :: To k -> NodeInfo k v -> NodeInfo k v

159nodeInfoSetTo to ni = ni { _nodeInfo_to = to }

156nodeInfoSetTo to ni = ni { _nodeInfo_to = to }