{-
    Copyright 2019 Vidar 'koala_man' Holen

    This file is part of ShellCheck.
    https://www.shellcheck.net

    ShellCheck is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    ShellCheck is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
-}
{-# LANGUAGE TemplateHaskell #-}
module ShellCheck.Formatter.Diff (format, ShellCheck.Formatter.Diff.runTests) where

import ShellCheck.Interface
import ShellCheck.Fixer
import ShellCheck.Formatter.Format

import Control.Monad
import Data.Algorithm.Diff
import Data.Array
import Data.IORef
import Data.List
import qualified Data.Monoid as Monoid
import Data.Maybe
import qualified Data.Map as M
import GHC.Exts (sortWith)
import System.IO
import System.FilePath

import Test.QuickCheck

format :: FormatterOptions -> IO Formatter
format :: FormatterOptions -> IO Formatter
format FormatterOptions
options = do
    IORef Bool
foundIssues <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    IORef Bool
reportedIssues <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
    Bool
shouldColor <- ColorOption -> IO Bool
shouldOutputColor (FormatterOptions -> ColorOption
foColorOption FormatterOptions
options)
    let color :: Int -> [Char] -> [Char]
color = if Bool
shouldColor then Int -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
colorize else Int -> [Char] -> [Char]
forall p a. p -> a -> a
nocolor
    Formatter -> IO Formatter
forall (m :: * -> *) a. Monad m => a -> m a
return Formatter :: IO ()
-> (CheckResult -> SystemInterface IO -> IO ())
-> ([Char] -> [Char] -> IO ())
-> IO ()
-> Formatter
Formatter {
        header :: IO ()
header = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
        footer :: IO ()
footer = IORef Bool -> IORef Bool -> (Int -> [Char] -> [Char]) -> IO ()
checkFooter IORef Bool
foundIssues IORef Bool
reportedIssues Int -> [Char] -> [Char]
color,
        onFailure :: [Char] -> [Char] -> IO ()
onFailure = (Int -> [Char] -> [Char]) -> [Char] -> [Char] -> IO ()
reportFailure Int -> [Char] -> [Char]
color,
        onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult  = IORef Bool
-> IORef Bool
-> (Int -> [Char] -> [Char])
-> CheckResult
-> SystemInterface IO
-> IO ()
reportResult IORef Bool
foundIssues IORef Bool
reportedIssues Int -> [Char] -> [Char]
color
    }


contextSize :: Int
contextSize = Int
3
red :: Int
red = Int
31
green :: Int
green = Int
32
yellow :: Integer
yellow = Integer
33
cyan :: Int
cyan = Int
36
bold :: Int
bold = Int
1

nocolor :: p -> a -> a
nocolor p
n = a -> a
forall a. a -> a
id
colorize :: a -> [Char] -> [Char]
colorize a
n [Char]
s = (a -> [Char]
forall a. Show a => a -> [Char]
ansi a
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Integer -> [Char]
forall a. Show a => a -> [Char]
ansi Integer
0)
ansi :: a -> [Char]
ansi a
n = [Char]
"\x1B[" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"m"

printErr :: ColorFunc -> String -> IO ()
printErr :: (Int -> [Char] -> [Char]) -> [Char] -> IO ()
printErr Int -> [Char] -> [Char]
color = Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> ([Char] -> [Char]) -> [Char] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
color Int
bold ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
color Int
red
reportFailure :: (Int -> [Char] -> [Char]) -> [Char] -> [Char] -> IO ()
reportFailure Int -> [Char] -> [Char]
color [Char]
file [Char]
msg = (Int -> [Char] -> [Char]) -> [Char] -> IO ()
printErr Int -> [Char] -> [Char]
color ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
file [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg

checkFooter :: IORef Bool -> IORef Bool -> (Int -> [Char] -> [Char]) -> IO ()
checkFooter IORef Bool
foundIssues IORef Bool
reportedIssues Int -> [Char] -> [Char]
color = do
    Bool
found <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
foundIssues
    Bool
output <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
reportedIssues
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
found Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
output) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            (Int -> [Char] -> [Char]) -> [Char] -> IO ()
printErr Int -> [Char] -> [Char]
color [Char]
"Issues were detected, but none were auto-fixable. Use another format to see them."

type ColorFunc = (Int -> String -> String)
data LFStatus = LinefeedMissing | LinefeedOk
data DiffDoc a = DiffDoc String LFStatus [DiffRegion a]
data DiffRegion a = DiffRegion (Int, Int) (Int, Int) [Diff a]

reportResult :: (IORef Bool) -> (IORef Bool) -> ColorFunc -> CheckResult -> SystemInterface IO -> IO ()
reportResult :: IORef Bool
-> IORef Bool
-> (Int -> [Char] -> [Char])
-> CheckResult
-> SystemInterface IO
-> IO ()
reportResult IORef Bool
foundIssues IORef Bool
reportedIssues Int -> [Char] -> [Char]
color CheckResult
result SystemInterface IO
sys = do
    let comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
result
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PositionedComment] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PositionedComment]
comments) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
foundIssues Bool
True
    let suggestedFixes :: [Fix]
suggestedFixes = (PositionedComment -> Maybe Fix) -> [PositionedComment] -> [Fix]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe PositionedComment -> Maybe Fix
pcFix [PositionedComment]
comments
    let fixmap :: Map [Char] Fix
fixmap = [Fix] -> Map [Char] Fix
buildFixMap [Fix]
suggestedFixes
    (([Char], Fix) -> IO ()) -> [([Char], Fix)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], Fix) -> IO ()
output ([([Char], Fix)] -> IO ()) -> [([Char], Fix)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map [Char] Fix -> [([Char], Fix)]
forall k a. Map k a -> [(k, a)]
M.toList Map [Char] Fix
fixmap
  where
    output :: ([Char], Fix) -> IO ()
output ([Char]
name, Fix
fix) = do
        Either [Char] [Char]
file <- SystemInterface IO
-> Maybe Bool -> [Char] -> IO (Either [Char] [Char])
forall (m :: * -> *).
SystemInterface m
-> Maybe Bool -> [Char] -> m (Either [Char] [Char])
siReadFile SystemInterface IO
sys (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) [Char]
name
        case Either [Char] [Char]
file of
            Right [Char]
contents -> do
                [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> [Char] -> [Char]) -> DiffDoc [Char] -> [Char]
formatDoc Int -> [Char] -> [Char]
color (DiffDoc [Char] -> [Char]) -> DiffDoc [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> Fix -> DiffDoc [Char]
makeDiff [Char]
name [Char]
contents Fix
fix
                IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
reportedIssues Bool
True
            Left [Char]
msg -> (Int -> [Char] -> [Char]) -> [Char] -> [Char] -> IO ()
reportFailure Int -> [Char] -> [Char]
color [Char]
name [Char]
msg

hasTrailingLinefeed :: [Char] -> Bool
hasTrailingLinefeed [Char]
str =
    case [Char]
str of
        [] -> Bool
True
        [Char]
_ -> [Char] -> Char
forall a. [a] -> a
last [Char]
str Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'

coversLastLine :: [(Bool, b)] -> Bool
coversLastLine [(Bool, b)]
regions =
    case [(Bool, b)]
regions of
        [] -> Bool
False
        [(Bool, b)]
_ -> ((Bool, b) -> Bool
forall a b. (a, b) -> a
fst ((Bool, b) -> Bool) -> (Bool, b) -> Bool
forall a b. (a -> b) -> a -> b
$ [(Bool, b)] -> (Bool, b)
forall a. [a] -> a
last [(Bool, b)]
regions)

-- TODO: Factor this out into a unified diff library because we're doing a lot
-- of the heavy lifting anyways.
makeDiff :: String -> String -> Fix -> DiffDoc String
makeDiff :: [Char] -> [Char] -> Fix -> DiffDoc [Char]
makeDiff [Char]
name [Char]
contents Fix
fix = do
    let hunks :: [(Bool, [Diff [Char]])]
hunks = [Diff [Char]] -> [(Bool, [Diff [Char]])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff ([Diff [Char]] -> [(Bool, [Diff [Char]])])
-> [Diff [Char]] -> [(Bool, [Diff [Char]])]
forall a b. (a -> b) -> a -> b
$ [Char] -> Fix -> [Diff [Char]]
computeDiff [Char]
contents Fix
fix
    let lf :: LFStatus
lf = if [(Bool, [Diff [Char]])] -> Bool
forall b. [(Bool, b)] -> Bool
coversLastLine [(Bool, [Diff [Char]])]
hunks Bool -> Bool -> Bool
&& Bool -> Bool
not ([Char] -> Bool
hasTrailingLinefeed [Char]
contents)
             then LFStatus
LinefeedMissing
             else LFStatus
LinefeedOk
    [Char] -> LFStatus -> [DiffRegion [Char]] -> DiffDoc [Char]
forall a. [Char] -> LFStatus -> [DiffRegion a] -> DiffDoc a
DiffDoc [Char]
name LFStatus
lf ([DiffRegion [Char]] -> DiffDoc [Char])
-> [DiffRegion [Char]] -> DiffDoc [Char]
forall a b. (a -> b) -> a -> b
$ [(Bool, [Diff [Char]])] -> [DiffRegion [Char]]
findRegions [(Bool, [Diff [Char]])]
hunks

computeDiff :: String -> Fix -> [Diff String]
computeDiff :: [Char] -> Fix -> [Diff [Char]]
computeDiff [Char]
contents Fix
fix =
    let old :: [[Char]]
old = [Char] -> [[Char]]
lines [Char]
contents
        array :: Array Int [Char]
array = (Int, Int) -> [[Char]] -> Array Int [Char]
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
1, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
old)) [[Char]]
old
        new :: [[Char]]
new = Fix -> Array Int [Char] -> [[Char]]
applyFix Fix
fix Array Int [Char]
array
    in [[Char]] -> [[Char]] -> [Diff [Char]]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff [[Char]]
old [[Char]]
new

-- Group changes into hunks
groupDiff :: [Diff a] -> [(Bool, [Diff a])]
groupDiff :: [Diff a] -> [(Bool, [Diff a])]
groupDiff = ((Bool, [Diff a]) -> Bool)
-> [(Bool, [Diff a])] -> [(Bool, [Diff a])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Bool
_, [Diff a]
l) -> Bool -> Bool
not ([Diff a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Diff a]
l)) ([(Bool, [Diff a])] -> [(Bool, [Diff a])])
-> ([Diff a] -> [(Bool, [Diff a])])
-> [Diff a]
-> [(Bool, [Diff a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Diff a] -> [Diff a] -> [(Bool, [Diff a])]
forall a b.
[PolyDiff a b] -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
hunt []
  where
    -- Churn through 'Both's until we find a difference
    hunt :: [PolyDiff a b] -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
hunt [PolyDiff a b]
current [] = [(Bool
False, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
current)]
    hunt [PolyDiff a b]
current (x :: PolyDiff a b
x@Both {}:[PolyDiff a b]
rest) = [PolyDiff a b] -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
hunt (PolyDiff a b
xPolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
:[PolyDiff a b]
current) [PolyDiff a b]
rest
    hunt [PolyDiff a b]
current [PolyDiff a b]
list =
        let ([PolyDiff a b]
context, [PolyDiff a b]
previous) = Int -> [PolyDiff a b] -> ([PolyDiff a b], [PolyDiff a b])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
contextSize [PolyDiff a b]
current
        in (Bool
False, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
previous) (Bool, [PolyDiff a b])
-> [(Bool, [PolyDiff a b])] -> [(Bool, [PolyDiff a b])]
forall a. a -> [a] -> [a]
: [PolyDiff a b] -> Int -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
gather [PolyDiff a b]
context Int
0 [PolyDiff a b]
list

    -- Pick out differences until we find a run of Both's
    gather :: [PolyDiff a b] -> Int -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
gather [PolyDiff a b]
current Int
n [] =
        let ([PolyDiff a b]
extras, [PolyDiff a b]
patch) = Int -> [PolyDiff a b] -> ([PolyDiff a b], [PolyDiff a b])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
contextSize) [PolyDiff a b]
current
        in [(Bool
True, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
patch), (Bool
False, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
extras)]

    gather [PolyDiff a b]
current Int
n list :: [PolyDiff a b]
list@(Both {}:[PolyDiff a b]
_) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
contextSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2 =
        let ([PolyDiff a b]
context, [PolyDiff a b]
previous) = Int -> [PolyDiff a b] -> ([PolyDiff a b], [PolyDiff a b])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
contextSize [PolyDiff a b]
current
        in (Bool
True, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
previous) (Bool, [PolyDiff a b])
-> [(Bool, [PolyDiff a b])] -> [(Bool, [PolyDiff a b])]
forall a. a -> [a] -> [a]
: [PolyDiff a b] -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
hunt [PolyDiff a b]
context [PolyDiff a b]
list

    gather [PolyDiff a b]
current Int
n (x :: PolyDiff a b
x@Both {}:[PolyDiff a b]
rest) = [PolyDiff a b] -> Int -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
gather (PolyDiff a b
xPolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
:[PolyDiff a b]
current) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [PolyDiff a b]
rest
    gather [PolyDiff a b]
current Int
n (PolyDiff a b
x:[PolyDiff a b]
rest) = [PolyDiff a b] -> Int -> [PolyDiff a b] -> [(Bool, [PolyDiff a b])]
gather (PolyDiff a b
xPolyDiff a b -> [PolyDiff a b] -> [PolyDiff a b]
forall a. a -> [a] -> [a]
:[PolyDiff a b]
current) Int
0 [PolyDiff a b]
rest

-- Get line numbers for hunks
findRegions :: [(Bool, [Diff String])] -> [DiffRegion String]
findRegions :: [(Bool, [Diff [Char]])] -> [DiffRegion [Char]]
findRegions = Int -> Int -> [(Bool, [Diff [Char]])] -> [DiffRegion [Char]]
forall a. Int -> Int -> [(Bool, [Diff a])] -> [DiffRegion a]
find' Int
1 Int
1
  where
    find' :: Int -> Int -> [(Bool, [Diff a])] -> [DiffRegion a]
find' Int
_ Int
_ [] = []
    find' Int
left Int
right ((Bool
output, [Diff a]
run):[(Bool, [Diff a])]
rest) =
        let (Int
dl, Int
dr) = [Diff a] -> (Int, Int)
forall a. [Diff a] -> (Int, Int)
countDelta [Diff a]
run
            remainder :: [DiffRegion a]
remainder = Int -> Int -> [(Bool, [Diff a])] -> [DiffRegion a]
find' (Int
leftInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dl) (Int
rightInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dr) [(Bool, [Diff a])]
rest
        in
            if Bool
output
            then (Int, Int) -> (Int, Int) -> [Diff a] -> DiffRegion a
forall a. (Int, Int) -> (Int, Int) -> [Diff a] -> DiffRegion a
DiffRegion (Int
left, Int
dl) (Int
right, Int
dr) [Diff a]
run DiffRegion a -> [DiffRegion a] -> [DiffRegion a]
forall a. a -> [a] -> [a]
: [DiffRegion a]
remainder
            else [DiffRegion a]
remainder

-- Get left/right line counts for a hunk
countDelta :: [Diff a] -> (Int, Int)
countDelta :: [Diff a] -> (Int, Int)
countDelta = Int -> Int -> [Diff a] -> (Int, Int)
forall a a a b.
(Num a, Num a) =>
a -> a -> [PolyDiff a b] -> (a, a)
count' Int
0 Int
0
  where
    count' :: a -> a -> [PolyDiff a b] -> (a, a)
count' a
left a
right [] = (a
left, a
right)
    count' a
left a
right (PolyDiff a b
x:[PolyDiff a b]
rest) =
        case PolyDiff a b
x of
            Both {} -> a -> a -> [PolyDiff a b] -> (a, a)
count' (a
lefta -> a -> a
forall a. Num a => a -> a -> a
+a
1) (a
righta -> a -> a
forall a. Num a => a -> a -> a
+a
1) [PolyDiff a b]
rest
            First {} -> a -> a -> [PolyDiff a b] -> (a, a)
count' (a
lefta -> a -> a
forall a. Num a => a -> a -> a
+a
1) a
right [PolyDiff a b]
rest
            Second {} -> a -> a -> [PolyDiff a b] -> (a, a)
count' a
left (a
righta -> a -> a
forall a. Num a => a -> a -> a
+a
1) [PolyDiff a b]
rest

formatRegion :: ColorFunc -> LFStatus -> DiffRegion String -> String
formatRegion :: (Int -> [Char] -> [Char])
-> LFStatus -> DiffRegion [Char] -> [Char]
formatRegion Int -> [Char] -> [Char]
color LFStatus
lf (DiffRegion (Int, Int)
left (Int, Int)
right [Diff [Char]]
diffs) =
    let header :: [Char]
header = Int -> [Char] -> [Char]
color Int
cyan ([Char]
"@@ -" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ((Int, Int) -> [Char]
forall a a. (Show a, Show a) => (a, a) -> [Char]
tup (Int, Int)
left) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" +" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ((Int, Int) -> [Char]
forall a a. (Show a, Show a) => (a, a) -> [Char]
tup (Int, Int)
right) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" @@")
    in
        [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
header [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse (LFStatus -> [Diff [Char]] -> [[Char]]
getStrings LFStatus
lf ([Diff [Char]] -> [Diff [Char]]
forall a. [a] -> [a]
reverse [Diff [Char]]
diffs))
  where
    noLF :: [Char]
noLF = [Char]
"\\ No newline at end of file"

    getStrings :: LFStatus -> [Diff [Char]] -> [[Char]]
getStrings LFStatus
LinefeedOk [Diff [Char]]
list = (Diff [Char] -> [Char]) -> [Diff [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Diff [Char] -> [Char]
format [Diff [Char]]
list
    getStrings LFStatus
LinefeedMissing list :: [Diff [Char]]
list@((Both [Char]
_ [Char]
_):[Diff [Char]]
_) = [Char]
noLF [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Diff [Char] -> [Char]) -> [Diff [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Diff [Char] -> [Char]
format [Diff [Char]]
list
    getStrings LFStatus
LinefeedMissing list :: [Diff [Char]]
list@((First [Char]
_):[Diff [Char]]
_) = [Char]
noLF [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: (Diff [Char] -> [Char]) -> [Diff [Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Diff [Char] -> [Char]
format [Diff [Char]]
list
    getStrings LFStatus
LinefeedMissing (Diff [Char]
last:[Diff [Char]]
rest) = Diff [Char] -> [Char]
format Diff [Char]
last [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: LFStatus -> [Diff [Char]] -> [[Char]]
getStrings LFStatus
LinefeedMissing [Diff [Char]]
rest

    tup :: (a, a) -> [Char]
tup (a
a,a
b) = (a -> [Char]
forall a. Show a => a -> [Char]
show a
a) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"," [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (a -> [Char]
forall a. Show a => a -> [Char]
show a
b)
    format :: Diff [Char] -> [Char]
format (Both [Char]
x [Char]
_) = Char
' 'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
x
    format (First [Char]
x) = Int -> [Char] -> [Char]
color Int
red ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Char
'-'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
x
    format (Second [Char]
x) = Int -> [Char] -> [Char]
color Int
green ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Char
'+'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
x

splitLast :: [a] -> ([a], [a])
splitLast [] = ([], [])
splitLast [a]
x =
    let ([a]
last, [a]
rest) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
x
    in ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
rest, [a]
last)

formatDoc :: (Int -> [Char] -> [Char]) -> DiffDoc [Char] -> [Char]
formatDoc Int -> [Char] -> [Char]
color (DiffDoc [Char]
name LFStatus
lf [DiffRegion [Char]]
regions) =
    let ([DiffRegion [Char]]
most, [DiffRegion [Char]]
last) = [DiffRegion [Char]] -> ([DiffRegion [Char]], [DiffRegion [Char]])
forall a. [a] -> ([a], [a])
splitLast [DiffRegion [Char]]
regions
    in
          (Int -> [Char] -> [Char]
color Int
bold ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"--- " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char]
"a" [Char] -> [Char] -> [Char]
</> [Char]
name)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          (Int -> [Char] -> [Char]
color Int
bold ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"+++ " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ([Char]
"b" [Char] -> [Char] -> [Char]
</> [Char]
name)) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          (DiffRegion [Char] -> [Char]) -> [DiffRegion [Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> [Char] -> [Char])
-> LFStatus -> DiffRegion [Char] -> [Char]
formatRegion Int -> [Char] -> [Char]
color LFStatus
LinefeedOk) [DiffRegion [Char]]
most [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
          (DiffRegion [Char] -> [Char]) -> [DiffRegion [Char]] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Int -> [Char] -> [Char])
-> LFStatus -> DiffRegion [Char] -> [Char]
formatRegion Int -> [Char] -> [Char]
color LFStatus
lf) [DiffRegion [Char]]
last

-- Create a Map from filename to Fix
buildFixMap :: [Fix] -> M.Map String Fix
buildFixMap :: [Fix] -> Map [Char] Fix
buildFixMap [Fix]
fixes = Map [Char] Fix
perFile
  where
    splitFixes :: [Fix]
splitFixes = (Fix -> [Fix]) -> [Fix] -> [Fix]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Fix -> [Fix]
splitFixByFile [Fix]
fixes
    perFile :: Map [Char] Fix
perFile = (Fix -> [Char]) -> [Fix] -> Map [Char] Fix
forall k v. (Ord k, Monoid v) => (v -> k) -> [v] -> Map k v
groupByMap (Position -> [Char]
posFile (Position -> [Char]) -> (Fix -> Position) -> Fix -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Replacement -> Position
repStartPos (Replacement -> Position)
-> (Fix -> Replacement) -> Fix -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Replacement] -> Replacement
forall a. [a] -> a
head ([Replacement] -> Replacement)
-> (Fix -> [Replacement]) -> Fix -> Replacement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fix -> [Replacement]
fixReplacements) [Fix]
splitFixes

-- There are currently no multi-file fixes, but let's handle it anyways
splitFixByFile :: Fix -> [Fix]
splitFixByFile :: Fix -> [Fix]
splitFixByFile Fix
fix = ([Replacement] -> Fix) -> [[Replacement]] -> [Fix]
forall a b. (a -> b) -> [a] -> [b]
map [Replacement] -> Fix
makeFix ([[Replacement]] -> [Fix]) -> [[Replacement]] -> [Fix]
forall a b. (a -> b) -> a -> b
$ (Replacement -> Replacement -> Bool)
-> [Replacement] -> [[Replacement]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy Replacement -> Replacement -> Bool
sameFile (Fix -> [Replacement]
fixReplacements Fix
fix)
  where
    sameFile :: Replacement -> Replacement -> Bool
sameFile Replacement
rep1 Replacement
rep2 = (Position -> [Char]
posFile (Position -> [Char]) -> Position -> [Char]
forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repStartPos Replacement
rep1) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Position -> [Char]
posFile (Position -> [Char]) -> Position -> [Char]
forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repStartPos Replacement
rep2)
    makeFix :: [Replacement] -> Fix
makeFix [Replacement]
reps = Fix
newFix { fixReplacements :: [Replacement]
fixReplacements = [Replacement]
reps }

groupByMap :: (Ord k, Monoid v) => (v -> k) -> [v] -> M.Map k v
groupByMap :: (v -> k) -> [v] -> Map k v
groupByMap v -> k
f = (v -> v -> v) -> [(k, v)] -> Map k v
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith v -> v -> v
forall a. Monoid a => a -> a -> a
Monoid.mappend ([(k, v)] -> Map k v) -> ([v] -> [(k, v)]) -> [v] -> Map k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> (k, v)) -> [v] -> [(k, v)]
forall a b. (a -> b) -> [a] -> [b]
map (\v
x -> (v -> k
f v
x, v
x))

-- For building unit tests
b :: b -> PolyDiff b b
b b
n = b -> b -> PolyDiff b b
forall a b. a -> b -> PolyDiff a b
Both b
n b
n
l :: a -> PolyDiff a b
l = a -> PolyDiff a b
forall a b. a -> PolyDiff a b
First
r :: b -> PolyDiff a b
r = b -> PolyDiff a b
forall a b. b -> PolyDiff a b
Second

prop_identifiesProperContext :: Bool
prop_identifiesProperContext = [Diff Integer] -> [(Bool, [Diff Integer])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
8, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
9] [(Bool, [Diff Integer])] -> [(Bool, [Diff Integer])] -> Bool
forall a. Eq a => a -> a -> Bool
==
    [(Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1]), -- Omitted
    (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
8]), -- A change with three lines of context
    (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
9])]  -- Omitted

prop_includesContextFromStartIfNecessary :: Bool
prop_includesContextFromStartIfNecessary = [Diff Integer] -> [(Bool, [Diff Integer])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
8, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
9] [(Bool, [Diff Integer])] -> [(Bool, [Diff Integer])] -> Bool
forall a. Eq a => a -> a -> Bool
==
    [ -- Nothing omitted
    (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
8]), -- A change with three lines of context
    (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
9])]  -- Omitted

prop_includesContextUntilEndIfNecessary :: Bool
prop_includesContextUntilEndIfNecessary = [Diff Integer] -> [(Bool, [Diff Integer])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5] [(Bool, [Diff Integer])] -> [(Bool, [Diff Integer])] -> Bool
forall a. Eq a => a -> a -> Bool
==
    [ -- Nothing omitted
        (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
5])
    ] -- Nothing Omitted

prop_splitsIntoMultipleHunks :: Bool
prop_splitsIntoMultipleHunks = [Diff Integer] -> [(Bool, [Diff Integer])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff [Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
8] [(Bool, [Diff Integer])] -> [(Bool, [Diff Integer])] -> Bool
forall a. Eq a => a -> a -> Bool
==
    [ -- Nothing omitted
        (Bool
True, [Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3]),
        (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4]),
        (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
7, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
8])
    ] -- Nothing Omitted

prop_splitsIntoMultipleHunksUnlessTouching :: Bool
prop_splitsIntoMultipleHunksUnlessTouching = [Diff Integer] -> [(Bool, [Diff Integer])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff [Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
7] [(Bool, [Diff Integer])] -> [(Bool, [Diff Integer])] -> Bool
forall a. Eq a => a -> a -> Bool
==
    [
        (Bool
True, [Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
6, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
7])
    ]

prop_countDeltasWorks :: Bool
prop_countDeltasWorks = [Diff Integer] -> (Int, Int)
forall a. [Diff a] -> (Int, Int)
countDelta [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
1, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l Integer
2, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
3, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r Integer
4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b Integer
5] (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
3,Int
4)
prop_countDeltasWorks2 :: Bool
prop_countDeltasWorks2 = [Diff Any] -> (Int, Int)
forall a. [Diff a] -> (Int, Int)
countDelta [] (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
0,Int
0)

return []
runTests :: IO Bool
runTests = Bool
[Char]
[([Char], Property)]
Bool -> Property
[([Char], Property)] -> (Property -> IO Result) -> IO Bool
Property -> IO Result
forall prop. Testable prop => prop -> IO Result
forall prop. Testable prop => prop -> Property
runQuickCheckAll :: [([Char], Property)] -> (Property -> IO Result) -> IO Bool
property :: forall prop. Testable prop => prop -> Property
quickCheckResult :: forall prop. Testable prop => prop -> IO Result
prop_countDeltasWorks2 :: Bool
prop_countDeltasWorks :: Bool
prop_splitsIntoMultipleHunksUnlessTouching :: Bool
prop_splitsIntoMultipleHunks :: Bool
prop_includesContextUntilEndIfNecessary :: Bool
prop_includesContextFromStartIfNecessary :: Bool
prop_identifiesProperContext :: Bool
$quickCheckAll