{-# LANGUAGE PatternGuards, ScopedTypeVariables, RecordWildCards, ViewPatterns #-}

-- | Check the input/output pairs in the tests/ directory
module Test.InputOutput(testInputOutput) where

import Control.Applicative
import Data.Tuple.Extra
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Data.List.Extra
import Data.IORef
import System.Directory
import System.FilePath
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Verbosity
import System.Exit
import System.IO.Extra
import Prelude
import Data.Version (showVersion)
import Paths_hlint (version)

import Test.Util


testInputOutput :: ([String] -> IO ()) -> Test ()
testInputOutput :: ([String] -> IO ()) -> Test ()
testInputOutput [String] -> IO ()
main = do
    [String]
xs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
"tests"
    [String]
xs <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) String
".test" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension) [String]
xs
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
xs forall a b. (a -> b) -> a -> b
$ \String
file -> do
        [InputOutput]
ios <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> [InputOutput]
parseInputOutputs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile (String
"tests" String -> String -> String
</> String
file)
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [InputOutput]
ios) forall a b. (a -> b) -> a -> b
$ \(Integer
i,io :: InputOutput
io@InputOutput{String
[String]
[(String, String)]
Maybe ExitCode
exit :: InputOutput -> Maybe ExitCode
output :: InputOutput -> String
run :: InputOutput -> [String]
files :: InputOutput -> [(String, String)]
name :: InputOutput -> String
exit :: Maybe ExitCode
output :: String
run :: [String]
files :: [(String, String)]
name :: String
..}) -> do
            Test ()
progress
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
files forall a b. (a -> b) -> a -> b
$ \(String
name,String
contents) -> do
                Bool -> String -> IO ()
createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory String
name
                String -> String -> IO ()
writeFile String
name String
contents
            ([String] -> IO ()) -> InputOutput -> Test ()
checkInputOutput [String] -> IO ()
main InputOutput
io{name :: String
name= String
"_" forall a. [a] -> [a] -> [a]
++ String -> String
takeBaseName String
file forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i}
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
removeFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InputOutput -> [(String, String)]
files [InputOutput]
ios

data InputOutput = InputOutput
    {InputOutput -> String
name :: String
    ,InputOutput -> [(String, String)]
files :: [(FilePath, String)]
    ,InputOutput -> [String]
run :: [String]
    ,InputOutput -> String
output :: String
    ,InputOutput -> Maybe ExitCode
exit :: Maybe ExitCode
    } deriving InputOutput -> InputOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputOutput -> InputOutput -> Bool
$c/= :: InputOutput -> InputOutput -> Bool
== :: InputOutput -> InputOutput -> Bool
$c== :: InputOutput -> InputOutput -> Bool
Eq

parseInputOutputs :: String -> [InputOutput]
parseInputOutputs :: String -> [InputOutput]
parseInputOutputs = InputOutput -> [String] -> [InputOutput]
f InputOutput
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
    where
        z :: InputOutput
z = String
-> [(String, String)]
-> [String]
-> String
-> Maybe ExitCode
-> InputOutput
InputOutput String
"unknown" [] [] String
"" forall a. Maybe a
Nothing
        interest :: String -> Bool
interest String
x = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
x) [String
"----",String
"FILE",String
"RUN",String
"OUTPUT",String
"EXIT"]
        outputTemplateVars :: [(String, String)]
outputTemplateVars = [ (String
"__VERSION__", Version -> String
showVersion Version
version) ]
        substituteTemplateVars :: String -> String
substituteTemplateVars = forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace) [(String, String)]
outputTemplateVars

        f :: InputOutput -> [String] -> [InputOutput]
f InputOutput
io ((forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"RUN " -> Just String
flags):[String]
xs) = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{run :: [String]
run = String -> [String]
splitArgs String
flags} [String]
xs
        f InputOutput
io ((forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"EXIT " -> Just String
code):[String]
xs) = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{exit :: Maybe ExitCode
exit = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ let i :: Int
i = forall a. Read a => String -> a
read String
code in if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then ExitCode
ExitSuccess else Int -> ExitCode
ExitFailure Int
i} [String]
xs
        f InputOutput
io ((forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"FILE " -> Just String
file):[String]
xs) | ([String]
str,[String]
xs) <- [String] -> ([String], [String])
g [String]
xs = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{files :: [(String, String)]
files = InputOutput -> [(String, String)]
files InputOutput
io forall a. [a] -> [a] -> [a]
++ [(String
file,[String] -> String
unlines [String]
str)]} [String]
xs
        f InputOutput
io (String
"OUTPUT":[String]
xs) | ([String]
str,[String]
xs) <- [String] -> ([String], [String])
g [String]
xs = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{output :: String
output = [String] -> String
unlines [String]
str} [String]
xs
        f InputOutput
io ((forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"----" -> Bool
True):[String]
xs) = [InputOutput
io | InputOutput
io forall a. Eq a => a -> a -> Bool
/= InputOutput
z] forall a. [a] -> [a] -> [a]
++ InputOutput -> [String] -> [InputOutput]
f InputOutput
z [String]
xs
        f InputOutput
io [] = [InputOutput
io | InputOutput
io forall a. Eq a => a -> a -> Bool
/= InputOutput
z]
        f InputOutput
io (String
x:[String]
xs) = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown test item, " forall a. [a] -> [a] -> [a]
++ String
x

        g :: [String] -> ([String], [String])
g = forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
substituteTemplateVars forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
interest


---------------------------------------------------------------------
-- CHECK INPUT/OUTPUT PAIRS

checkInputOutput :: ([String] -> IO ()) -> InputOutput -> Test ()
checkInputOutput :: ([String] -> IO ()) -> InputOutput -> Test ()
checkInputOutput [String] -> IO ()
main InputOutput{String
[String]
[(String, String)]
Maybe ExitCode
exit :: Maybe ExitCode
output :: String
run :: [String]
files :: [(String, String)]
name :: String
exit :: InputOutput -> Maybe ExitCode
output :: InputOutput -> String
run :: InputOutput -> [String]
files :: InputOutput -> [(String, String)]
name :: InputOutput -> String
..} = do
    IORef ExitCode
code <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef ExitCode
ExitSuccess
    [String]
got <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
trimEnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. IO a -> IO (String, a)
captureOutput forall a b. (a -> b) -> a -> b
$
        forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException
e::SomeException) -> forall a. Show a => a -> IO ()
print SomeException
e) forall a b. (a -> b) -> a -> b
$
        forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ExitCode
e::ExitCode) -> forall a. IORef a -> a -> IO ()
writeIORef IORef ExitCode
code ExitCode
e) forall a b. (a -> b) -> a -> b
$
        forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Verbosity
getVerbosity Verbosity -> IO ()
setVerbosity forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ Verbosity -> IO ()
setVerbosity Verbosity
Normal forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO ()
main [String]
run
    ExitCode
code <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef ExitCode
code
    ([String]
want,[String]
got) <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> ([String], [String])
matchStarStar (String -> [String]
lines String
output) [String]
got

    if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
/= ExitCode
code) Maybe ExitCode
exit then
        [String] -> Test ()
failed
            [String
"TEST FAILURE IN tests/" forall a. [a] -> [a] -> [a]
++ String
name
            ,String
"WRONG EXIT CODE"
            ,String
"GOT : " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ExitCode
code
            ,String
"WANT: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe ExitCode
exit
            ]
     else if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
got forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
want Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
and (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> Bool
matchStar [String]
want [String]
got) then
        Test ()
passed
     else do
        let trail :: [String]
trail = forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
got) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
want)) String
"<EOF>"
        let (Integer
i,String
g,String
w):[(Integer, String, String)]
_ = [(Integer
i,String
g,String
w) | (Integer
i,String
g,String
w) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Integer
1..] ([String]
gotforall a. [a] -> [a] -> [a]
++[String]
trail) ([String]
wantforall a. [a] -> [a] -> [a]
++[String]
trail), Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
matchStar String
w String
g]
        [String] -> Test ()
failed forall a b. (a -> b) -> a -> b
$
            [String
"TEST FAILURE IN tests/" forall a. [a] -> [a] -> [a]
++ String
name
            ,String
"DIFFER ON LINE: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i
            ,String
"GOT : " forall a. [a] -> [a] -> [a]
++ String
g
            ,String
"WANT: " forall a. [a] -> [a] -> [a]
++ String
w
            ,String
"FULL OUTPUT FOR GOT:"] forall a. [a] -> [a] -> [a]
++ [String]
got


-- | First string may have stars in it (the want)
matchStar :: String -> String -> Bool
matchStar :: String -> String -> Bool
matchStar (Char
'*':String
xs) String
ys = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
matchStar String
xs) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
tails String
ys
matchStar (Char
'/':Char
x:String
xs) (Char
'\\':Char
'\\':String
ys) | Char
x forall a. Eq a => a -> a -> Bool
/= Char
'/' = String -> String -> Bool
matchStar (Char
xforall a. a -> [a] -> [a]
:String
xs) String
ys -- JSON escaped newlines
matchStar (Char
x:String
xs) (Char
y:String
ys) = Char -> Char -> Bool
eq Char
x Char
y Bool -> Bool -> Bool
&& String -> String -> Bool
matchStar String
xs String
ys
    where
        -- allow path differences between Windows and Linux
        eq :: Char -> Char -> Bool
eq Char
'/' Char
y = Char -> Bool
isPathSeparator Char
y
        eq Char
x Char
y = Char
x forall a. Eq a => a -> a -> Bool
== Char
y
matchStar [] [] = Bool
True
matchStar String
_ String
_ = Bool
False


matchStarStar :: [String] -> [String] -> ([String], [String])
matchStarStar :: [String] -> [String] -> ([String], [String])
matchStarStar [String]
want [String]
got = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== String
"**") [String]
want of
    ([String]
_, []) -> ([String]
want, [String]
got)
    ([String]
w1,String
_:[String]
w2) -> ([String]
w1forall a. [a] -> [a] -> [a]
++[String]
w2, [String]
g1 forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
takeEnd (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
w2) [String]
g2)
        where ([String]
g1,[String]
g2) = forall a. Int -> [a] -> ([a], [a])
splitAt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
w1) [String]
got