{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternGuards #-}
module Hedgehog.Internal.Show (
    Name
  , Value(..)
  , ValueDiff(..)
  , LineDiff(..)

  , mkValue
  , showPretty

  , valueDiff
  , lineDiff
  , toLineDiff

  , renderValue
  , renderValueDiff
  , renderLineDiff

  , takeLeft
  , takeRight
  ) where

import           Data.Bifunctor (second)

import           Text.Show.Pretty (Value(..), Name, reify, valToStr, ppShow)


data ValueDiff =
    ValueCon Name [ValueDiff]
  | ValueRec Name [(Name, ValueDiff)]
  | ValueTuple [ValueDiff]
  | ValueList [ValueDiff]
  | ValueSame Value
  | ValueDiff Value Value
    deriving (ValueDiff -> ValueDiff -> Bool
(ValueDiff -> ValueDiff -> Bool)
-> (ValueDiff -> ValueDiff -> Bool) -> Eq ValueDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValueDiff -> ValueDiff -> Bool
== :: ValueDiff -> ValueDiff -> Bool
$c/= :: ValueDiff -> ValueDiff -> Bool
/= :: ValueDiff -> ValueDiff -> Bool
Eq, Int -> ValueDiff -> ShowS
[ValueDiff] -> ShowS
ValueDiff -> Name
(Int -> ValueDiff -> ShowS)
-> (ValueDiff -> Name) -> ([ValueDiff] -> ShowS) -> Show ValueDiff
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueDiff -> ShowS
showsPrec :: Int -> ValueDiff -> ShowS
$cshow :: ValueDiff -> Name
show :: ValueDiff -> Name
$cshowList :: [ValueDiff] -> ShowS
showList :: [ValueDiff] -> ShowS
Show)

data LineDiff =
    LineSame String
  | LineRemoved String
  | LineAdded String
    deriving (LineDiff -> LineDiff -> Bool
(LineDiff -> LineDiff -> Bool)
-> (LineDiff -> LineDiff -> Bool) -> Eq LineDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LineDiff -> LineDiff -> Bool
== :: LineDiff -> LineDiff -> Bool
$c/= :: LineDiff -> LineDiff -> Bool
/= :: LineDiff -> LineDiff -> Bool
Eq, Int -> LineDiff -> ShowS
[LineDiff] -> ShowS
LineDiff -> Name
(Int -> LineDiff -> ShowS)
-> (LineDiff -> Name) -> ([LineDiff] -> ShowS) -> Show LineDiff
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LineDiff -> ShowS
showsPrec :: Int -> LineDiff -> ShowS
$cshow :: LineDiff -> Name
show :: LineDiff -> Name
$cshowList :: [LineDiff] -> ShowS
showList :: [LineDiff] -> ShowS
Show)

data DocDiff =
    DocSame Int String
  | DocRemoved Int String
  | DocAdded Int String
  | DocOpen Int String
  | DocItem Int String [DocDiff]
  | DocClose Int String
    deriving (DocDiff -> DocDiff -> Bool
(DocDiff -> DocDiff -> Bool)
-> (DocDiff -> DocDiff -> Bool) -> Eq DocDiff
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DocDiff -> DocDiff -> Bool
== :: DocDiff -> DocDiff -> Bool
$c/= :: DocDiff -> DocDiff -> Bool
/= :: DocDiff -> DocDiff -> Bool
Eq, Int -> DocDiff -> ShowS
[DocDiff] -> ShowS
DocDiff -> Name
(Int -> DocDiff -> ShowS)
-> (DocDiff -> Name) -> ([DocDiff] -> ShowS) -> Show DocDiff
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DocDiff -> ShowS
showsPrec :: Int -> DocDiff -> ShowS
$cshow :: DocDiff -> Name
show :: DocDiff -> Name
$cshowList :: [DocDiff] -> ShowS
showList :: [DocDiff] -> ShowS
Show)

renderValue :: Value -> String
renderValue :: Value -> Name
renderValue =
  Value -> Name
valToStr

renderValueDiff :: ValueDiff -> String
renderValueDiff :: ValueDiff -> Name
renderValueDiff =
  [Name] -> Name
unlines ([Name] -> Name) -> (ValueDiff -> [Name]) -> ValueDiff -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (LineDiff -> Name) -> [LineDiff] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LineDiff -> Name
renderLineDiff ([LineDiff] -> [Name])
-> (ValueDiff -> [LineDiff]) -> ValueDiff -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  ValueDiff -> [LineDiff]
toLineDiff

renderLineDiff :: LineDiff -> String
renderLineDiff :: LineDiff -> Name
renderLineDiff = \case
  LineSame Name
x ->
    Name
"  " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x
  LineRemoved Name
x ->
    Name
"- " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x
  LineAdded Name
x ->
    Name
"+ " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x

mkValue :: Show a => a -> Maybe Value
mkValue :: forall a. Show a => a -> Maybe Value
mkValue =
  a -> Maybe Value
forall a. Show a => a -> Maybe Value
reify

showPretty :: Show a => a -> String
showPretty :: forall a. Show a => a -> Name
showPretty =
  a -> Name
forall a. Show a => a -> Name
ppShow

lineDiff :: Value -> Value -> [LineDiff]
lineDiff :: Value -> Value -> [LineDiff]
lineDiff Value
x Value
y =
  ValueDiff -> [LineDiff]
toLineDiff (ValueDiff -> [LineDiff]) -> ValueDiff -> [LineDiff]
forall a b. (a -> b) -> a -> b
$ Value -> Value -> ValueDiff
valueDiff Value
x Value
y

toLineDiff :: ValueDiff -> [LineDiff]
toLineDiff :: ValueDiff -> [LineDiff]
toLineDiff =
  (DocDiff -> [LineDiff]) -> [DocDiff] -> [LineDiff]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff Int
0 Name
"") ([DocDiff] -> [LineDiff])
-> (ValueDiff -> [DocDiff]) -> ValueDiff -> [LineDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [DocDiff] -> [DocDiff]
collapseOpen ([DocDiff] -> [DocDiff])
-> (ValueDiff -> [DocDiff]) -> ValueDiff -> [DocDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  [DocDiff] -> [DocDiff]
dropLeadingSep ([DocDiff] -> [DocDiff])
-> (ValueDiff -> [DocDiff]) -> ValueDiff -> [DocDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Int -> ValueDiff -> [DocDiff]
mkDocDiff Int
0

valueDiff :: Value -> Value -> ValueDiff
valueDiff :: Value -> Value -> ValueDiff
valueDiff Value
x Value
y =
  if Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
y then
    Value -> ValueDiff
ValueSame Value
x
  else
    case (Value
x, Value
y) of
      (Con Name
nx [Value]
xs, Con Name
ny [Value]
ys)
        | Name
nx Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
ny
        , [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ys
        ->
          Name -> [ValueDiff] -> ValueDiff
ValueCon Name
nx ((Value -> Value -> ValueDiff) -> [Value] -> [Value] -> [ValueDiff]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Value -> Value -> ValueDiff
valueDiff [Value]
xs [Value]
ys)

      (Rec Name
nx [(Name, Value)]
nxs, Rec Name
ny [(Name, Value)]
nys)
        | Name
nx Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
ny
        , ((Name, Value) -> Name) -> [(Name, Value)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Value) -> Name
forall a b. (a, b) -> a
fst [(Name, Value)]
nxs [Name] -> [Name] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Name, Value) -> Name) -> [(Name, Value)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Value) -> Name
forall a b. (a, b) -> a
fst [(Name, Value)]
nys
        , [Name]
ns <- ((Name, Value) -> Name) -> [(Name, Value)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Value) -> Name
forall a b. (a, b) -> a
fst [(Name, Value)]
nxs
        , [Value]
xs <- ((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Value) -> Value
forall a b. (a, b) -> b
snd [(Name, Value)]
nxs
        , [Value]
ys <- ((Name, Value) -> Value) -> [(Name, Value)] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name, Value) -> Value
forall a b. (a, b) -> b
snd [(Name, Value)]
nys
        ->
          Name -> [(Name, ValueDiff)] -> ValueDiff
ValueRec Name
nx ([Name] -> [ValueDiff] -> [(Name, ValueDiff)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
ns ((Value -> Value -> ValueDiff) -> [Value] -> [Value] -> [ValueDiff]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Value -> Value -> ValueDiff
valueDiff [Value]
xs [Value]
ys))

      (Tuple [Value]
xs, Tuple [Value]
ys)
        | [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ys
        ->
          [ValueDiff] -> ValueDiff
ValueTuple ((Value -> Value -> ValueDiff) -> [Value] -> [Value] -> [ValueDiff]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Value -> Value -> ValueDiff
valueDiff [Value]
xs [Value]
ys)

      (List [Value]
xs, List [Value]
ys)
        | [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
ys
        ->
          [ValueDiff] -> ValueDiff
ValueList ((Value -> Value -> ValueDiff) -> [Value] -> [Value] -> [ValueDiff]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Value -> Value -> ValueDiff
valueDiff [Value]
xs [Value]
ys)

      (Value, Value)
_ ->
        Value -> Value -> ValueDiff
ValueDiff Value
x Value
y

takeLeft :: ValueDiff -> Value
takeLeft :: ValueDiff -> Value
takeLeft = \case
  ValueCon Name
n [ValueDiff]
xs ->
    Name -> [Value] -> Value
Con Name
n ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeLeft [ValueDiff]
xs)
  ValueRec Name
n [(Name, ValueDiff)]
nxs ->
    Name -> [(Name, Value)] -> Value
Rec Name
n (((Name, ValueDiff) -> (Name, Value))
-> [(Name, ValueDiff)] -> [(Name, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ValueDiff -> Value) -> (Name, ValueDiff) -> (Name, Value)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ValueDiff -> Value
takeLeft) [(Name, ValueDiff)]
nxs)
  ValueTuple [ValueDiff]
xs ->
    [Value] -> Value
Tuple ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeLeft [ValueDiff]
xs)
  ValueList [ValueDiff]
xs ->
    [Value] -> Value
List ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeLeft [ValueDiff]
xs)
  ValueSame Value
x ->
    Value
x
  ValueDiff Value
x Value
_ ->
    Value
x

takeRight :: ValueDiff -> Value
takeRight :: ValueDiff -> Value
takeRight = \case
  ValueCon Name
n [ValueDiff]
xs ->
    Name -> [Value] -> Value
Con Name
n ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeRight [ValueDiff]
xs)
  ValueRec Name
n [(Name, ValueDiff)]
nxs ->
    Name -> [(Name, Value)] -> Value
Rec Name
n (((Name, ValueDiff) -> (Name, Value))
-> [(Name, ValueDiff)] -> [(Name, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ValueDiff -> Value) -> (Name, ValueDiff) -> (Name, Value)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ValueDiff -> Value
takeRight) [(Name, ValueDiff)]
nxs)
  ValueTuple [ValueDiff]
xs ->
    [Value] -> Value
Tuple ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeRight [ValueDiff]
xs)
  ValueList [ValueDiff]
xs ->
    [Value] -> Value
List ((ValueDiff -> Value) -> [ValueDiff] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ValueDiff -> Value
takeRight [ValueDiff]
xs)
  ValueSame Value
x ->
    Value
x
  ValueDiff Value
_ Value
x ->
    Value
x

mkLineDiff :: Int -> String -> DocDiff -> [LineDiff]
mkLineDiff :: Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff Int
indent0 Name
prefix0 DocDiff
diff =
  let
    mkLinePrefix :: Int -> Name
mkLinePrefix Int
indent =
      Int -> Name
spaces Int
indent0 Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
prefix0 Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Name
spaces Int
indent

    mkLineIndent :: Int -> Int
mkLineIndent Int
indent =
      Int
indent0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Name -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
prefix0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent
  in
    case DocDiff
diff of
      DocSame Int
indent Name
x ->
        [Name -> LineDiff
LineSame (Name -> LineDiff) -> Name -> LineDiff
forall a b. (a -> b) -> a -> b
$ Int -> Name
mkLinePrefix Int
indent Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x]

      DocRemoved Int
indent Name
x ->
        [Name -> LineDiff
LineRemoved (Name -> LineDiff) -> Name -> LineDiff
forall a b. (a -> b) -> a -> b
$ Int -> Name
mkLinePrefix Int
indent Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x]

      DocAdded Int
indent Name
x ->
        [Name -> LineDiff
LineAdded (Name -> LineDiff) -> Name -> LineDiff
forall a b. (a -> b) -> a -> b
$ Int -> Name
mkLinePrefix Int
indent Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x]

      DocOpen Int
indent Name
x ->
        [Name -> LineDiff
LineSame (Name -> LineDiff) -> Name -> LineDiff
forall a b. (a -> b) -> a -> b
$ Int -> Name
mkLinePrefix Int
indent Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x]

      DocItem Int
_ Name
_ [] ->
        []

      DocItem Int
indent Name
prefix (x :: DocDiff
x@DocRemoved{} : y :: DocDiff
y@DocAdded{} : [DocDiff]
xs) ->
        Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff (Int -> Int
mkLineIndent Int
indent) Name
prefix DocDiff
x [LineDiff] -> [LineDiff] -> [LineDiff]
forall a. [a] -> [a] -> [a]
++
        Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff (Int -> Int
mkLineIndent Int
indent) Name
prefix DocDiff
y [LineDiff] -> [LineDiff] -> [LineDiff]
forall a. [a] -> [a] -> [a]
++
        (DocDiff -> [LineDiff]) -> [DocDiff] -> [LineDiff]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff (Int -> Int
mkLineIndent (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Name -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
prefix)) Name
"") [DocDiff]
xs

      DocItem Int
indent Name
prefix (DocDiff
x : [DocDiff]
xs) ->
        Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff (Int -> Int
mkLineIndent Int
indent) Name
prefix DocDiff
x [LineDiff] -> [LineDiff] -> [LineDiff]
forall a. [a] -> [a] -> [a]
++
        (DocDiff -> [LineDiff]) -> [DocDiff] -> [LineDiff]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> Name -> DocDiff -> [LineDiff]
mkLineDiff (Int -> Int
mkLineIndent (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Name -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
prefix)) Name
"") [DocDiff]
xs

      DocClose Int
indent Name
x ->
        [Name -> LineDiff
LineSame (Name -> LineDiff) -> Name -> LineDiff
forall a b. (a -> b) -> a -> b
$ Int -> Name
spaces (Int -> Int
mkLineIndent Int
indent) Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
x]

spaces :: Int -> String
spaces :: Int -> Name
spaces Int
indent =
  Int -> Char -> Name
forall a. Int -> a -> [a]
replicate Int
indent Char
' '

collapseOpen :: [DocDiff] -> [DocDiff]
collapseOpen :: [DocDiff] -> [DocDiff]
collapseOpen = \case
  DocSame Int
indent Name
line : DocOpen Int
_ Name
bra : [DocDiff]
xs ->
    Int -> Name -> DocDiff
DocSame Int
indent (Name
line Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
" " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
bra) DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
collapseOpen [DocDiff]
xs
  DocItem Int
indent Name
prefix [DocDiff]
xs : [DocDiff]
ys ->
    Int -> Name -> [DocDiff] -> DocDiff
DocItem Int
indent Name
prefix ([DocDiff] -> [DocDiff]
collapseOpen [DocDiff]
xs) DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
collapseOpen [DocDiff]
ys
  DocDiff
x : [DocDiff]
xs ->
    DocDiff
x DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
collapseOpen [DocDiff]
xs
  [] ->
    []

dropLeadingSep :: [DocDiff] -> [DocDiff]
dropLeadingSep :: [DocDiff] -> [DocDiff]
dropLeadingSep = \case
  DocOpen Int
oindent Name
bra : DocItem Int
indent Name
prefix [DocDiff]
xs : [DocDiff]
ys ->
    Int -> Name -> DocDiff
DocOpen Int
oindent Name
bra DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: Int -> Name -> [DocDiff] -> DocDiff
DocItem (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Name -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Name
prefix) Name
"" ([DocDiff] -> [DocDiff]
dropLeadingSep [DocDiff]
xs) DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
dropLeadingSep [DocDiff]
ys
  DocItem Int
indent Name
prefix [DocDiff]
xs : [DocDiff]
ys ->
    Int -> Name -> [DocDiff] -> DocDiff
DocItem Int
indent Name
prefix ([DocDiff] -> [DocDiff]
dropLeadingSep [DocDiff]
xs) DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
dropLeadingSep [DocDiff]
ys
  DocDiff
x : [DocDiff]
xs ->
    DocDiff
x DocDiff -> [DocDiff] -> [DocDiff]
forall a. a -> [a] -> [a]
: [DocDiff] -> [DocDiff]
dropLeadingSep [DocDiff]
xs
  [] ->
    []

mkDocDiff :: Int -> ValueDiff -> [DocDiff]
mkDocDiff :: Int -> ValueDiff -> [DocDiff]
mkDocDiff Int
indent = \case
  ValueSame Value
x ->
    Int -> Name -> [DocDiff]
same Int
indent (Value -> Name
renderValue Value
x)

  ValueDiff
diff
    | Value
x <- ValueDiff -> Value
takeLeft ValueDiff
diff
    , Value
y <- ValueDiff -> Value
takeRight ValueDiff
diff
    , Value -> Bool
oneLiner Value
x
    , Value -> Bool
oneLiner Value
y
    ->
      Int -> Name -> [DocDiff]
removed Int
indent (Value -> Name
renderValue Value
x) [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
      Int -> Name -> [DocDiff]
added Int
indent (Value -> Name
renderValue Value
y)

  ValueCon Name
n [ValueDiff]
xs ->
    Int -> Name -> [DocDiff]
same Int
indent Name
n [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    (ValueDiff -> [DocDiff]) -> [ValueDiff] -> [DocDiff]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> ValueDiff -> [DocDiff]
mkDocDiff (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)) [ValueDiff]
xs

  ValueRec Name
n [(Name, ValueDiff)]
nxs ->
    Int -> Name -> [DocDiff]
same Int
indent Name
n [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    [Int -> Name -> DocDiff
DocOpen Int
indent Name
"{"] [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    ((Name, ValueDiff) -> DocDiff) -> [(Name, ValueDiff)] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Name
name, ValueDiff
x) -> Int -> Name -> [DocDiff] -> DocDiff
DocItem (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Name
", " (Int -> Name -> [DocDiff]
same Int
0 (Name
name Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
" =") [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++ Int -> ValueDiff -> [DocDiff]
mkDocDiff Int
2 ValueDiff
x)) [(Name, ValueDiff)]
nxs [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    [Int -> Name -> DocDiff
DocClose (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) Name
"}"]

  ValueTuple [ValueDiff]
xs ->
    [Int -> Name -> DocDiff
DocOpen Int
indent Name
"("] [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    (ValueDiff -> DocDiff) -> [ValueDiff] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Name -> [DocDiff] -> DocDiff
DocItem Int
indent Name
", " ([DocDiff] -> DocDiff)
-> (ValueDiff -> [DocDiff]) -> ValueDiff -> DocDiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ValueDiff -> [DocDiff]
mkDocDiff Int
0) [ValueDiff]
xs [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    [Int -> Name -> DocDiff
DocClose Int
indent Name
")"]

  ValueList [ValueDiff]
xs ->
    [Int -> Name -> DocDiff
DocOpen Int
indent Name
"["] [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    (ValueDiff -> DocDiff) -> [ValueDiff] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Name -> [DocDiff] -> DocDiff
DocItem Int
indent Name
", " ([DocDiff] -> DocDiff)
-> (ValueDiff -> [DocDiff]) -> ValueDiff -> DocDiff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ValueDiff -> [DocDiff]
mkDocDiff Int
0) [ValueDiff]
xs [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    [Int -> Name -> DocDiff
DocClose Int
indent Name
"]"]

  ValueDiff Value
x Value
y ->
    Int -> Name -> [DocDiff]
removed Int
indent (Value -> Name
renderValue Value
x) [DocDiff] -> [DocDiff] -> [DocDiff]
forall a. [a] -> [a] -> [a]
++
    Int -> Name -> [DocDiff]
added Int
indent (Value -> Name
renderValue Value
y)

oneLiner :: Value -> Bool
oneLiner :: Value -> Bool
oneLiner Value
x =
  case Name -> [Name]
lines (Value -> Name
renderValue Value
x) of
    Name
_ : Name
_ : [Name]
_ ->
      Bool
False
    [Name]
_ ->
      Bool
True

same :: Int -> String -> [DocDiff]
same :: Int -> Name -> [DocDiff]
same Int
indent =
  (Name -> DocDiff) -> [Name] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Name -> DocDiff
DocSame Int
indent) ([Name] -> [DocDiff]) -> (Name -> [Name]) -> Name -> [DocDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Name]
lines

removed :: Int -> String -> [DocDiff]
removed :: Int -> Name -> [DocDiff]
removed Int
indent =
  (Name -> DocDiff) -> [Name] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Name -> DocDiff
DocRemoved Int
indent) ([Name] -> [DocDiff]) -> (Name -> [Name]) -> Name -> [DocDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Name]
lines

added :: Int -> String -> [DocDiff]
added :: Int -> Name -> [DocDiff]
added Int
indent =
  (Name -> DocDiff) -> [Name] -> [DocDiff]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Name -> DocDiff
DocAdded Int
indent) ([Name] -> [DocDiff]) -> (Name -> [Name]) -> Name -> [DocDiff]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> [Name]
lines