-- | Functions to produce text diffs.
module Util.Diffs (
    ColorCode(..)
    , CharRange
    , colored1, colored2
    , highlightLines
    , ranges
    , Numbered(..)
    , numberedDiff
) where
import qualified Data.Algorithm.Diff as Diff
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Data.Text as Text
import           Data.Text (Text)

import qualified Util.Maps as Maps
import qualified Util.Ranges as Ranges
import qualified Util.Lists as Lists


newtype ColorCode = ColorCode Text
    deriving (Int -> ColorCode -> ShowS
[ColorCode] -> ShowS
ColorCode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorCode] -> ShowS
$cshowList :: [ColorCode] -> ShowS
show :: ColorCode -> String
$cshow :: ColorCode -> String
showsPrec :: Int -> ColorCode -> ShowS
$cshowsPrec :: Int -> ColorCode -> ShowS
Show)

type CharRange = (Int, Int)

-- | Only show the "from" side of the diff, if it's just deletion then
-- that will be enough.
colored1 :: Text -> Text -> Text
colored1 :: Text -> Text -> Text
colored1 Text
a Text
b = [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ ColorCode -> IntMap [CharRange] -> [Text] -> [Text]
highlightLines ColorCode
redColor IntMap [CharRange]
diffA forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
a
    where (IntMap [CharRange]
diffA, IntMap [CharRange]
_diffB) = Text -> Text -> (IntMap [CharRange], IntMap [CharRange])
ranges Text
a Text
b

colored2 :: Text -> Text -> Text
colored2 :: Text -> Text -> Text
colored2 Text
a Text
b =
    Text -> [Text] -> [Text] -> Text
fmtLines Text
"->"
        (ColorCode -> IntMap [CharRange] -> [Text] -> [Text]
highlightLines ColorCode
redColor IntMap [CharRange]
diffA forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
a)
        (ColorCode -> IntMap [CharRange] -> [Text] -> [Text]
highlightLines ColorCode
redColor IntMap [CharRange]
diffB forall a b. (a -> b) -> a -> b
$ Text -> [Text]
Text.lines Text
b)
    where (IntMap [CharRange]
diffA, IntMap [CharRange]
diffB) = Text -> Text -> (IntMap [CharRange], IntMap [CharRange])
ranges Text
a Text
b

fmtLines :: Text -> [Text] -> [Text] -> Text
fmtLines :: Text -> [Text] -> [Text] -> Text
fmtLines Text
operator [Text]
xs [Text]
ys = (Text
"\n"<>) forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.stripEnd forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
Text.unlines forall a b. (a -> b) -> a -> b
$ [Text]
xs forall a. Semigroup a => a -> a -> a
<> [Text
"    " forall a. Semigroup a => a -> a -> a
<> Text
operator] forall a. Semigroup a => a -> a -> a
<> [Text]
ys

highlight :: ColorCode -> Text -> Text
highlight :: ColorCode -> Text -> Text
highlight (ColorCode Text
code) Text
text
    | Text -> Bool
Text.null Text
text = Text
text
    | Bool
otherwise = Text
code forall a. Semigroup a => a -> a -> a
<> Text
text forall a. Semigroup a => a -> a -> a
<> Text
vt100Normal

-- | These codes should probably come from termcap, but I can't be bothered.
redColor :: ColorCode
redColor :: ColorCode
redColor = Text -> ColorCode
ColorCode Text
"\ESC[31m" -- red

vt100Normal :: Text
vt100Normal :: Text
vt100Normal = Text
"\ESC[m\ESC[m"

-- | Apply color ranges as produced by 'ranges'.
highlightLines :: ColorCode -> IntMap.IntMap [CharRange] -> [Text]
    -> [Text]
highlightLines :: ColorCode -> IntMap [CharRange] -> [Text] -> [Text]
highlightLines ColorCode
color IntMap [CharRange]
nums = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Text
hi [Int
0..]
    where
    hi :: Int -> Text -> Text
hi Int
i Text
line = case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
i IntMap [CharRange]
nums of
        Just [CharRange]
ranges -> ColorCode -> [CharRange] -> Text -> Text
highlightRanges ColorCode
color [CharRange]
ranges Text
line
        Maybe [CharRange]
Nothing -> Text
line

highlightRanges :: ColorCode -> [CharRange] -> Text -> Text
highlightRanges :: ColorCode -> [CharRange] -> Text -> Text
highlightRanges ColorCode
color [CharRange]
ranges = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
hi forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CharRange] -> Text -> [(Text, Text)]
splitRanges [CharRange]
ranges
    where hi :: (Text, Text) -> Text
hi (Text
outside, Text
inside) = Text
outside forall a. Semigroup a => a -> a -> a
<> ColorCode -> Text -> Text
highlight ColorCode
color Text
inside

splitRanges :: [(Int, Int)] -> Text -> [(Text, Text)] -- ^ (out, in) pairs
splitRanges :: [CharRange] -> Text -> [(Text, Text)]
splitRanges = Int -> [CharRange] -> Text -> [(Text, Text)]
go Int
0
    where
    go :: Int -> [CharRange] -> Text -> [(Text, Text)]
go Int
_ [] Text
text
        | Text -> Bool
Text.null Text
text = []
        | Bool
otherwise = [(Text
text, forall a. Monoid a => a
mempty)]
    go Int
prev ((Int
s, Int
e) : [CharRange]
ranges) Text
text = (Text
pre, Text
within) forall a. a -> [a] -> [a]
: Int -> [CharRange] -> Text -> [(Text, Text)]
go Int
e [CharRange]
ranges Text
post
        where
        (Text
pre, Text
rest) = Int -> Text -> (Text, Text)
Text.splitAt (Int
sforall a. Num a => a -> a -> a
-Int
prev) Text
text
        (Text
within, Text
post) = Int -> Text -> (Text, Text)
Text.splitAt (Int
e forall a. Num a => a -> a -> a
- Int
s) Text
rest

ranges :: Text -> Text
    -> (IntMap.IntMap [CharRange], IntMap.IntMap [CharRange])
ranges :: Text -> Text -> (IntMap [CharRange], IntMap [CharRange])
ranges Text
first Text
second =
    forall {a} {a}. ([(Int, a)], [(Int, a)]) -> (IntMap a, IntMap a)
toMap forall a b. (a -> b) -> a -> b
$ forall a b. [Paired a b] -> ([a], [b])
Lists.partitionPaired forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(a, Paired Text Text) -> Paired (a, [CharRange]) (a, [CharRange])
diffLine forall a b. (a -> b) -> a -> b
$
        forall k v1 v2.
Ord k =>
Map k v1 -> Map k v2 -> [(k, Paired v1 v2)]
Maps.pairs Map Int Text
firstByLine Map Int Text
secondByLine
    where
    toMap :: ([(Int, a)], [(Int, a)]) -> (IntMap a, IntMap a)
toMap ([(Int, a)]
as, [(Int, a)]
bs) = (forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, a)]
as, forall a. [(Int, a)] -> IntMap a
IntMap.fromList [(Int, a)]
bs)
    diffLine :: (a, Paired Text Text) -> Paired (a, [CharRange]) (a, [CharRange])
diffLine (a
num, Paired Text Text
d) = case Paired Text Text
d of
        Lists.Both Text
line1 Text
line2 -> forall a b. a -> b -> Paired a b
Lists.Both (a
num, [CharRange]
d1) (a
num, [CharRange]
d2)
            where ([CharRange]
d1, [CharRange]
d2) = Text -> Text -> ([CharRange], [CharRange])
char Text
line1 Text
line2
        Lists.First Text
line1 -> forall a b. a -> Paired a b
Lists.First (a
num, [(Int
0, Text -> Int
Text.length Text
line1)])
        Lists.Second Text
line2 -> forall a b. b -> Paired a b
Lists.Second (a
num, [(Int
0, Text -> Int
Text.length Text
line2)])
    firstByLine :: Map Int Text
firstByLine = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [(Int
n, Text
text) | Diff.First (Numbered Int
n Text
text) <- [PolyDiff (Numbered Text) (Numbered Text)]
diffs]
    secondByLine :: Map Int Text
secondByLine = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [(Int
n, Text
text) | Diff.Second (Numbered Int
n Text
text) <- [PolyDiff (Numbered Text) (Numbered Text)]
diffs]
    diffs :: [PolyDiff (Numbered Text) (Numbered Text)]
diffs = forall a. (a -> a -> Bool) -> [a] -> [a] -> [Diff (Numbered a)]
numberedDiff forall a. Eq a => a -> a -> Bool
(==) (Text -> [Text]
Text.lines Text
first) (Text -> [Text]
Text.lines Text
second)

char :: Text -> Text -> ([CharRange], [CharRange])
char :: Text -> Text -> ([CharRange], [CharRange])
char Text
first Text
second
    | forall {t :: * -> *} {a}. Foldable t => t a -> Bool
tooDifferent [CharRange]
firstCs Bool -> Bool -> Bool
|| forall {t :: * -> *} {a}. Foldable t => t a -> Bool
tooDifferent [CharRange]
secondCs =
        ([(Int
0, Text -> Int
Text.length Text
first)], [(Int
0, Text -> Int
Text.length Text
second)])
    | Bool
otherwise = ([CharRange]
firstCs, [CharRange]
secondCs)
    where
    firstCs :: [CharRange]
firstCs = [Int] -> [CharRange]
toRanges [Int
n | Diff.First (Numbered Int
n Char
_) <- [PolyDiff (Numbered Char) (Numbered Char)]
diffs]
    secondCs :: [CharRange]
secondCs = [Int] -> [CharRange]
toRanges [Int
n | Diff.Second (Numbered Int
n Char
_) <- [PolyDiff (Numbered Char) (Numbered Char)]
diffs]
    diffs :: [PolyDiff (Numbered Char) (Numbered Char)]
diffs = forall a. (a -> a -> Bool) -> [a] -> [a] -> [Diff (Numbered a)]
numberedDiff forall a. Eq a => a -> a -> Bool
(==) (Text -> String
Text.unpack Text
first) (Text -> String
Text.unpack Text
second)
    -- If there are too many diff ranges let's just mark the whole thing
    -- different.  Perhaps I should ignore spaces that are the same, but let's
    -- see how this work first.
    tooDifferent :: t a -> Bool
tooDifferent t a
ranges = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
ranges forall a. Ord a => a -> a -> Bool
> Int
2

toRanges :: [Int] -> [(Int, Int)]
toRanges :: [Int] -> [CharRange]
toRanges [Int]
xs = forall n. Ord n => [(n, n)] -> [(n, n)]
Ranges.merge_sorted [(Int
n, Int
nforall a. Num a => a -> a -> a
+Int
1) | Int
n <- [Int]
xs]

data Numbered a = Numbered {
    forall a. Numbered a -> Int
numbered :: !Int
    , forall a. Numbered a -> a
numberedVal :: !a
    } deriving (Int -> Numbered a -> ShowS
forall a. Show a => Int -> Numbered a -> ShowS
forall a. Show a => [Numbered a] -> ShowS
forall a. Show a => Numbered a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Numbered a] -> ShowS
$cshowList :: forall a. Show a => [Numbered a] -> ShowS
show :: Numbered a -> String
$cshow :: forall a. Show a => Numbered a -> String
showsPrec :: Int -> Numbered a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Numbered a -> ShowS
Show)

numberedDiff :: (a -> a -> Bool) -> [a] -> [a] -> [Diff.Diff (Numbered a)]
numberedDiff :: forall a. (a -> a -> Bool) -> [a] -> [a] -> [Diff (Numbered a)]
numberedDiff a -> a -> Bool
equal [a]
a [a]
b =
    forall a b. (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]
Diff.getDiffBy (\Numbered a
a Numbered a
b -> forall a. Numbered a -> a
numberedVal Numbered a
a a -> a -> Bool
`equal` forall a. Numbered a -> a
numberedVal Numbered a
b)
        (forall {b}. [b] -> [Numbered b]
number [a]
a) (forall {b}. [b] -> [Numbered b]
number [a]
b)
    where number :: [b] -> [Numbered b]
number = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Int -> a -> Numbered a
Numbered [Int
0..]