Commit ed44f463 authored by Camil Staps's avatar Camil Staps 🚀

Merge branch '19-gdiff-for-jsonnode-utterly-broken' into 'master'

Resolve "gDiff for JSONNode utterly broken"

Closes #19

See merge request !4
parents c07fdc68 036ec424
Pipeline #12590 passed with stage
in 40 seconds
...@@ -26,51 +26,57 @@ import Testing.Options ...@@ -26,51 +26,57 @@ import Testing.Options
import Testing.TestEvents import Testing.TestEvents
from Text import <+, class Text(join,replaceSubString,split,trim), instance Text String from Text import <+, class Text(join,replaceSubString,split,trim), instance Text String
import Text.GenJSON import Text.GenJSON
import Text.GenParse
import Text.GenPrint
import Text.Language import Text.Language
gDiff{|JSONNode|} x y = case x of derive gDiff GenConsAssoc, Maybe, JSONNode
JSONBool i -> case y of derive gPrint Expression, JSONNode
JSONBool j -> gDiff{|*|} i j
_ -> add i ++ remove y gDiff{|Expression|} x y = case (x,y) of
JSONInt i -> case y of (JSON x, JSON y) -> gDiff{|*|} x y
JSONInt j -> gDiff{|*|} i j (GPrint x, GPrint y) -> gDiff{|*|} (preParseString x) (preParseString y)
_ -> add i ++ remove y _ -> simpleDiff (printToString x) (printToString y)
JSONReal i -> case y of
JSONReal j -> gDiff{|*|} i j gDiff{|Expr|} x y = case (x,y) of
_ -> add i ++ remove y (ExprInt a, ExprInt b) -> gDiff{|*|} a b
JSONString i -> case y of (ExprChar a, ExprChar b) -> gDiff{|*|} a b
JSONString j -> gDiff{|*|} i j (ExprBool a, ExprBool b) -> gDiff{|*|} a b
_ -> add i ++ remove y (ExprReal a, ExprReal b) -> gDiff{|*|} a b
JSONArray xs -> case y of (ExprString a, ExprString b) -> gDiff{|*|} a b
JSONArray ys -> gDiff{|*|} xs ys (ExprTuple a, ExprTuple b) -> gDiff{|*|} a b
_ -> add xs ++ remove y (ExprList a, ExprList b) -> gDiff{|*|} a b
JSONObject xs -> case y of (ExprArray a, ExprArray b) -> gDiff{|*|} a b
JSONObject ys -> [ (ExprRecord r1 xs, ExprRecord r2 ys) | r1 == r2 -> [
{ status = if (all (\d -> d.status == Common) field_diffs) Common Changed { status = parentStatus field_diffs
, value = "Object" , value = fromMaybe "<unnamed record>" r1
, children = field_diffs , children = field_diffs
}] }]
with with
field_diffs = field_diffs =
[let ds = gDiff{|*|} (find k xs) (find k ys) in [ let ds = gDiff{|*|} (find k xs) (find k ys) in
{status=if (all (\d->d.status==Common) ds) Common Changed, value=k <+ "=", children=ds} \\ k <- both] ++ {status=parentStatus ds, value=k +++ "=", children=ds} \\ k <- both] ++
[{status=OnlyLeft, value=k <+ "=", children=[d]} \\ k <- xonly, d <- remove (find k xs)] ++ [{status=OnlyLeft, value=k +++ "=", children=[{status=OnlyLeft, value=toString (find k xs), children=[]}]} \\ k <- xonly] ++
[{status=OnlyRight, value=k <+ "=", children=[d]} \\ k <- yonly, d <- add (find k ys)] [{status=OnlyRight, value=k +++ "=", children=[{status=OnlyRight, value=toString (find k ys), children=[]}]} \\ k <- yonly]
with
xkeys = map fst xs
ykeys = map fst ys
both = intersect xkeys ykeys
xonly = difference xkeys ykeys
yonly = difference ykeys xkeys
find k = fromJust o lookup k
_ -> add xs ++ remove y
_ -> abort "Unimplemented gDiff for JSONNode\n"
where
add :: a -> [Diff] | gDiff{|*|} a
add x = map (setStatus OnlyRight) (gDiff{|*|} x x)
remove :: a -> [Diff] | gDiff{|*|} a xkeys = [k \\ ExprField k _ <-: xs]
remove x = map (setStatus OnlyLeft) (gDiff{|*|} x x) ykeys = [k \\ ExprField k _ <-: ys]
both = intersect xkeys ykeys
xonly = difference xkeys ykeys
yonly = difference ykeys xkeys
find k vs = case [e \\ ExprField f e <-: vs | f == k] of
[e:_] -> e
_ -> abort "gDiff_Expr: internal error\n"
parentStatus :: [Diff] -> DiffStatus
parentStatus diffs = if (all (\d -> d.status == Common) field_diffs) Common Changed
_ -> simpleDiff (toString x) (toString y)
simpleDiff :: !String !String -> [Diff]
simpleDiff left right =
[ {status=OnlyLeft, value=left, children=[]}
, {status=OnlyRight, value=right, children=[]}
]
:: *ProcessOutput = :: *ProcessOutput =
{ lines :: ![String] { lines :: ![String]
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment