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
import Testing.TestEvents
from Text import <+, class Text(join,replaceSubString,split,trim), instance Text String
import Text.GenJSON
import Text.GenParse
import Text.GenPrint
import Text.Language
gDiff{|JSONNode|} x y = case x of
JSONBool i -> case y of
JSONBool j -> gDiff{|*|} i j
_ -> add i ++ remove y
JSONInt i -> case y of
JSONInt j -> gDiff{|*|} i j
_ -> add i ++ remove y
JSONReal i -> case y of
JSONReal j -> gDiff{|*|} i j
_ -> add i ++ remove y
JSONString i -> case y of
JSONString j -> gDiff{|*|} i j
_ -> add i ++ remove y
JSONArray xs -> case y of
JSONArray ys -> gDiff{|*|} xs ys
_ -> add xs ++ remove y
JSONObject xs -> case y of
JSONObject ys -> [
{ status = if (all (\d -> d.status == Common) field_diffs) Common Changed
, value = "Object"
, children = field_diffs
}]
with
field_diffs =
[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=OnlyLeft, value=k <+ "=", children=[d]} \\ k <- xonly, d <- remove (find k xs)] ++
[{status=OnlyRight, value=k <+ "=", children=[d]} \\ k <- yonly, d <- add (find k ys)]
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)
derive gDiff GenConsAssoc, Maybe, JSONNode
derive gPrint Expression, JSONNode
gDiff{|Expression|} x y = case (x,y) of
(JSON x, JSON y) -> gDiff{|*|} x y
(GPrint x, GPrint y) -> gDiff{|*|} (preParseString x) (preParseString y)
_ -> simpleDiff (printToString x) (printToString y)
gDiff{|Expr|} x y = case (x,y) of
(ExprInt a, ExprInt b) -> gDiff{|*|} a b
(ExprChar a, ExprChar b) -> gDiff{|*|} a b
(ExprBool a, ExprBool b) -> gDiff{|*|} a b
(ExprReal a, ExprReal b) -> gDiff{|*|} a b
(ExprString a, ExprString b) -> gDiff{|*|} a b
(ExprTuple a, ExprTuple b) -> gDiff{|*|} a b
(ExprList a, ExprList b) -> gDiff{|*|} a b
(ExprArray a, ExprArray b) -> gDiff{|*|} a b
(ExprRecord r1 xs, ExprRecord r2 ys) | r1 == r2 -> [
{ status = parentStatus field_diffs
, value = fromMaybe "<unnamed record>" r1
, children = field_diffs
}]
with
field_diffs =
[ let ds = gDiff{|*|} (find k xs) (find k ys) in
{status=parentStatus ds, value=k +++ "=", children=ds} \\ k <- both] ++
[{status=OnlyLeft, value=k +++ "=", children=[{status=OnlyLeft, value=toString (find k xs), children=[]}]} \\ k <- xonly] ++
[{status=OnlyRight, value=k +++ "=", children=[{status=OnlyRight, value=toString (find k ys), children=[]}]} \\ k <- yonly]
remove :: a -> [Diff] | gDiff{|*|} a
remove x = map (setStatus OnlyLeft) (gDiff{|*|} x x)
xkeys = [k \\ ExprField k _ <-: xs]
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 =
{ 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