@@ -6,6 +6,7 @@
66{-# LANGUAGE PatternGuards #-}
77{-# LANGUAGE ScopedTypeVariables #-}
88{-# LANGUAGE StandaloneDeriving #-}
9+{-# LANGUAGE TemplateHaskell #-}
910{-# LANGUAGE TypeFamilies #-}
1011{-# LANGUAGE UndecidableInstances #-}
1112
@@ -16,6 +17,7 @@ module Data.Patch.MapWithPatchingMove where
1617import Data.Patch.Class
1718
1819import Control.Arrow
20+import Control.Lens.TH (makeWrapped)
1921import Control.Monad.Trans.State
2022import Data.Foldable
2123import Data.Function
@@ -23,7 +25,6 @@ import Data.List
2325import Data.Map (Map)
2426import qualified Data.Map as Map
2527import Data.Maybe
26−--import Data.Proxy
2728#if !MIN_VERSION_base(4,10,0)
2829import Data.Semigroup (Semigroup (..))
2930#endif
@@ -39,6 +40,7 @@ newtype PatchMapWithPatchingMove k p = PatchMapWithPatchingMove
3940 { -- | Extract the internal representation of the 'PatchMapWithPatchingMove'
4041 unPatchMapWithPatchingMove :: Map k (NodeInfo k p)
4142 }
43+
4244deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (PatchMapWithPatchingMove k p)
4345deriving instance (Ord k, Read k, Read p, Read (PatchTarget p)) => Read (PatchMapWithPatchingMove k p)
4446deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (PatchMapWithPatchingMove k p)
@@ -58,12 +60,33 @@ deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (NodeInfo k p)
5860deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (NodeInfo k p)
5961deriving instance (Ord k, Ord p, Ord (PatchTarget p)) => Ord (NodeInfo k p)
6062
63+bitraverseNodeInfo
64+ :: Applicative f
65+ => (k0 -> f k1)
66+ -> (p0 -> f p1)
67+ -> (PatchTarget p0 -> f (PatchTarget p1))
68+ -> NodeInfo k0 p0 -> f (NodeInfo k1 p1)
69+bitraverseNodeInfo fk fp fpt (NodeInfo from to) = NodeInfo
70+ <$> bitraverseFrom fk fp fpt from
71+ <*> traverse fk to
72+
6173-- | Describe how a key's new value should be produced
6274data From k p
6375 = From_Insert (PatchTarget p) -- ^ Insert the given value here
6476 | From_Delete -- ^ Delete the existing value, if any, from here
6577 | From_Move !k !p -- ^ Move the value here from the given key, and apply the given patch
6678
79+bitraverseFrom
80+ :: Applicative f
81+ => (k0 -> f k1)
82+ -> (p0 -> f p1)
83+ -> (PatchTarget p0 -> f (PatchTarget p1))
84+ -> From k0 p0 -> f (From k1 p1)
85+bitraverseFrom fk fp fpt = \case
86+ From_Insert pt -> From_Insert <$> fpt pt
87+ From_Delete -> pure From_Delete
88+ From_Move k p -> From_Move <$> fk k <*> fp p
89+
6790deriving instance (Show k, Show p, Show (PatchTarget p)) => Show (From k p)
6891deriving instance (Read k, Read p, Read (PatchTarget p)) => Read (From k p)
6992deriving instance (Eq k, Eq p, Eq (PatchTarget p)) => Eq (From k p)
@@ -326,3 +349,5 @@ instance ( Ord k
326349 ) => Monoid (PatchMapWithPatchingMove k p) where
327350 mempty = PatchMapWithPatchingMove mempty
328351 mappend = (<>)
352+
353+makeWrapped ''PatchMapWithPatchingMove