mirror of
https://github.com/github/semantic.git
synced 2024-12-25 16:02:43 +03:00
Patch is algebraic.
This commit is contained in:
parent
d881006e55
commit
da3bf047b1
@ -15,9 +15,6 @@ data Info = Info -- Range [String]
|
||||
type Term a annotation = Cofree (Syntax a) annotation
|
||||
type Diff a = Free (Syntax a) (Patch (Term a Info))
|
||||
|
||||
(</>) :: Maybe (Term a Info) -> Maybe (Term a Info) -> Diff a
|
||||
(</>) a b = Pure Patch { old = a, new = b }
|
||||
|
||||
a :: Term String Info
|
||||
a = Info :< (Keyed $ fromList [
|
||||
("hello", Info :< Indexed [ Info :< Leaf "hi" ]),
|
||||
@ -30,8 +27,8 @@ b = Info :< (Keyed $ fromList [
|
||||
|
||||
d :: Diff String
|
||||
d = Free $ Keyed $ fromList [
|
||||
("hello", Free $ Indexed [ Just (Info :< Leaf "hi") </> Nothing ]),
|
||||
("goodbye", Just (Info :< Leaf "goodbye") </> Just (Info :< Indexed [])) ]
|
||||
("hello", Free $ Indexed [ Pure . Delete $ Info :< Leaf "hi" ]),
|
||||
("goodbye", Pure $ Replace (Info :< Leaf "goodbye") (Info :< Indexed [])) ]
|
||||
|
||||
cost :: Diff a -> Integer
|
||||
cost f = iter c $ fmap g f where
|
||||
|
@ -27,9 +27,9 @@ run (Free (Recursive a b f)) = run . f $ recur a b where
|
||||
repack key = (key, interpretInBoth key a' b')
|
||||
interpretInBoth key a' b' = maybeInterpret (Data.Map.lookup key a') (Data.Map.lookup key b')
|
||||
maybeInterpret (Just a) (Just b) = interpret a b
|
||||
recur _ _ = Pure Patch { old = Just a, new = Just b }
|
||||
recur _ _ = Pure $ Replace a b
|
||||
|
||||
interpret :: Term a Info -> Term a Info -> Diff a
|
||||
interpret a b = maybeReplace $ constructAndRun a b where
|
||||
maybeReplace (Just a) = a
|
||||
maybeReplace Nothing = Just a </> Just b
|
||||
maybeReplace Nothing = Pure $ Replace a b
|
||||
|
@ -1,3 +1,6 @@
|
||||
module Patch where
|
||||
|
||||
data Patch a = Patch { old :: Maybe a, new :: Maybe a }
|
||||
data Patch a =
|
||||
Replace a a
|
||||
| Insert a
|
||||
| Delete a
|
||||
|
Loading…
Reference in New Issue
Block a user