{-# LANGUAGE UndecidableInstances #-}
module Dino.AST.Diff where
import Prelude
import Control.Monad (guard, zipWithM)
import Data.Coerce (coerce)
import Data.Foldable (asum)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import Data.List (sortOn)
import Data.Text (Text)
import qualified Data.Text as Text
import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..), (<+>))
import qualified Text.PrettyPrint.ANSI.Leijen as PP
import Dino.Pretty
import Dino.AST
dropEnd :: Int -> [a] -> [a]
dropEnd :: Int -> [a] -> [a]
dropEnd Int
n [a]
as = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) [a]
as
data Replace a = Replace
{ Replace a -> a
original :: a
, Replace a -> a
new :: a
} deriving (Replace a -> Replace a -> Bool
(Replace a -> Replace a -> Bool)
-> (Replace a -> Replace a -> Bool) -> Eq (Replace a)
forall a. Eq a => Replace a -> Replace a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Replace a -> Replace a -> Bool
$c/= :: forall a. Eq a => Replace a -> Replace a -> Bool
== :: Replace a -> Replace a -> Bool
$c== :: forall a. Eq a => Replace a -> Replace a -> Bool
Eq, Int -> Replace a -> ShowS
[Replace a] -> ShowS
Replace a -> String
(Int -> Replace a -> ShowS)
-> (Replace a -> String)
-> ([Replace a] -> ShowS)
-> Show (Replace a)
forall a. Show a => Int -> Replace a -> ShowS
forall a. Show a => [Replace a] -> ShowS
forall a. Show a => Replace a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Replace a] -> ShowS
$cshowList :: forall a. Show a => [Replace a] -> ShowS
show :: Replace a -> String
$cshow :: forall a. Show a => Replace a -> String
showsPrec :: Int -> Replace a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Replace a -> ShowS
Show, a -> Replace b -> Replace a
(a -> b) -> Replace a -> Replace b
(forall a b. (a -> b) -> Replace a -> Replace b)
-> (forall a b. a -> Replace b -> Replace a) -> Functor Replace
forall a b. a -> Replace b -> Replace a
forall a b. (a -> b) -> Replace a -> Replace b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Replace b -> Replace a
$c<$ :: forall a b. a -> Replace b -> Replace a
fmap :: (a -> b) -> Replace a -> Replace b
$cfmap :: forall a b. (a -> b) -> Replace a -> Replace b
Functor)
data ElemOp a
= AddElem a
| RemoveElem a
| EditElem (Diff a)
deriving instance (Eq a, Eq (Diff a)) => Eq (ElemOp a)
deriving instance (Show a, Show (Diff a)) => Show (ElemOp a)
data EndOp a
= Append [a]
| DropEnd [a]
deriving (EndOp a -> EndOp a -> Bool
(EndOp a -> EndOp a -> Bool)
-> (EndOp a -> EndOp a -> Bool) -> Eq (EndOp a)
forall a. Eq a => EndOp a -> EndOp a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EndOp a -> EndOp a -> Bool
$c/= :: forall a. Eq a => EndOp a -> EndOp a -> Bool
== :: EndOp a -> EndOp a -> Bool
$c== :: forall a. Eq a => EndOp a -> EndOp a -> Bool
Eq, Int -> EndOp a -> ShowS
[EndOp a] -> ShowS
EndOp a -> String
(Int -> EndOp a -> ShowS)
-> (EndOp a -> String) -> ([EndOp a] -> ShowS) -> Show (EndOp a)
forall a. Show a => Int -> EndOp a -> ShowS
forall a. Show a => [EndOp a] -> ShowS
forall a. Show a => EndOp a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EndOp a] -> ShowS
$cshowList :: forall a. Show a => [EndOp a] -> ShowS
show :: EndOp a -> String
$cshow :: forall a. Show a => EndOp a -> String
showsPrec :: Int -> EndOp a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> EndOp a -> ShowS
Show, a -> EndOp b -> EndOp a
(a -> b) -> EndOp a -> EndOp b
(forall a b. (a -> b) -> EndOp a -> EndOp b)
-> (forall a b. a -> EndOp b -> EndOp a) -> Functor EndOp
forall a b. a -> EndOp b -> EndOp a
forall a b. (a -> b) -> EndOp a -> EndOp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> EndOp b -> EndOp a
$c<$ :: forall a b. a -> EndOp b -> EndOp a
fmap :: (a -> b) -> EndOp a -> EndOp b
$cfmap :: forall a b. (a -> b) -> EndOp a -> EndOp b
Functor)
data ListOp a =
ListOp
[Maybe (Diff a)]
(Maybe (EndOp a))
deriving instance (Eq a, Eq (Diff a)) => Eq (ListOp a)
deriving instance (Show a, Show (Diff a)) => Show (ListOp a)
data Edit a
= Replacement (Replace (AST a))
| EditApp Constr [Maybe (Edit a)]
| EditList (Diff [AST a])
| EditLet (Diff (Text, AST a, AST a))
| EditRecord (Diff (Mapping Field (AST a)))
deriving (Edit a -> Edit a -> Bool
(Edit a -> Edit a -> Bool)
-> (Edit a -> Edit a -> Bool) -> Eq (Edit a)
forall a. Eq a => Edit a -> Edit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Edit a -> Edit a -> Bool
$c/= :: forall a. Eq a => Edit a -> Edit a -> Bool
== :: Edit a -> Edit a -> Bool
$c== :: forall a. Eq a => Edit a -> Edit a -> Bool
Eq, Int -> Edit a -> ShowS
[Edit a] -> ShowS
Edit a -> String
(Int -> Edit a -> ShowS)
-> (Edit a -> String) -> ([Edit a] -> ShowS) -> Show (Edit a)
forall a. Show a => Int -> Edit a -> ShowS
forall a. Show a => [Edit a] -> ShowS
forall a. Show a => Edit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Edit a] -> ShowS
$cshowList :: forall a. Show a => [Edit a] -> ShowS
show :: Edit a -> String
$cshow :: forall a. Show a => Edit a -> String
showsPrec :: Int -> Edit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Edit a -> ShowS
Show)
newtype Monolithic a = Monolithic {Monolithic a -> a
unMonolithic :: a}
class Diffable a where
type Diff a
type instance Diff a = Replace a
diff ::
a
-> a
-> Maybe (Diff a)
default diff :: (Eq a, Diff a ~ Replace a) => a -> a -> Maybe (Diff a)
diff a
original a
new = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
original a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
new)
Replace a -> Maybe (Replace a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Replace a -> Maybe (Replace a)) -> Replace a -> Maybe (Replace a)
forall a b. (a -> b) -> a -> b
$ Replace :: forall a. a -> a -> Replace a
Replace {a
original :: a
original :: a
original, a
new :: a
new :: a
new}
applyDiff :: Diff a -> a -> Maybe a
default applyDiff :: (Eq a, Diff a ~ Replace a) => Diff a -> a -> Maybe a
applyDiff (Replace {original, new}) a
a
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
original = a -> Maybe a
forall a. a -> Maybe a
Just a
new
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
applyDiffWhen :: Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen :: Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff a)
Nothing a
a = a -> Maybe a
forall a. a -> Maybe a
Just a
a
applyDiffWhen (Just Diff a
d) a
a = Diff a -> a -> Maybe a
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff a
d a
a
instance Diffable ()
instance Diffable Bool
instance Diffable Text
instance Diffable Int
instance Diffable Integer
instance Diffable Float
instance Diffable Double
instance Diffable Rational
instance Eq a => Diffable (Monolithic a) where
type Diff (Monolithic a) = Replace a
diff :: Monolithic a -> Monolithic a -> Maybe (Diff (Monolithic a))
diff (Monolithic a
original) (Monolithic a
new) = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a
original a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
new)
Replace a -> Maybe (Replace a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Replace a -> Maybe (Replace a)) -> Replace a -> Maybe (Replace a)
forall a b. (a -> b) -> a -> b
$ Replace :: forall a. a -> a -> Replace a
Replace {a
original :: a
original :: a
original, a
new :: a
new :: a
new}
applyDiff :: Diff (Monolithic a) -> Monolithic a -> Maybe (Monolithic a)
applyDiff (Replace {original, new}) Monolithic a
a
| Monolithic a -> a
forall a. Monolithic a -> a
unMonolithic Monolithic a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
original = Monolithic a -> Maybe (Monolithic a)
forall a. a -> Maybe a
Just (Monolithic a -> Maybe (Monolithic a))
-> Monolithic a -> Maybe (Monolithic a)
forall a b. (a -> b) -> a -> b
$ a -> Monolithic a
forall a. a -> Monolithic a
Monolithic a
new
| Bool
otherwise = Maybe (Monolithic a)
forall a. Maybe a
Nothing
instance Diffable a => Diffable (Maybe a) where
type Diff (Maybe a) = ElemOp a
diff :: Maybe a -> Maybe a -> Maybe (Diff (Maybe a))
diff Maybe a
Nothing Maybe a
Nothing = Maybe (Diff (Maybe a))
forall a. Maybe a
Nothing
diff (Just a
a') Maybe a
Nothing = ElemOp a -> Maybe (ElemOp a)
forall a. a -> Maybe a
Just (ElemOp a -> Maybe (ElemOp a)) -> ElemOp a -> Maybe (ElemOp a)
forall a b. (a -> b) -> a -> b
$ a -> ElemOp a
forall a. a -> ElemOp a
RemoveElem a
a'
diff Maybe a
Nothing (Just a
b') = ElemOp a -> Maybe (ElemOp a)
forall a. a -> Maybe a
Just (ElemOp a -> Maybe (ElemOp a)) -> ElemOp a -> Maybe (ElemOp a)
forall a b. (a -> b) -> a -> b
$ a -> ElemOp a
forall a. a -> ElemOp a
AddElem a
b'
diff (Just a
a') (Just a
b') = Diff a -> ElemOp a
forall a. Diff a -> ElemOp a
EditElem (Diff a -> ElemOp a) -> Maybe (Diff a) -> Maybe (ElemOp a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Maybe (Diff a)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff a
a' a
b'
applyDiff :: Diff (Maybe a) -> Maybe a -> Maybe (Maybe a)
applyDiff (RemoveElem _) Maybe a
Nothing = Maybe (Maybe a)
forall a. Maybe a
Nothing
applyDiff (RemoveElem _) (Just a
_) = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
applyDiff (AddElem a) Maybe a
Nothing = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
applyDiff (AddElem _) (Just a
_) = Maybe (Maybe a)
forall a. Maybe a
Nothing
applyDiff (EditElem d) (Just a
a) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff a -> a -> Maybe a
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff a
d a
a
applyDiff (EditElem _) Maybe a
Nothing = Maybe (Maybe a)
forall a. Maybe a
Nothing
instance Diffable a => Diffable [a] where
type Diff [a] = ListOp a
diff :: [a] -> [a] -> Maybe (Diff [a])
diff [a]
o [a]
n
| Maybe (Diff a)
Nothing <- [Maybe (Diff a)] -> Maybe (Diff a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [Maybe (Diff a)]
es, Maybe (EndOp a)
Nothing <- Maybe (EndOp a)
endOp = Maybe (Diff [a])
forall a. Maybe a
Nothing
| Bool
otherwise = ListOp a -> Maybe (ListOp a)
forall a. a -> Maybe a
Just (ListOp a -> Maybe (ListOp a)) -> ListOp a -> Maybe (ListOp a)
forall a b. (a -> b) -> a -> b
$ [Maybe (Diff a)] -> Maybe (EndOp a) -> ListOp a
forall a. [Maybe (Diff a)] -> Maybe (EndOp a) -> ListOp a
ListOp [Maybe (Diff a)]
es Maybe (EndOp a)
endOp
where
es :: [Maybe (Diff a)]
es = (a -> a -> Maybe (Diff a)) -> [a] -> [a] -> [Maybe (Diff a)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Maybe (Diff a)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff [a]
o [a]
n
lo :: Int
lo = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
o
ln :: Int
ln = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
n
endOp :: Maybe (EndOp a)
endOp
| Int
lo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ln = EndOp a -> Maybe (EndOp a)
forall a. a -> Maybe a
Just (EndOp a -> Maybe (EndOp a)) -> EndOp a -> Maybe (EndOp a)
forall a b. (a -> b) -> a -> b
$ [a] -> EndOp a
forall a. [a] -> EndOp a
Append (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
lo [a]
n)
| Int
ln Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lo = EndOp a -> Maybe (EndOp a)
forall a. a -> Maybe a
Just (EndOp a -> Maybe (EndOp a)) -> EndOp a -> Maybe (EndOp a)
forall a b. (a -> b) -> a -> b
$ [a] -> EndOp a
forall a. [a] -> EndOp a
DropEnd (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
dropEnd Int
ln [a]
o)
| Bool
otherwise = Maybe (EndOp a)
forall a. Maybe a
Nothing
applyDiff :: Diff [a] -> [a] -> Maybe [a]
applyDiff (ListOp es endOp) [a]
as
| Int
le Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
la, Bool -> (EndOp a -> Bool) -> Maybe (EndOp a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False EndOp a -> Bool
forall a. EndOp a -> Bool
isAppend Maybe (EndOp a)
endOp = Maybe [a]
forall a. Maybe a
Nothing
| Int
le Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
la = [a] -> [a]
applyEndOp ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Diff a) -> a -> Maybe a)
-> [Maybe (Diff a)] -> [a] -> Maybe [a]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Maybe (Diff a) -> a -> Maybe a
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen [Maybe (Diff a)]
es [a]
as
| Bool
otherwise = Maybe [a]
forall a. Maybe a
Nothing
where
le :: Int
le = [Maybe (Diff a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe (Diff a)]
es
la :: Int
la = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as
isAppend :: EndOp a -> Bool
isAppend (Append [a]
_) = Bool
True
isAppend EndOp a
_ = Bool
False
applyEndOp :: [a] -> [a]
applyEndOp = case Maybe (EndOp a)
endOp of
Just (Append [a]
bs) -> ([a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
bs)
Maybe (EndOp a)
_ -> [a] -> [a]
forall a. a -> a
id
instance (Diffable a, Diffable b) => Diffable (a, b) where
type Diff (a, b) = (Maybe (Diff a), Maybe (Diff b))
diff :: (a, b) -> (a, b) -> Maybe (Diff (a, b))
diff (a
oa, b
ob) (a
na, b
nb)
| Maybe (Diff a)
Nothing <- Maybe (Diff a)
da, Maybe (Diff b)
Nothing <- Maybe (Diff b)
db = Maybe (Diff (a, b))
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe (Diff a), Maybe (Diff b))
-> Maybe (Maybe (Diff a), Maybe (Diff b))
forall a. a -> Maybe a
Just (Maybe (Diff a)
da, Maybe (Diff b)
db)
where
da :: Maybe (Diff a)
da = a -> a -> Maybe (Diff a)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff a
oa a
na
db :: Maybe (Diff b)
db = b -> b -> Maybe (Diff b)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff b
ob b
nb
applyDiff :: Diff (a, b) -> (a, b) -> Maybe (a, b)
applyDiff (da, db) (a
a, b
b) = (,) (a -> b -> (a, b)) -> Maybe a -> Maybe (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Diff a) -> a -> Maybe a
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff a)
da a
a Maybe (b -> (a, b)) -> Maybe b -> Maybe (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Diff b) -> b -> Maybe b
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff b)
db b
b
instance (Diffable a, Diffable b, Diffable c) => Diffable (a, b, c) where
type Diff (a, b, c) = (Maybe (Diff a), Maybe (Diff b), Maybe (Diff c))
diff :: (a, b, c) -> (a, b, c) -> Maybe (Diff (a, b, c))
diff (a
oa, b
ob, c
oc) (a
na, b
nb, c
nc)
| Maybe (Diff a)
Nothing <- Maybe (Diff a)
da, Maybe (Diff b)
Nothing <- Maybe (Diff b)
db, Maybe (Diff c)
Nothing <- Maybe (Diff c)
dc = Maybe (Diff (a, b, c))
forall a. Maybe a
Nothing
| Bool
otherwise = (Maybe (Diff a), Maybe (Diff b), Maybe (Diff c))
-> Maybe (Maybe (Diff a), Maybe (Diff b), Maybe (Diff c))
forall a. a -> Maybe a
Just (Maybe (Diff a)
da, Maybe (Diff b)
db, Maybe (Diff c)
dc)
where
da :: Maybe (Diff a)
da = a -> a -> Maybe (Diff a)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff a
oa a
na
db :: Maybe (Diff b)
db = b -> b -> Maybe (Diff b)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff b
ob b
nb
dc :: Maybe (Diff c)
dc = c -> c -> Maybe (Diff c)
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff c
oc c
nc
applyDiff :: Diff (a, b, c) -> (a, b, c) -> Maybe (a, b, c)
applyDiff (da, db, dc) (a
a, b
b, c
c) =
(,,) (a -> b -> c -> (a, b, c))
-> Maybe a -> Maybe (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Diff a) -> a -> Maybe a
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff a)
da a
a Maybe (b -> c -> (a, b, c)) -> Maybe b -> Maybe (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Diff b) -> b -> Maybe b
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff b)
db b
b Maybe (c -> (a, b, c)) -> Maybe c -> Maybe (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Diff c) -> c -> Maybe c
forall a. Diffable a => Maybe (Diff a) -> a -> Maybe a
applyDiffWhen Maybe (Diff c)
dc c
c
instance (Eq k, Hashable k, Diffable a) => Diffable (Mapping k a) where
type Diff (Mapping k a) = Mapping k (ElemOp a)
diff :: Mapping k a -> Mapping k a -> Maybe (Diff (Mapping k a))
diff (Mapping Importance
oi HashMap k a
o) (Mapping Importance
ni HashMap k a
n)
| HashMap k (ElemOp a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashMap k (ElemOp a)
e = Maybe (Diff (Mapping k a))
forall a. Maybe a
Nothing
| Bool
otherwise = Mapping k (ElemOp a) -> Maybe (Mapping k (ElemOp a))
forall a. a -> Maybe a
Just (Mapping k (ElemOp a) -> Maybe (Mapping k (ElemOp a)))
-> Mapping k (ElemOp a) -> Maybe (Mapping k (ElemOp a))
forall a b. (a -> b) -> a -> b
$ Importance -> HashMap k (ElemOp a) -> Mapping k (ElemOp a)
forall k v. Importance -> HashMap k v -> Mapping k v
Mapping (Importance
oi Importance -> Importance -> Importance
forall a. Semigroup a => a -> a -> a
<> Importance
ni) HashMap k (ElemOp a)
e
where
e :: HashMap k (ElemOp a)
e = ((k -> a -> Maybe (ElemOp a))
-> HashMap k a -> HashMap k (ElemOp a))
-> HashMap k a
-> (k -> a -> Maybe (ElemOp a))
-> HashMap k (ElemOp a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> a -> Maybe (ElemOp a)) -> HashMap k a -> HashMap k (ElemOp a)
forall k v1 v2.
(k -> v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybeWithKey (HashMap k a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap k a
o HashMap k a
n) ((k -> a -> Maybe (ElemOp a)) -> HashMap k (ElemOp a))
-> (k -> a -> Maybe (ElemOp a)) -> HashMap k (ElemOp a)
forall a b. (a -> b) -> a -> b
$ \k
k a
_ ->
Maybe a -> Maybe a -> Maybe (Diff (Maybe a))
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff (k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k HashMap k a
o) (k -> HashMap k a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k HashMap k a
n)
applyDiff :: Diff (Mapping k a) -> Mapping k a -> Maybe (Mapping k a)
applyDiff (Mapping imp e) (Mapping Importance
_ HashMap k a
m) =
(HashMap k (Maybe a) -> Mapping k a)
-> Maybe (HashMap k (Maybe a)) -> Maybe (Mapping k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Importance -> HashMap k a -> Mapping k a
forall k v. Importance -> HashMap k v -> Mapping k v
Mapping Importance
imp (HashMap k a -> Mapping k a)
-> (HashMap k (Maybe a) -> HashMap k a)
-> HashMap k (Maybe a)
-> Mapping k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k a -> HashMap k a -> HashMap k a
forall k v.
(Eq k, Hashable k) =>
HashMap k v -> HashMap k v -> HashMap k v
HM.union HashMap k a
additions (HashMap k a -> HashMap k a)
-> (HashMap k (Maybe a) -> HashMap k a)
-> HashMap k (Maybe a)
-> HashMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe a) -> HashMap k (Maybe a) -> HashMap k a
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe Maybe a -> Maybe a
forall a. a -> a
id) (Maybe (HashMap k (Maybe a)) -> Maybe (Mapping k a))
-> Maybe (HashMap k (Maybe a)) -> Maybe (Mapping k a)
forall a b. (a -> b) -> a -> b
$
(k -> a -> Maybe (Maybe a))
-> HashMap k a -> Maybe (HashMap k (Maybe a))
forall (f :: * -> *) k v1 v2.
Applicative f =>
(k -> v1 -> f v2) -> HashMap k v1 -> f (HashMap k v2)
HM.traverseWithKey k -> a -> Maybe (Maybe a)
applyElem HashMap k a
m
where
applyElem :: k -> a -> Maybe (Maybe a)
applyElem k
k a
v =
case k -> HashMap k (ElemOp a) -> Maybe (ElemOp a)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup k
k HashMap k (ElemOp a)
e of
Maybe (ElemOp a)
Nothing -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just (Maybe a -> Maybe (Maybe a)) -> Maybe a -> Maybe (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
v
Just (AddElem a
_) -> Maybe (Maybe a)
forall a. Maybe a
Nothing
Just (RemoveElem a
_) -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing
Just (EditElem Diff a
d) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff a -> a -> Maybe a
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff a
d a
v
additions :: HashMap k a
additions =
((ElemOp a -> Maybe a) -> HashMap k (ElemOp a) -> HashMap k a)
-> HashMap k (ElemOp a) -> (ElemOp a -> Maybe a) -> HashMap k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (ElemOp a -> Maybe a) -> HashMap k (ElemOp a) -> HashMap k a
forall v1 v2 k. (v1 -> Maybe v2) -> HashMap k v1 -> HashMap k v2
HM.mapMaybe HashMap k (ElemOp a)
e ((ElemOp a -> Maybe a) -> HashMap k a)
-> (ElemOp a -> Maybe a) -> HashMap k a
forall a b. (a -> b) -> a -> b
$ \ElemOp a
d ->
case ElemOp a
d of
AddElem a
v -> a -> Maybe a
forall a. a -> Maybe a
Just a
v
ElemOp a
_ -> Maybe a
forall a. Maybe a
Nothing
instance Eq a => Diffable (AST a) where
type Diff (AST a) = Edit a
diff :: AST a -> AST a -> Maybe (Diff (AST a))
diff (App Constr
List [AST a]
o) (App Constr
List [AST a]
n) = ListOp (AST a) -> Edit a
forall a. Diff [AST a] -> Edit a
EditList (ListOp (AST a) -> Edit a)
-> Maybe (ListOp (AST a)) -> Maybe (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AST a] -> [AST a] -> Maybe (Diff [AST a])
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff [AST a]
o [AST a]
n
diff (App Constr
co [AST a]
os) (App Constr
cn [AST a]
ns)
| Constr
co Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== Constr
cn Bool -> Bool -> Bool
&& [AST a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AST a]
os Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [AST a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AST a]
ns =
(\(ListOp [Maybe (Diff (AST a))]
es Maybe (EndOp (AST a))
_) -> Constr -> [Maybe (Edit a)] -> Edit a
forall a. Constr -> [Maybe (Edit a)] -> Edit a
EditApp Constr
co [Maybe (Diff (AST a))]
[Maybe (Edit a)]
es) (ListOp (AST a) -> Edit a)
-> Maybe (ListOp (AST a)) -> Maybe (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AST a] -> [AST a] -> Maybe (Diff [AST a])
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff [AST a]
os [AST a]
ns
diff (Let Text
vo AST a
o AST a
bo) (Let Text
vn AST a
n AST a
bn) = (Maybe (Replace Text), Maybe (Edit a), Maybe (Edit a)) -> Edit a
forall a. Diff (Text, AST a, AST a) -> Edit a
EditLet ((Maybe (Replace Text), Maybe (Edit a), Maybe (Edit a)) -> Edit a)
-> Maybe (Maybe (Replace Text), Maybe (Edit a), Maybe (Edit a))
-> Maybe (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text, AST a, AST a)
-> (Text, AST a, AST a) -> Maybe (Diff (Text, AST a, AST a))
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff (Text
vo, AST a
o, AST a
bo) (Text
vn, AST a
n, AST a
bn)
diff (Record Mapping Field (AST a)
o) (Record Mapping Field (AST a)
n) = Mapping Field (ElemOp (AST a)) -> Edit a
forall a. Diff (Mapping Field (AST a)) -> Edit a
EditRecord (Mapping Field (ElemOp (AST a)) -> Edit a)
-> Maybe (Mapping Field (ElemOp (AST a))) -> Maybe (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mapping Field (AST a)
-> Mapping Field (AST a) -> Maybe (Diff (Mapping Field (AST a)))
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff Mapping Field (AST a)
o Mapping Field (AST a)
n
diff AST a
o AST a
n = Replace (AST a) -> Edit a
forall a. Replace (AST a) -> Edit a
Replacement (Replace (AST a) -> Edit a)
-> Maybe (Replace (AST a)) -> Maybe (Edit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monolithic (AST a)
-> Monolithic (AST a) -> Maybe (Diff (Monolithic (AST a)))
forall a. Diffable a => a -> a -> Maybe (Diff a)
diff (AST a -> Monolithic (AST a)
forall a. a -> Monolithic a
Monolithic AST a
o) (AST a -> Monolithic (AST a)
forall a. a -> Monolithic a
Monolithic AST a
n)
applyDiff :: Diff (AST a) -> AST a -> Maybe (AST a)
applyDiff (Replacement d) AST a
a = Maybe (Monolithic (AST a)) -> Maybe (AST a)
coerce (Maybe (Monolithic (AST a)) -> Maybe (AST a))
-> Maybe (Monolithic (AST a)) -> Maybe (AST a)
forall a b. (a -> b) -> a -> b
$ Diff (Monolithic (AST a))
-> Monolithic (AST a) -> Maybe (Monolithic (AST a))
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff (Monolithic (AST a))
Replace (AST a)
d (AST a -> Monolithic (AST a)
forall a. a -> Monolithic a
Monolithic AST a
a)
applyDiff (EditList e) (App Constr
List [AST a]
as) = Constr -> [AST a] -> AST a
forall n. Constr -> [AST n] -> AST n
App Constr
List ([AST a] -> AST a) -> Maybe [AST a] -> Maybe (AST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff [AST a] -> [AST a] -> Maybe [AST a]
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff [AST a]
e [AST a]
as
applyDiff (EditApp c es) (App Constr
c' [AST a]
as)
| Constr
c Constr -> Constr -> Bool
forall a. Eq a => a -> a -> Bool
== Constr
c' = Constr -> [AST a] -> AST a
forall n. Constr -> [AST n] -> AST n
App Constr
c ([AST a] -> AST a) -> Maybe [AST a] -> Maybe (AST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff [AST a] -> [AST a] -> Maybe [AST a]
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff ([Maybe (Diff (AST a))] -> Maybe (EndOp (AST a)) -> ListOp (AST a)
forall a. [Maybe (Diff a)] -> Maybe (EndOp a) -> ListOp a
ListOp [Maybe (Diff (AST a))]
[Maybe (Edit a)]
es Maybe (EndOp (AST a))
forall a. Maybe a
Nothing) [AST a]
as
applyDiff (EditLet e) (Let Text
v AST a
a AST a
b) =
(\(Text
v', AST a
a', AST a
b') -> Text -> AST a -> AST a -> AST a
forall n. Text -> AST n -> AST n -> AST n
Let Text
v' AST a
a' AST a
b') ((Text, AST a, AST a) -> AST a)
-> Maybe (Text, AST a, AST a) -> Maybe (AST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff (Text, AST a, AST a)
-> (Text, AST a, AST a) -> Maybe (Text, AST a, AST a)
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff (Text, AST a, AST a)
e (Text
v, AST a
a, AST a
b)
applyDiff (EditRecord e) (Record Mapping Field (AST a)
rec) = Mapping Field (AST a) -> AST a
forall n. Mapping Field (AST n) -> AST n
Record (Mapping Field (AST a) -> AST a)
-> Maybe (Mapping Field (AST a)) -> Maybe (AST a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Diff (Mapping Field (AST a))
-> Mapping Field (AST a) -> Maybe (Mapping Field (AST a))
forall a. Diffable a => Diff a -> a -> Maybe a
applyDiff Diff (Mapping Field (AST a))
e Mapping Field (AST a)
rec
applyDiff Diff (AST a)
_ AST a
_ = Maybe (AST a)
forall a. Maybe a
Nothing
instance {-# OVERLAPPING #-}
(Pretty a, Pretty (Diff a), Show k, Ord k) =>
Pretty (Mapping k (ElemOp a)) where
pretty :: Mapping k (ElemOp a) -> Doc
pretty (Mapping Importance
imp HashMap k (ElemOp a)
m) =
Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
PP.lbrace Doc
PP.comma Doc
PP.rbrace ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
((k, ElemOp a) -> Doc) -> [(k, ElemOp a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (k, ElemOp a) -> Doc
prettyField ([(k, ElemOp a)] -> [Doc]) -> [(k, ElemOp a)] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((k, ElemOp a) -> k) -> [(k, ElemOp a)] -> [(k, ElemOp a)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (k, ElemOp a) -> k
forall a b. (a, b) -> a
fst ([(k, ElemOp a)] -> [(k, ElemOp a)])
-> [(k, ElemOp a)] -> [(k, ElemOp a)]
forall a b. (a -> b) -> a -> b
$ HashMap k (ElemOp a) -> [(k, ElemOp a)]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap k (ElemOp a)
m
where
prettyField :: (k, ElemOp a) -> Doc
prettyField (k
f, AddElem a
v) =
Doc -> Doc
PP.green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(String -> Doc
PP.text String
"+" Doc -> Doc -> Doc
<+>
Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (k -> String
forall a. Show a => a -> String
show k
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") Doc -> Doc -> Doc
PP.<$>
String -> Doc
PP.text String
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
v)
prettyField (k
f, RemoveElem a
v) =
Doc -> Doc
PP.red (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(String -> Doc
PP.text String
"-" Doc -> Doc -> Doc
<+>
Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (k -> String
forall a. Show a => a -> String
show k
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") Doc -> Doc -> Doc
PP.<$>
String -> Doc
PP.text String
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
v)
prettyField (k
f, EditElem Diff a
e) =
Doc -> Doc -> Doc
underHeader (Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (k -> String
forall a. Show a => a -> String
show k
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Diff a -> Doc
forall a. Pretty a => a -> Doc
pretty Diff a
e
instance Pretty a => Pretty (Replace a) where
pretty :: Replace a -> Doc
pretty Replace {a
original :: a
original :: forall a. Replace a -> a
original, a
new :: a
new :: forall a. Replace a -> a
new} =
Doc -> Doc
PP.red (Char -> Doc
PP.char Char
'-' Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
original)) Doc -> Doc -> Doc
PP.<$>
Doc -> Doc
PP.green (Char -> Doc
PP.char Char
'+' Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
new))
prettyEditTuple :: Pretty a => Doc -> Doc -> Doc -> [Maybe a] -> Doc
prettyEditTuple :: Doc -> Doc -> Doc -> [Maybe a] -> Doc
prettyEditTuple Doc
l Doc
sep Doc
r = Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
l Doc
sep Doc
r ([Doc] -> Doc) -> ([Maybe a] -> [Doc]) -> [Maybe a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Doc) -> [Maybe a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged a -> Doc
forall a. Pretty a => a -> Doc
pretty)
prettyEditApp :: Pretty a => NameType -> Text -> [Maybe a] -> Doc
prettyEditApp :: NameType -> Text -> [Maybe a] -> Doc
prettyEditApp NameType
t Text
c [] = NameType -> Text -> Doc
prettyNamed NameType
t Text
c
prettyEditApp NameType
t Text
c [Maybe a]
as =
Doc -> Doc -> Doc
underHeader (NameType -> Text -> Doc
prettyNamed NameType
t Text
c) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Maybe a -> Doc) -> [Maybe a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged a -> Doc
forall a. Pretty a => a -> Doc
pretty) [Maybe a]
as
instance (Pretty a, Pretty (Diff a)) => Pretty (ListOp a) where
pretty :: ListOp a -> Doc
pretty (ListOp [Maybe (Diff a)]
es Maybe (EndOp a)
endOp) =
Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
PP.lbracket Doc
PP.comma Doc
PP.rbracket ([Doc]
es' [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc]
os)
where
es' :: [Doc]
es' =
[ Doc -> Doc -> Doc
underHeader (Doc -> Doc
PP.magenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text (String
"edit @" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (Diff a -> Doc
forall a. Pretty a => a -> Doc
pretty Diff a
e)
| (Int
i :: Int, Just Diff a
e) <- [Int] -> [Maybe (Diff a)] -> [(Int, Maybe (Diff a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Maybe (Diff a)]
es
]
os :: [Doc]
os = case Maybe (EndOp a)
endOp of
Maybe (EndOp a)
Nothing -> []
Just (Append [a]
vs) ->
[ Doc -> Doc -> Doc
underHeader (Doc -> Doc
PP.magenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
"append") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
PP.green (Char -> Doc
PP.char Char
'+' Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
v))
| a
v <- [a]
vs
]
Just (DropEnd [a]
vs) ->
[ Doc -> Doc -> Doc
underHeader (Doc -> Doc
PP.magenta (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
"drop from end") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Doc -> Doc
PP.red (Char -> Doc
PP.char Char
'-' Doc -> Doc -> Doc
<+> Doc -> Doc
PP.align (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
v))
| a
v <- [a]
vs
]
instance Show a => Pretty (Edit a) where
pretty :: Edit a -> Doc
pretty (EditApp Constr
Tuple [Maybe (Edit a)]
es) =
Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
PP.lparen Doc
PP.comma Doc
PP.rparen ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Maybe (Edit a) -> Doc) -> [Maybe (Edit a)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (Edit a -> Doc) -> Maybe (Edit a) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty) [Maybe (Edit a)]
es
pretty (Replacement Replace (AST a)
e) = Replace (AST a) -> Doc
forall a. Pretty a => a -> Doc
pretty Replace (AST a)
e
pretty (EditApp Constr
List [Maybe (Edit a)]
es) = Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty (Edit a -> Doc) -> Edit a -> Doc
forall a b. (a -> b) -> a -> b
$ Diff [AST a] -> Edit a
forall a. Diff [AST a] -> Edit a
EditList ([Maybe (Diff (AST a))] -> Maybe (EndOp (AST a)) -> ListOp (AST a)
forall a. [Maybe (Diff a)] -> Maybe (EndOp a) -> ListOp a
ListOp [Maybe (Diff (AST a))]
[Maybe (Edit a)]
es Maybe (EndOp (AST a))
forall a. Maybe a
Nothing)
pretty (EditApp (Named NameType
t Text
c) [Maybe (Edit a)]
es) = NameType -> Text -> [Maybe (Edit a)] -> Doc
forall a. Pretty a => NameType -> Text -> [Maybe a] -> Doc
prettyEditApp NameType
t Text
c [Maybe (Edit a)]
es
pretty (EditList Diff [AST a]
e) = ListOp (AST a) -> Doc
forall a. Pretty a => a -> Doc
pretty Diff [AST a]
ListOp (AST a)
e
pretty (EditLet (v, a, b)) =
Doc -> Doc -> Doc
underHeader (String -> Doc
PP.string String
"let" Doc -> Doc -> Doc
PP.<+> Doc -> Doc
PP.align Doc
var Doc -> Doc -> Doc
PP.<+> Doc
"=") (Doc -> (Edit a -> Doc) -> Maybe (Edit a) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Edit a)
a)
Doc -> Doc -> Doc
PP.<$>
Doc -> Doc -> Doc
underHeader (String -> Doc
PP.string String
" in") (Doc -> (Edit a -> Doc) -> Maybe (Edit a) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty Maybe (Edit a)
b)
where
var :: Doc
var = Doc -> (Replace Text -> Doc) -> Maybe (Replace Text) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
unchanged (Replace Doc -> Doc
forall a. Pretty a => a -> Doc
pretty (Replace Doc -> Doc)
-> (Replace Text -> Replace Doc) -> Replace Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Doc) -> Replace Text -> Replace Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc
PP.string (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack)) Maybe (Replace Text)
v
pretty (EditRecord (Mapping imp erec)) =
Doc -> Doc -> Doc -> [Doc] -> Doc
verticalList Doc
PP.lbrace Doc
PP.comma Doc
PP.rbrace ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
((Field, ElemOp (AST a)) -> Doc)
-> [(Field, ElemOp (AST a))] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Field, ElemOp (AST a)) -> Doc
prettyField ([(Field, ElemOp (AST a))] -> [Doc])
-> [(Field, ElemOp (AST a))] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ((Field, ElemOp (AST a)) -> Field)
-> [(Field, ElemOp (AST a))] -> [(Field, ElemOp (AST a))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Field, ElemOp (AST a)) -> Field
forall a b. (a, b) -> a
fst ([(Field, ElemOp (AST a))] -> [(Field, ElemOp (AST a))])
-> [(Field, ElemOp (AST a))] -> [(Field, ElemOp (AST a))]
forall a b. (a -> b) -> a -> b
$ HashMap Field (ElemOp (AST a)) -> [(Field, ElemOp (AST a))]
forall k v. HashMap k v -> [(k, v)]
HM.toList HashMap Field (ElemOp (AST a))
erec
where
prettyField :: (Field, ElemOp (AST a)) -> Doc
prettyField (Field
f, AddElem AST a
v) =
Doc -> Doc
PP.green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(String -> Doc
PP.text String
"+" Doc -> Doc -> Doc
<+>
Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (Field -> String
unField Field
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") Doc -> Doc -> Doc
PP.<$>
String -> Doc
PP.text String
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
PP.align (AST a -> Doc
forall a. Pretty a => a -> Doc
pretty AST a
v)
prettyField (Field
f, RemoveElem AST a
v) =
Doc -> Doc
PP.red (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
(String -> Doc
PP.text String
"-" Doc -> Doc -> Doc
<+>
Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (Field -> String
unField Field
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") Doc -> Doc -> Doc
PP.<$>
String -> Doc
PP.text String
" " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
Doc -> Doc
PP.align (AST a -> Doc
forall a. Pretty a => a -> Doc
pretty AST a
v)
prettyField (Field
f, EditElem Diff (AST a)
e) =
Doc -> Doc -> Doc
underHeader (Importance -> Doc -> Doc
emphasize Importance
imp (String -> Doc
PP.string (Field -> String
unField Field
f)) Doc -> Doc -> Doc
<+> String -> Doc
PP.text String
"=") (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty Diff (AST a)
Edit a
e
printEdit :: Show a => Edit a -> IO ()
printEdit :: Edit a -> IO ()
printEdit Edit a
e = Doc -> IO ()
PP.putDoc (Edit a -> Doc
forall a. Pretty a => a -> Doc
pretty Edit a
e) IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO ()
putStrLn String
""
diffAsTestResult :: Show a => Maybe (Edit a) -> Doc
diffAsTestResult :: Maybe (Edit a) -> Doc
diffAsTestResult Maybe (Edit a)
Nothing = Doc -> Doc
PP.green (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.string String
"OK"
diffAsTestResult (Just Edit a
e) = Doc -> Doc -> Doc
underHeader (Doc -> Doc
PP.red (String -> Doc
PP.string String
"Fail")) (Edit a -> Doc
forall a. Pretty a => a -> Doc
PP.pretty Edit a
e)