-- | This module uses 'Expr' for richer diffs than based on 'Tree'.
module Data.TreeDiff.Expr (
    -- * Types
    Expr (..),
    ConstructorName,
    FieldName,
    EditExpr (..),
    Edit (..),
    exprDiff,
    ) where

import Prelude ()
import Prelude.Compat

import Control.DeepSeq (NFData (..))
import Data.Semialign  (alignWith)
import Data.These      (These (..))

import Data.TreeDiff.List
import Data.TreeDiff.OMap (OMap)

import qualified Data.TreeDiff.OMap as OMap
import qualified Test.QuickCheck    as QC

-- | Constructor name is a string
type ConstructorName = String
--
-- | Record field name is a string too.
type FieldName       = String

-- | A untyped Haskell-like expression.
--
-- Having richer structure than just 'Tree' allows to have richer diffs.
data Expr
    = App ConstructorName [Expr]                 -- ^ application
    | Rec ConstructorName (OMap FieldName Expr)  -- ^ record constructor
    | Lst [Expr]                                 -- ^ list constructor
  deriving (Expr -> Expr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expr -> Expr -> Bool
$c/= :: Expr -> Expr -> Bool
== :: Expr -> Expr -> Bool
$c== :: Expr -> Expr -> Bool
Eq, Eq Expr
Expr -> Expr -> Bool
Expr -> Expr -> Ordering
Expr -> Expr -> Expr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Expr -> Expr -> Expr
$cmin :: Expr -> Expr -> Expr
max :: Expr -> Expr -> Expr
$cmax :: Expr -> Expr -> Expr
>= :: Expr -> Expr -> Bool
$c>= :: Expr -> Expr -> Bool
> :: Expr -> Expr -> Bool
$c> :: Expr -> Expr -> Bool
<= :: Expr -> Expr -> Bool
$c<= :: Expr -> Expr -> Bool
< :: Expr -> Expr -> Bool
$c< :: Expr -> Expr -> Bool
compare :: Expr -> Expr -> Ordering
$ccompare :: Expr -> Expr -> Ordering
Ord, Int -> Expr -> ShowS
[Expr] -> ShowS
Expr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expr] -> ShowS
$cshowList :: [Expr] -> ShowS
show :: Expr -> String
$cshow :: Expr -> String
showsPrec :: Int -> Expr -> ShowS
$cshowsPrec :: Int -> Expr -> ShowS
Show)

instance NFData Expr where
    rnf :: Expr -> ()
rnf (App String
n [Expr]
es) = forall a. NFData a => a -> ()
rnf String
n seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Expr]
es
    rnf (Rec String
n OMap String Expr
fs) = forall a. NFData a => a -> ()
rnf String
n seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf OMap String Expr
fs
    rnf (Lst [Expr]
es)   = forall a. NFData a => a -> ()
rnf [Expr]
es

instance QC.Arbitrary Expr where
    arbitrary :: Gen Expr
arbitrary = forall a. (Int -> Int) -> Gen a -> Gen a
QC.scale (forall a. Ord a => a -> a -> a
min Int
25) forall a b. (a -> b) -> a -> b
$ forall a. (Int -> Gen a) -> Gen a
QC.sized forall {t}. (Random t, Integral t) => t -> Gen Expr
arb where
        arb :: t -> Gen Expr
arb t
n | t
n forall a. Ord a => a -> a -> Bool
<= t
0 = forall a. [Gen a] -> Gen a
QC.oneof
            [ (String -> [Expr] -> Expr
`App` []) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbName
            ,  (String -> OMap String Expr -> Expr
`Rec` forall k v. OMap k v
OMap.empty) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbName
            ]
              | Bool
otherwise = do
            t
n' <- forall a. Random a => (a, a) -> Gen a
QC.choose (t
0, t
n forall a. Integral a => a -> a -> a
`div` t
3)
            forall a. [Gen a] -> Gen a
QC.oneof
                [ String -> [Expr] -> Expr
App forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary (t -> Gen Expr
arb t
n')
                , String -> OMap String Expr -> Expr
Rec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbName forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary (t -> Gen Expr
arb t
n')
                , [Expr] -> Expr
Lst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary (t -> Gen Expr
arb t
n')
                ]

    shrink :: Expr -> [Expr]
shrink (Lst [Expr]
es)   = [Expr]
es
        forall a. [a] -> [a] -> [a]
++ [ [Expr] -> Expr
Lst [Expr]
es'    | [Expr]
es' <- forall a. Arbitrary a => a -> [a]
QC.shrink [Expr]
es ]
    shrink (Rec String
n OMap String Expr
fs) = forall k v. OMap k v -> [v]
OMap.elems OMap String Expr
fs
        forall a. [a] -> [a] -> [a]
++ [ String -> OMap String Expr -> Expr
Rec String
n' OMap String Expr
fs  | String
n'  <- forall a. Arbitrary a => a -> [a]
QC.shrink String
n  ]
        forall a. [a] -> [a] -> [a]
++ [ String -> OMap String Expr -> Expr
Rec String
n  OMap String Expr
fs' | OMap String Expr
fs' <- forall a. Arbitrary a => a -> [a]
QC.shrink OMap String Expr
fs ]
    shrink (App String
n [Expr]
es) = [Expr]
es
        forall a. [a] -> [a] -> [a]
++ [ String -> [Expr] -> Expr
App String
n' [Expr]
es  | String
n'  <- forall a. Arbitrary a => a -> [a]
QC.shrink String
n  ]
        forall a. [a] -> [a] -> [a]
++ [ String -> [Expr] -> Expr
App String
n  [Expr]
es' | [Expr]
es' <- forall a. Arbitrary a => a -> [a]
QC.shrink [Expr]
es ]

arbName :: QC.Gen String
arbName :: Gen String
arbName = forall a. [(Int, Gen a)] -> Gen a
QC.frequency
    [ (Int
10, forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
QC.liftArbitrary forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Gen a
QC.elements forall a b. (a -> b) -> a -> b
$ [Char
'a'..Char
'z'] forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] forall a. [a] -> [a] -> [a]
++ String
"+-_:")
    , (Int
1, forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
QC.arbitrary :: QC.Gen String))
    , (Int
1, forall a. Arbitrary a => Gen a
QC.arbitrary)
    , (Int
1, forall a. [a] -> Gen a
QC.elements [String
"_×_", String
"_×_×_", String
"_×_×_×_"])
    ]

-- | Diff two 'Expr'.
--
-- For examples see 'ediff' in "Data.TreeDiff.Class".
exprDiff :: Expr -> Expr -> Edit EditExpr
exprDiff :: Expr -> Expr -> Edit EditExpr
exprDiff = Expr -> Expr -> Edit EditExpr
impl
  where
    impl :: Expr -> Expr -> Edit EditExpr
impl Expr
ea Expr
eb | Expr
ea forall a. Eq a => a -> a -> Bool
== Expr
eb = forall a. a -> Edit a
Cpy (Expr -> EditExpr
EditExp Expr
ea)

    -- application
    impl ea :: Expr
ea@(App String
a [Expr]
as) eb :: Expr
eb@(App String
b [Expr]
bs)
        | String
a forall a. Eq a => a -> a -> Bool
== String
b    = forall a. a -> Edit a
Cpy forall a b. (a -> b) -> a -> b
$ String -> [Edit EditExpr] -> EditExpr
EditApp String
a (forall a b. (a -> b) -> [a] -> [b]
map Edit Expr -> Edit EditExpr
recurse (forall a. Show a => (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy forall a. Eq a => a -> a -> Bool
(==) [Expr]
as [Expr]
bs))
        | Bool
otherwise = forall a. a -> a -> Edit a
Swp (Expr -> EditExpr
EditExp Expr
ea) (Expr -> EditExpr
EditExp Expr
eb)

    -- records
    impl ea :: Expr
ea@(Rec String
a OMap String Expr
as) eb :: Expr
eb@(Rec String
b OMap String Expr
bs)
        | String
a forall a. Eq a => a -> a -> Bool
== String
b    = forall a. a -> Edit a
Cpy forall a b. (a -> b) -> a -> b
$ String -> OMap String (Edit EditExpr) -> EditExpr
EditRec String
a forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These Expr Expr -> Edit EditExpr
cls OMap String Expr
as OMap String Expr
bs
        | Bool
otherwise = forall a. a -> a -> Edit a
Swp (Expr -> EditExpr
EditExp Expr
ea) (Expr -> EditExpr
EditExp Expr
eb)
      where
        cls :: These Expr Expr -> Edit EditExpr
        cls :: These Expr Expr -> Edit EditExpr
cls (This Expr
x) = forall a. a -> Edit a
Del (Expr -> EditExpr
EditExp Expr
x)
        cls (That Expr
y) = forall a. a -> Edit a
Ins (Expr -> EditExpr
EditExp Expr
y)
        cls (These Expr
x Expr
y) = Expr -> Expr -> Edit EditExpr
exprDiff Expr
x Expr
y

    -- lists
    impl (Lst [Expr]
as) (Lst [Expr]
bs) =
        forall a. a -> Edit a
Cpy forall a b. (a -> b) -> a -> b
$ [Edit EditExpr] -> EditExpr
EditLst (forall a b. (a -> b) -> [a] -> [b]
map Edit Expr -> Edit EditExpr
recurse (forall a. Show a => (a -> a -> Bool) -> [a] -> [a] -> [Edit a]
diffBy forall a. Eq a => a -> a -> Bool
(==) [Expr]
as [Expr]
bs))

    -- If higher level doesn't match, just swap.
    impl Expr
a Expr
b = forall a. a -> a -> Edit a
Swp (Expr -> EditExpr
EditExp Expr
a) (Expr -> EditExpr
EditExp Expr
b)

    recurse :: Edit Expr -> Edit EditExpr
recurse (Ins Expr
x)   = forall a. a -> Edit a
Ins (Expr -> EditExpr
EditExp Expr
x)
    recurse (Del Expr
y)   = forall a. a -> Edit a
Del (Expr -> EditExpr
EditExp Expr
y)
    recurse (Cpy Expr
z)   = forall a. a -> Edit a
Cpy (Expr -> EditExpr
EditExp Expr
z)
    recurse (Swp Expr
x Expr
y) = Expr -> Expr -> Edit EditExpr
impl Expr
x Expr
y

-- | Type used in the result of 'ediff'.
data EditExpr
    = EditApp ConstructorName [Edit EditExpr]
    | EditRec ConstructorName (OMap FieldName (Edit EditExpr))
    | EditLst [Edit EditExpr]
    | EditExp Expr  -- ^ unchanged tree
  deriving Int -> EditExpr -> ShowS
[EditExpr] -> ShowS
EditExpr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditExpr] -> ShowS
$cshowList :: [EditExpr] -> ShowS
show :: EditExpr -> String
$cshow :: EditExpr -> String
showsPrec :: Int -> EditExpr -> ShowS
$cshowsPrec :: Int -> EditExpr -> ShowS
Show

instance NFData EditExpr where
    rnf :: EditExpr -> ()
rnf (EditApp String
n [Edit EditExpr]
es) = forall a. NFData a => a -> ()
rnf String
n seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [Edit EditExpr]
es
    rnf (EditRec String
n OMap String (Edit EditExpr)
fs) = forall a. NFData a => a -> ()
rnf String
n seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf OMap String (Edit EditExpr)
fs
    rnf (EditLst [Edit EditExpr]
es)   = forall a. NFData a => a -> ()
rnf [Edit EditExpr]
es
    rnf (EditExp Expr
e)    = forall a. NFData a => a -> ()
rnf Expr
e