{-# LANGUAGE CPP, ScopedTypeVariables #-}
--
-- Copyright (c) 2011-2022   Stefan Wehr - http://www.stefanwehr.de
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library 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
-- Lesser General Public License for more details.
--
-- You should have received a copy of the GNU Lesser General Public
-- License along with this library; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
--

module Test.Framework.Diff (

    DiffConfig(..), diffWithSensibleConfig, diff, main

) where

#ifndef MIN_VERSION_base
#define MIN_VERSION_base(a,b,c) 1
#endif

#if !MIN_VERSION_base(4,6,0)
import Prelude hiding (catch)
#endif

import Control.Exception (catch, finally, IOException)
import qualified Data.List as List
import Data.Char
import qualified Data.Algorithm.Diff as D
import Data.Algorithm.DiffOutput
import Test.Framework.Colors

-- for testing
import System.IO
import System.Directory
import System.Exit
import System.Process
import System.Environment (getArgs)
import qualified Data.Text as T

data Pos = First | Middle | Last | FirstLast
         deriving (Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
/= :: Pos -> Pos -> Bool
Eq)

isLast :: Pos -> Bool
isLast :: Pos -> Bool
isLast Pos
Last = Bool
True
isLast Pos
FirstLast = Bool
True
isLast Pos
_ = Bool
False

isFirst :: Pos -> Bool
isFirst :: Pos -> Bool
isFirst Pos
First = Bool
True
isFirst Pos
FirstLast = Bool
True
isFirst Pos
_ = Bool
False

data DiffConfig = DiffConfig {
    -- for single line diffs
      DiffConfig -> String -> ColorString
dc_fromFirst :: String -> ColorString
    , DiffConfig -> String -> ColorString
dc_fromSecond :: String -> ColorString
    , DiffConfig -> String -> ColorString
dc_fromBoth :: String -> ColorString
    , DiffConfig -> ColorString
dc_sep :: ColorString
    , DiffConfig -> String -> ColorString
dc_skip :: String -> ColorString
    -- for multi-line diffs
    , DiffConfig -> String -> ColorString
dc_lineFromFirst :: String -> ColorString
    , DiffConfig -> String -> ColorString
dc_lineFromSecond :: String -> ColorString
    }

mkDefaultDiffConfig :: Color -> Color -> Color -> Char -> Char -> DiffConfig
mkDefaultDiffConfig :: Color -> Color -> Color -> Char -> Char -> DiffConfig
mkDefaultDiffConfig Color
c1 Color
c2 Color
c3 Char
f Char
s = DiffConfig {
      dc_fromFirst :: String -> ColorString
dc_fromFirst = \String
x -> Color -> String -> String -> ColorString
colorize' Color
c1 String
x (Char
f Char -> String -> String
forall a. a -> [a] -> [a]
: String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
    , dc_fromSecond :: String -> ColorString
dc_fromSecond = \String
x -> Color -> String -> String -> ColorString
colorize' Color
c2 String
x (Char
s Char -> String -> String
forall a. a -> [a] -> [a]
: String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
    , dc_fromBoth :: String -> ColorString
dc_fromBoth = \String
x -> String -> String -> ColorString
noColor' String
x (String
"C " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x)
    , dc_skip :: String -> ColorString
dc_skip = \String
x -> Color -> String -> String -> ColorString
colorize' Color
c3 (String
"..." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...") (String
"<..." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...>")
    , dc_sep :: ColorString
dc_sep = String -> String -> ColorString
noColor' String
"" String
"\n"
    , dc_lineFromFirst :: String -> ColorString
dc_lineFromFirst = Color -> String -> ColorString
colorize Color
c1
    , dc_lineFromSecond :: String -> ColorString
dc_lineFromSecond = Color -> String -> ColorString
colorize Color
c2
    }

defaultDiffConfig :: DiffConfig
defaultDiffConfig :: DiffConfig
defaultDiffConfig = Color -> Color -> Color -> Char -> Char -> DiffConfig
mkDefaultDiffConfig Color
firstDiffColor Color
secondDiffColor Color
skipDiffColor Char
'F' Char
'S'

contextSize :: Int
contextSize :: Int
contextSize = Int
10

prepareStringsForDiff :: String -> String -> (String, String, Maybe (String, String))
prepareStringsForDiff :: String -> String -> (String, String, Maybe (String, String))
prepareStringsForDiff String
s1 String
s2 =
    case (Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
1024 String
s1, Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
List.splitAt Int
1024 String
s2) of
      ((String
start1, rest1 :: String
rest1@(Char
_:String
_)), (String
start2, rest2 :: String
rest2@(Char
_:String
_))) -> (String
start1, String
start2, (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
rest1, String
rest2))
      ((String
start1, []), (String
start2, String
_)) -> (String
start1, String
start2, Maybe (String, String)
forall a. Maybe a
Nothing)
      ((String
start1, String
_), (String
start2, [])) -> (String
start1, String
start2, Maybe (String, String)
forall a. Maybe a
Nothing)

singleLineDiff :: DiffConfig -> String -> String -> ColorString
singleLineDiff :: DiffConfig -> String -> String -> ColorString
singleLineDiff DiffConfig
dc String
s1 String
s2 = (Int, Int) -> (String, String) -> ColorString
loop (Int
0, Int
0) (String
s1, String
s2)
    where
      loop :: (Int, Int) -> (String, String) -> ColorString
      loop :: (Int, Int) -> (String, String) -> ColorString
loop (Int
skipped1, Int
skipped2) (String
s1, String
s2) =
          let (String
start1, String
start2, Maybe (String, String)
cont) = String -> String -> (String, String, Maybe (String, String))
prepareStringsForDiff String
s1 String
s2
          in case DiffConfig -> String -> String -> Maybe ColorString
singleLineDiff' DiffConfig
dc String
start1 String
start2 of
               Just ColorString
cs ->
                   let prefix :: ColorString
prefix =
                           if Int
skipped1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
skipped1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                           then ColorString
emptyColorString
                           else DiffConfig -> String -> ColorString
dc_skip DiffConfig
dc
                                    (String
"skipped " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
skipped1 String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                     String
" chars from first string, "
                                    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
skipped2 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" chars from second string")
                       suffix :: ColorString
suffix =
                           case Maybe (String, String)
cont of
                             Maybe (String, String)
Nothing -> ColorString
emptyColorString
                             Just (String
r1, String
r2) ->
                                 DiffConfig -> String -> ColorString
dc_skip DiffConfig
dc
                                     (String
"skipped " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r1) String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      String
" chars from first string, " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                      Int -> String
forall a. Show a => a -> String
show (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
r2) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" chars from second string")
                   in ColorString
prefix ColorString -> ColorString -> ColorString
+++ ColorString
cs ColorString -> ColorString -> ColorString
+++ ColorString
suffix
               Maybe ColorString
Nothing ->
                   case Maybe (String, String)
cont of
                     Just (String
r1, String
r2) ->
                         (Int, Int) -> (String, String) -> ColorString
loop (Int
skipped1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
start1, Int
skipped2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
start2) (String
r1, String
r2)
                     Maybe (String, String)
Nothing -> ColorString
emptyColorString

singleLineDiff' :: DiffConfig -> String -> String -> Maybe ColorString
singleLineDiff' :: DiffConfig -> String -> String -> Maybe ColorString
singleLineDiff' DiffConfig
dc String
s1 String
s2
    | String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
s2 = Maybe ColorString
forall a. Maybe a
Nothing
    | Bool
otherwise =
        let groups :: [Diff String]
groups = String -> String -> [Diff String]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
D.getGroupedDiff String
s1 String
s2
        in ColorString -> Maybe ColorString
forall a. a -> Maybe a
Just (ColorString -> Maybe ColorString)
-> ColorString -> Maybe ColorString
forall a b. (a -> b) -> a -> b
$
           ((Diff String, Pos) -> ColorString -> ColorString)
-> ColorString -> [(Diff String, Pos)] -> ColorString
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Diff String
group, Pos
pos) ColorString
string ->
                      (Pos -> Diff String -> ColorString
showDiffGroup Pos
pos Diff String
group) ColorString -> ColorString -> ColorString
+++
                      (if Bool -> Bool
not (Pos -> Bool
isLast Pos
pos) then DiffConfig -> ColorString
dc_sep DiffConfig
dc else ColorString
emptyColorString) ColorString -> ColorString -> ColorString
+++
                      ColorString
string)
                 ColorString
emptyColorString ([Diff String] -> [(Diff String, Pos)]
forall {a}. [a] -> [(a, Pos)]
addPositions [Diff String]
groups)
    where
      showDiffGroup :: Pos -> Diff String -> ColorString
showDiffGroup Pos
_ (D.First String
s) = DiffConfig -> String -> ColorString
dc_fromFirst DiffConfig
dc String
s
      showDiffGroup Pos
_ (D.Second String
s) = DiffConfig -> String -> ColorString
dc_fromSecond DiffConfig
dc String
s
      showDiffGroup Pos
pos (D.Both String
inBoth String
_) =
          let showStart :: Bool
showStart = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pos -> Bool
isFirst Pos
pos
              showEnd :: Bool
showEnd = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Pos -> Bool
isLast Pos
pos
              (String
contextStart, String
ignored, String
contextEnd) =
                  let (String
s, String
rest) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
contextSize String
inBoth
                      (String
i, String
e) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rest Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
contextSize) String
rest
                      start :: String
start = if Bool
showStart then String
s else String
""
                      end :: String
end = if Bool
showEnd then String
e else String
""
                      ign :: String
ign = (if Bool
showStart then String
"" else String
s) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
i String -> String -> String
forall a. [a] -> [a] -> [a]
++
                            (if Bool
showEnd then String
"" else String
e)
                  in (String
start, String
ign, String
end)
              middle :: ColorString
middle = let n :: Int
n = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ignored
                           replText :: String
replText = String
"skipped " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" chars"
                       in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
replText
                          then DiffConfig -> String -> ColorString
dc_skip DiffConfig
dc String
ignored
                          else DiffConfig -> String -> ColorString
dc_skip DiffConfig
dc String
replText
          in DiffConfig -> String -> ColorString
dc_fromBoth DiffConfig
dc String
contextStart ColorString -> ColorString -> ColorString
+++ ColorString
middle ColorString -> ColorString -> ColorString
+++ DiffConfig -> String -> ColorString
dc_fromBoth DiffConfig
dc String
contextEnd
      addPositions :: [a] -> [(a, Pos)]
addPositions [] = []
      addPositions (a
x:[]) = (a
x, Pos
FirstLast) (a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall a. a -> [a] -> [a]
: []
      addPositions (a
x:[a]
xs) = (a
x, Pos
First) (a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall a. a -> [a] -> [a]
: [a] -> [(a, Pos)]
forall {a}. [a] -> [(a, Pos)]
addPositions' [a]
xs
      addPositions' :: [a] -> [(a, Pos)]
addPositions' [] = []
      addPositions' (a
x:[]) = (a
x, Pos
Last) (a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall a. a -> [a] -> [a]
: []
      addPositions' (a
x:[a]
xs) = (a
x, Pos
Middle) (a, Pos) -> [(a, Pos)] -> [(a, Pos)]
forall a. a -> [a] -> [a]
: [a] -> [(a, Pos)]
addPositions' [a]
xs

multiLineDiff :: DiffConfig -> String -> String -> IO ColorString
multiLineDiff :: DiffConfig -> String -> String -> IO ColorString
multiLineDiff DiffConfig
cfg String
left String
right =
    ((String, Handle) -> (String, Handle) -> IO ColorString)
-> IO ColorString
forall {b}. ((String, Handle) -> (String, Handle) -> IO b) -> IO b
withTempFiles (((String, Handle) -> (String, Handle) -> IO ColorString)
 -> IO ColorString)
-> ((String, Handle) -> (String, Handle) -> IO ColorString)
-> IO ColorString
forall a b. (a -> b) -> a -> b
$ \(String
fpLeft, Handle
hLeft) (String
fpRight, Handle
hRight) ->
        do Handle -> String -> IO ()
write Handle
hLeft String
leftForFile
           Handle -> String -> IO ()
write Handle
hRight String
rightForFile
           String -> String -> IO ColorString
doDiff String
fpLeft String
fpRight
    where
      (String
leftForFile, String
rightForFile) =
        if String -> Maybe Char
forall {a}. [a] -> Maybe a
lastChar String
left Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\n' Bool -> Bool -> Bool
&& String -> Maybe Char
forall {a}. [a] -> Maybe a
lastChar String
right Maybe Char -> Maybe Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'\n'
        then (String
left String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n", String
right String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") -- avoid "No newline at end of file" error messages
        else (String
left, String
right)
      lastChar :: [a] -> Maybe a
lastChar [a]
s =
        case [a] -> [a]
forall a. [a] -> [a]
reverse [a]
s of
          [] -> Maybe a
forall a. Maybe a
Nothing
          (a
c:[a]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
c
      doDiff :: String -> String -> IO ColorString
doDiff String
leftFile String
rightFile =
          (do (ExitCode
ecode, String
out, String
_err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"diff" [String
"-u", String
leftFile, String
rightFile] String
""
              case ExitCode
ecode of
                ExitCode
ExitSuccess -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ColorString
format String
out)
                ExitFailure Int
1 -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ColorString
format String
out)
                ExitFailure Int
_i -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ColorString -> IO ColorString) -> ColorString -> IO ColorString
forall a b. (a -> b) -> a -> b
$ String -> String -> ColorString
multiLineDiffHaskell String
left String
right)
             -- if we can't launch diff, use the Haskell code.
             -- We don't write the exception anywhere to not pollute test results.
            IO ColorString -> (IOException -> IO ColorString) -> IO ColorString
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOException
_::IOException) -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ColorString -> IO ColorString) -> ColorString -> IO ColorString
forall a b. (a -> b) -> a -> b
$ String -> String -> ColorString
multiLineDiffHaskell String
left String
right)
      saveRemove :: String -> IO ()
saveRemove String
fp =
          String -> IO ()
removeFile String
fp IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\IOException
e -> Handle -> String -> IO ()
hPutStrLn Handle
stderr (IOException -> String
forall a. Show a => a -> String
show (IOException
e::IOException)))
      withTempFiles :: ((String, Handle) -> (String, Handle) -> IO b) -> IO b
withTempFiles (String, Handle) -> (String, Handle) -> IO b
action =
          do String
dir <- IO String
getTemporaryDirectory
             left :: (String, Handle)
left@(String
fpLeft, Handle
_) <- String -> String -> IO (String, Handle)
openTempFile String
dir String
"HTF-diff-EXPECTED_.txt"
             (do right :: (String, Handle)
right@(String
fpRight, Handle
_) <- String -> String -> IO (String, Handle)
openTempFile String
dir String
"HTF-diff-ACTUAL_.txt"
                 (String, Handle) -> (String, Handle) -> IO b
action (String, Handle)
left (String, Handle)
right IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
`finally` String -> IO ()
saveRemove String
fpRight
              IO b -> IO () -> IO b
forall a b. IO a -> IO b -> IO a
`finally` String -> IO ()
saveRemove String
fpLeft)
      write :: Handle -> String -> IO ()
write Handle
h String
s =
          do Handle -> String -> IO ()
hPutStr Handle
h String
s
             Handle -> IO ()
hClose Handle
h
      format :: String -> ColorString
format String
out = [ColorString] -> ColorString
unlinesColorString ([ColorString] -> ColorString) -> [ColorString] -> ColorString
forall a b. (a -> b) -> a -> b
$ (String -> ColorString) -> [String] -> [ColorString]
forall a b. (a -> b) -> [a] -> [b]
map String -> ColorString
formatLine (String -> [String]
lines String
out)
      formatLine :: String -> ColorString
formatLine String
l =
          case String
l of
            (Char
'<' : String
_) -> String -> ColorString
fromFirst String
l
            (Char
'>' : String
_) -> String -> ColorString
fromSecond String
l
            (Char
c : String
_)
                 | Char -> Bool
isDigit Char
c -> case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.span (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'c' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'd') String
l of
                                  (String
left, Char
c:String
right) -> String -> ColorString
fromFirst String
left ColorString -> ColorString -> ColorString
+++
                                                     String -> ColorString
noColor [Char
c] ColorString -> ColorString -> ColorString
+++
                                                     String -> ColorString
fromSecond String
right
                                  (String
left, []) -> String -> ColorString
noColor String
left
                 | Bool
otherwise -> String -> ColorString
noColor String
l
            [] -> String -> ColorString
noColor String
l
          where
            fromFirst :: String -> ColorString
fromFirst String
s = DiffConfig -> String -> ColorString
dc_fromFirst DiffConfig
cfg String
s
            fromSecond :: String -> ColorString
fromSecond String
s = DiffConfig -> String -> ColorString
dc_fromSecond DiffConfig
cfg String
s

diff :: DiffConfig -> String -> String -> IO ColorString
diff :: DiffConfig -> String -> String -> IO ColorString
diff DiffConfig
cfg String
left String
right = do
    case (String -> [String]
lines String
left, String -> [String]
lines String
right) of
      ([], []) -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ColorString
emptyColorString
      ([], [String
_]) -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffConfig -> String -> String -> ColorString
singleLineDiff DiffConfig
cfg String
left String
right)
      ([String
_], []) -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffConfig -> String -> String -> ColorString
singleLineDiff DiffConfig
cfg String
left String
right)
      ([String
_], [String
_]) -> ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffConfig -> String -> String -> ColorString
singleLineDiff DiffConfig
cfg String
left String
right)
      ([String], [String])
_ -> DiffConfig -> String -> String -> IO ColorString
multiLineDiff DiffConfig
cfg String
left String
right

diffWithSensibleConfig :: String -> String -> IO ColorString
diffWithSensibleConfig :: String -> String -> IO ColorString
diffWithSensibleConfig String
s1 String
s2 =
    DiffConfig -> String -> String -> IO ColorString
diff DiffConfig
defaultDiffConfig String
s1 String
s2

{-
Haskell diff, in case the diff tool is not present
-}
multiLineDiffHaskell :: String -> String -> ColorString
multiLineDiffHaskell :: String -> String -> ColorString
multiLineDiffHaskell String
left String
right =
    if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
left Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen Bool -> Bool -> Bool
|| String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
right Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLen
    then String -> ColorString
noColor
             (String
"Refusing to compute a multiline diff for strings with more than " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxLen String -> String -> String
forall a. [a] -> [a] -> [a]
++
              String
" chars. Please install the 'diff' tool to get a diff ouput.")
    else String -> ColorString
noColor (String -> ColorString) -> String -> ColorString
forall a b. (a -> b) -> a -> b
$ [Diff [String]] -> String
ppDiff ([Diff [String]] -> String) -> [Diff [String]] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [Diff [String]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
D.getGroupedDiff (String -> [String]
lines String
left) (String -> [String]
lines String
right)
    where
      maxLen :: Int
maxLen = Int
10000

main :: IO ()
main =
    do [String]
args <- IO [String]
getArgs
       (String
leftFp, String
rightFp) <-
           case [String]
args of
             [String
x] -> (String, String) -> IO (String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x, String
x)
             [String
x, String
y] -> (String, String) -> IO (String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
x, String
y)
             [String]
_ -> String -> IO (String, String)
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"USAGE: diff FILE1 FILE2")
       String
left <- String -> IO String
readFile String
leftFp
       String
right <- String -> IO String
readFile String
rightFp
       ColorString
diff <- ColorString -> IO ColorString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ColorString -> IO ColorString) -> ColorString -> IO ColorString
forall a b. (a -> b) -> a -> b
$ String -> String -> ColorString
multiLineDiffHaskell String
left String
right
       String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ColorString -> Bool -> Text
renderColorString ColorString
diff Bool
True

-- Testcases:
--
-- < 12
-- vs.
-- > 1
-- > 2