{-
    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

import Debug.Trace
ltt :: a -> a
ltt x :: a
x = String -> a -> a
forall a. String -> a -> a
trace (a -> String
forall a. Show a => a -> String
show a
x) a
x

format :: FormatterOptions -> IO Formatter
format :: FormatterOptions -> IO Formatter
format options :: FormatterOptions
options = do
    IORef Bool
didOutput <- 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 -> String -> String
color = if Bool
shouldColor then Int -> String -> String
forall a. Show a => a -> String -> String
colorize else Int -> String -> String
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 ())
-> (String -> String -> IO ())
-> IO ()
-> Formatter
Formatter {
        header :: IO ()
header = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return (),
        footer :: IO ()
footer = IORef Bool -> (Int -> String -> String) -> IO ()
checkFooter IORef Bool
didOutput Int -> String -> String
color,
        onFailure :: String -> String -> IO ()
onFailure = (Int -> String -> String) -> String -> String -> IO ()
reportFailure Int -> String -> String
color,
        onResult :: CheckResult -> SystemInterface IO -> IO ()
onResult  = IORef Bool
-> (Int -> String -> String)
-> CheckResult
-> SystemInterface IO
-> IO ()
reportResult IORef Bool
didOutput Int -> String -> String
color
    }


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

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

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

checkFooter :: IORef Bool -> (Int -> String -> String) -> IO ()
checkFooter didOutput :: IORef Bool
didOutput color :: Int -> String -> String
color = do
    Bool
output <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
didOutput
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
output (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            (Int -> String -> String) -> String -> IO ()
printErr Int -> String -> String
color "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) -> ColorFunc -> CheckResult -> SystemInterface IO -> IO ()
reportResult :: IORef Bool
-> (Int -> String -> String)
-> CheckResult
-> SystemInterface IO
-> IO ()
reportResult didOutput :: IORef Bool
didOutput color :: Int -> String -> String
color result :: CheckResult
result sys :: SystemInterface IO
sys = do
    let comments :: [PositionedComment]
comments = CheckResult -> [PositionedComment]
crComments CheckResult
result
    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 String Fix
fixmap = [Fix] -> Map String Fix
buildFixMap [Fix]
suggestedFixes
    ((String, Fix) -> IO ()) -> [(String, Fix)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, Fix) -> IO ()
output ([(String, Fix)] -> IO ()) -> [(String, Fix)] -> IO ()
forall a b. (a -> b) -> a -> b
$ Map String Fix -> [(String, Fix)]
forall k a. Map k a -> [(k, a)]
M.toList Map String Fix
fixmap
  where
    output :: (String, Fix) -> IO ()
output (name :: String
name, fix :: Fix
fix) = do
        Either String String
file <- (SystemInterface IO -> String -> IO (Either String String)
forall (m :: * -> *).
SystemInterface m -> String -> m (Either String String)
siReadFile SystemInterface IO
sys) String
name
        case Either String String
file of
            Right contents :: String
contents -> do
                String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> String -> String) -> DiffDoc String -> String
formatDoc Int -> String -> String
color (DiffDoc String -> String) -> DiffDoc String -> String
forall a b. (a -> b) -> a -> b
$ String -> String -> Fix -> DiffDoc String
makeDiff String
name String
contents Fix
fix
                IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
didOutput Bool
True
            Left msg :: String
msg -> (Int -> String -> String) -> String -> String -> IO ()
reportFailure Int -> String -> String
color String
name String
msg

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

coversLastLine :: [(Bool, b)] -> Bool
coversLastLine regions :: [(Bool, b)]
regions =
    case [(Bool, b)]
regions of
        [] -> Bool
False
        _ -> ((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 :: String -> String -> Fix -> DiffDoc String
makeDiff name :: String
name contents :: String
contents fix :: Fix
fix = do
    let hunks :: [(Bool, [Diff String])]
hunks = [Diff String] -> [(Bool, [Diff String])]
forall a. [Diff a] -> [(Bool, [Diff a])]
groupDiff ([Diff String] -> [(Bool, [Diff String])])
-> [Diff String] -> [(Bool, [Diff String])]
forall a b. (a -> b) -> a -> b
$ String -> Fix -> [Diff String]
computeDiff String
contents Fix
fix
    let lf :: LFStatus
lf = if [(Bool, [Diff String])] -> Bool
forall b. [(Bool, b)] -> Bool
coversLastLine [(Bool, [Diff String])]
hunks Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
hasTrailingLinefeed String
contents)
             then LFStatus
LinefeedMissing
             else LFStatus
LinefeedOk
    String -> LFStatus -> [DiffRegion String] -> DiffDoc String
forall a. String -> LFStatus -> [DiffRegion a] -> DiffDoc a
DiffDoc String
name LFStatus
lf ([DiffRegion String] -> DiffDoc String)
-> [DiffRegion String] -> DiffDoc String
forall a b. (a -> b) -> a -> b
$ [(Bool, [Diff String])] -> [DiffRegion String]
findRegions [(Bool, [Diff String])]
hunks

computeDiff :: String -> Fix -> [Diff String]
computeDiff :: String -> Fix -> [Diff String]
computeDiff contents :: String
contents fix :: Fix
fix =
    let old :: [String]
old = String -> [String]
lines String
contents
        array :: Array Int String
array = (Int, Int) -> [String] -> Array Int String
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (1, Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ ([String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
old)) [String]
old
        new :: [String]
new = Fix -> Array Int String -> [String]
applyFix Fix
fix Array Int String
array
    in [String] -> [String] -> [Diff String]
forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff [String]
old [String]
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 (\(_, l :: [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 current :: [PolyDiff a b]
current [] = [(Bool
False, [PolyDiff a b] -> [PolyDiff a b]
forall a. [a] -> [a]
reverse [PolyDiff a b]
current)]
    hunt current :: [PolyDiff a b]
current (x :: PolyDiff a b
x@Both {}:rest :: [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 current :: [PolyDiff a b]
current list :: [PolyDiff a b]
list =
        let (context :: [PolyDiff a b]
context, previous :: [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 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 current :: [PolyDiff a b]
current n :: Int
n [] =
        let (extras :: [PolyDiff a b]
extras, patch :: [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 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 current :: [PolyDiff a b]
current n :: Int
n list :: [PolyDiff a b]
list@(Both {}:_) | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
contextSizeInt -> Int -> Int
forall a. Num a => a -> a -> a
*2 =
        let (context :: [PolyDiff a b]
context, previous :: [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 current :: [PolyDiff a b]
current n :: Int
n (x :: PolyDiff a b
x@Both {}:rest :: [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
+1) [PolyDiff a b]
rest
    gather current :: [PolyDiff a b]
current n :: Int
n (x :: PolyDiff a b
x:rest :: [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) 0 [PolyDiff a b]
rest

-- Get line numbers for hunks
findRegions :: [(Bool, [Diff String])] -> [DiffRegion String]
findRegions :: [(Bool, [Diff String])] -> [DiffRegion String]
findRegions = Int -> Int -> [(Bool, [Diff String])] -> [DiffRegion String]
forall a. Int -> Int -> [(Bool, [Diff a])] -> [DiffRegion a]
find' 1 1
  where
    find' :: Int -> Int -> [(Bool, [Diff a])] -> [DiffRegion a]
find' _ _ [] = []
    find' left :: Int
left right :: Int
right ((output :: Bool
output, run :: [Diff a]
run):rest :: [(Bool, [Diff a])]
rest) =
        let (dl :: Int
dl, dr :: 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' 0 0
  where
    count' :: a -> a -> [PolyDiff a b] -> (a, a)
count' left :: a
left right :: a
right [] = (a
left, a
right)
    count' left :: a
left right :: a
right (x :: PolyDiff a b
x:rest :: [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
+1) (a
righta -> a -> a
forall a. Num 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
+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
+1) [PolyDiff a b]
rest

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

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

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

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

-- Create a Map from filename to Fix
buildFixMap :: [Fix] -> M.Map String Fix
buildFixMap :: [Fix] -> Map String Fix
buildFixMap fixes :: [Fix]
fixes = Map String 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 String Fix
perFile = (Fix -> String) -> [Fix] -> Map String Fix
forall k v. (Ord k, Monoid v) => (v -> k) -> [v] -> Map k v
groupByMap (Position -> String
posFile (Position -> String) -> (Fix -> Position) -> Fix -> String
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
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 rep1 :: Replacement
rep1 rep2 :: Replacement
rep2 = (Position -> String
posFile (Position -> String) -> Position -> String
forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repStartPos Replacement
rep1) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== (Position -> String
posFile (Position -> String) -> Position -> String
forall a b. (a -> b) -> a -> b
$ Replacement -> Position
repStartPos Replacement
rep2)
    makeFix :: [Replacement] -> Fix
makeFix reps :: [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 f :: 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 (\x :: v
x -> (v -> k
f v
x, v
x))

-- For building unit tests
b :: b -> PolyDiff b b
b n :: 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 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 8, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 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 1]), -- Omitted
    (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 8]), -- A change with three lines of context
    (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 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 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 8, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 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 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 8]), -- A change with three lines of context
    (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 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 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 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 4, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 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 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 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 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3]),
        (Bool
False, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4]),
        (Bool
True, [Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 7, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 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 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 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 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 1, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 2, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 3, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 5, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 6, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 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 1, Integer -> Diff Integer
forall a b. a -> PolyDiff a b
l 2, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 3, Integer -> Diff Integer
forall b a. b -> PolyDiff a b
r 4, Integer -> Diff Integer
forall b. b -> PolyDiff b b
b 5] (Int, Int) -> (Int, Int) -> Bool
forall a. Eq a => a -> a -> Bool
== (3,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
== (0,0)

return []
runTests :: IO Bool
runTests = Bool
Bool -> Property
[(String, Property)] -> (Property -> IO Result) -> IO Bool
Property -> IO Result
forall prop. Testable prop => prop -> IO Result
forall prop. Testable prop => prop -> Property
runQuickCheckAll :: [(String, 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