{-# LANGUAGE PatternGuards, ScopedTypeVariables, RecordWildCards, ViewPatterns #-}
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 <- IO [String] -> Test [String]
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Test [String]) -> IO [String] -> Test [String]
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
"tests"
[String]
xs <- [String] -> Test [String]
forall a. a -> Test a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> Test [String]) -> [String] -> Test [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
".test" (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension) [String]
xs
[String] -> (String -> Test ()) -> Test ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
xs ((String -> Test ()) -> Test ()) -> (String -> Test ()) -> Test ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
[InputOutput]
ios <- IO [InputOutput] -> Test [InputOutput]
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputOutput] -> Test [InputOutput])
-> IO [InputOutput] -> Test [InputOutput]
forall a b. (a -> b) -> a -> b
$ String -> [InputOutput]
parseInputOutputs (String -> [InputOutput]) -> IO String -> IO [InputOutput]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
readFile (String
"tests" String -> String -> String
</> String
file)
[(Integer, InputOutput)]
-> ((Integer, InputOutput) -> Test ()) -> Test ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Integer -> [InputOutput] -> [(Integer, InputOutput)]
forall a b. Enum a => a -> [b] -> [(a, b)]
zipFrom Integer
1 [InputOutput]
ios) (((Integer, InputOutput) -> Test ()) -> Test ())
-> ((Integer, InputOutput) -> Test ()) -> Test ()
forall a b. (a -> b) -> a -> b
$ \(Integer
i,io :: InputOutput
io@InputOutput{String
[String]
[(String, String)]
Maybe ExitCode
name :: String
files :: [(String, String)]
run :: [String]
output :: String
exit :: Maybe ExitCode
name :: InputOutput -> String
files :: InputOutput -> [(String, String)]
run :: InputOutput -> [String]
output :: InputOutput -> String
exit :: InputOutput -> Maybe ExitCode
..}) -> do
Test ()
progress
IO () -> Test ()
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Test ()) -> IO () -> Test ()
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> ((String, String) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
files (((String, String) -> IO ()) -> IO ())
-> ((String, String) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name,String
contents) -> do
Bool -> String -> IO ()
createDirectoryIfMissing Bool
True (String -> IO ()) -> String -> IO ()
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= "_" ++ takeBaseName file ++ "_" ++ show i}
IO () -> Test ()
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Test ()) -> IO () -> Test ()
forall a b. (a -> b) -> a -> b
$ ((String, String) -> IO ()) -> [(String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
removeFile (String -> IO ())
-> ((String, String) -> String) -> (String, String) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
forall a b. (a, b) -> a
fst) ([(String, String)] -> IO ()) -> [(String, String)] -> IO ()
forall a b. (a -> b) -> a -> b
$ (InputOutput -> [(String, String)])
-> [InputOutput] -> [(String, String)]
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
(InputOutput -> InputOutput -> Bool)
-> (InputOutput -> InputOutput -> Bool) -> Eq InputOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputOutput -> InputOutput -> Bool
== :: InputOutput -> InputOutput -> Bool
$c/= :: InputOutput -> InputOutput -> Bool
/= :: InputOutput -> InputOutput -> Bool
Eq
parseInputOutputs :: String -> [InputOutput]
parseInputOutputs :: String -> [InputOutput]
parseInputOutputs = InputOutput -> [String] -> [InputOutput]
f InputOutput
z ([String] -> [InputOutput])
-> (String -> [String]) -> String -> [InputOutput]
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
"" Maybe ExitCode
forall a. Maybe a
Nothing
interest :: String -> Bool
interest String
x = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
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 = ((String, String) -> String -> String)
-> [(String, String)] -> String -> String
forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ((String -> String -> String -> String)
-> (String, String) -> String -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> String -> String
forall a. Eq a => [a] -> [a] -> [a] -> [a]
replace) [(String, String)]
outputTemplateVars
f :: InputOutput -> [String] -> [InputOutput]
f InputOutput
io ((String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"RUN " -> Just String
flags):[String]
xs) = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{run = splitArgs flags} [String]
xs
f InputOutput
io ((String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"EXIT " -> Just String
code):[String]
xs) = InputOutput -> [String] -> [InputOutput]
f InputOutput
io{exit = Just $ let i = String -> Int
forall a. Read a => String -> a
read String
code in if i == 0 then ExitSuccess else ExitFailure i} [String]
xs
f InputOutput
io ((String -> String -> Maybe String
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 = files io ++ [(file,unlines 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 = unlines str} [String]
xs
f InputOutput
io ((String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"----" -> Bool
True):[String]
xs) = [InputOutput
io | InputOutput
io InputOutput -> InputOutput -> Bool
forall a. Eq a => a -> a -> Bool
/= InputOutput
z] [InputOutput] -> [InputOutput] -> [InputOutput]
forall a. [a] -> [a] -> [a]
++ InputOutput -> [String] -> [InputOutput]
f InputOutput
z [String]
xs
f InputOutput
io [] = [InputOutput
io | InputOutput
io InputOutput -> InputOutput -> Bool
forall a. Eq a => a -> a -> Bool
/= InputOutput
z]
f InputOutput
io (String
x:[String]
xs) = String -> [InputOutput]
forall a. HasCallStack => String -> a
error (String -> [InputOutput]) -> String -> [InputOutput]
forall a b. (a -> b) -> a -> b
$ String
"Unknown test item, " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x
g :: [String] -> ([String], [String])
g = ([String] -> [String])
-> ([String], [String]) -> ([String], [String])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
substituteTemplateVars ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse) (([String], [String]) -> ([String], [String]))
-> ([String] -> ([String], [String]))
-> [String]
-> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
interest
checkInputOutput :: ([String] -> IO ()) -> InputOutput -> Test ()
checkInputOutput :: ([String] -> IO ()) -> InputOutput -> Test ()
checkInputOutput [String] -> IO ()
main InputOutput{String
[String]
[(String, String)]
Maybe ExitCode
name :: InputOutput -> String
files :: InputOutput -> [(String, String)]
run :: InputOutput -> [String]
output :: InputOutput -> String
exit :: InputOutput -> Maybe ExitCode
name :: String
files :: [(String, String)]
run :: [String]
output :: String
exit :: Maybe ExitCode
..} = do
IORef ExitCode
code <- IO (IORef ExitCode) -> Test (IORef ExitCode)
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef ExitCode) -> Test (IORef ExitCode))
-> IO (IORef ExitCode) -> Test (IORef ExitCode)
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO (IORef ExitCode)
forall a. a -> IO (IORef a)
newIORef ExitCode
ExitSuccess
[String]
got <- IO [String] -> Test [String]
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [String] -> Test [String]) -> IO [String] -> Test [String]
forall a b. (a -> b) -> a -> b
$ ((String, ()) -> [String]) -> IO (String, ()) -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ((String, ()) -> [String]) -> (String, ()) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> [String])
-> ((String, ()) -> [String]) -> (String, ()) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String])
-> ((String, ()) -> [String]) -> (String, ()) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
trimEnd ([String] -> [String])
-> ((String, ()) -> [String]) -> (String, ()) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> ((String, ()) -> String) -> (String, ()) -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ()) -> String
forall a b. (a, b) -> a
fst) (IO (String, ()) -> IO [String]) -> IO (String, ()) -> IO [String]
forall a b. (a -> b) -> a -> b
$ IO () -> IO (String, ())
forall a. IO a -> IO (String, a)
captureOutput (IO () -> IO (String, ())) -> IO () -> IO (String, ())
forall a b. (a -> b) -> a -> b
$
(SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException
e::SomeException) -> SomeException -> IO ()
forall a. Show a => a -> IO ()
print SomeException
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
(ExitCode -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(ExitCode
e::ExitCode) -> IORef ExitCode -> ExitCode -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef ExitCode
code ExitCode
e) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO Verbosity
-> (Verbosity -> IO ()) -> (Verbosity -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Verbosity
getVerbosity Verbosity -> IO ()
setVerbosity ((Verbosity -> IO ()) -> IO ()) -> (Verbosity -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> Verbosity -> IO ()
forall a b. a -> b -> a
const (IO () -> Verbosity -> IO ()) -> IO () -> Verbosity -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> IO ()
setVerbosity Verbosity
Normal IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO ()
main [String]
run
ExitCode
code <- IO ExitCode -> Test ExitCode
forall a. IO a -> Test a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ExitCode -> Test ExitCode) -> IO ExitCode -> Test ExitCode
forall a b. (a -> b) -> a -> b
$ IORef ExitCode -> IO ExitCode
forall a. IORef a -> IO a
readIORef IORef ExitCode
code
([String]
want,[String]
got) <- ([String], [String]) -> Test ([String], [String])
forall a. a -> Test a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([String], [String]) -> Test ([String], [String]))
-> ([String], [String]) -> Test ([String], [String])
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> ([String], [String])
matchStarStar (String -> [String]
lines String
output) [String]
got
if Bool -> (ExitCode -> Bool) -> Maybe ExitCode -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
code) Maybe ExitCode
exit then
[String] -> Test ()
failed
[String
"TEST FAILURE IN tests/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
,String
"WRONG EXIT CODE"
,String
"GOT : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ExitCode -> String
forall a. Show a => a -> String
show ExitCode
code
,String
"WANT: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Maybe ExitCode -> String
forall a. Show a => a -> String
show Maybe ExitCode
exit
]
else if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
got Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
want Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((String -> String -> Bool) -> [String] -> [String] -> [Bool]
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 = Int -> String -> [String]
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
got) ([String] -> Int
forall a. [a] -> Int
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) <- [Integer] -> [String] -> [String] -> [(Integer, String, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Integer
1..] ([String]
got[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
trail) ([String]
want[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
trail), Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> String -> Bool
matchStar String
w String
g]
[String] -> Test ()
failed ([String] -> Test ()) -> [String] -> Test ()
forall a b. (a -> b) -> a -> b
$
[String
"TEST FAILURE IN tests/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name
,String
"DIFFER ON LINE: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i
,String
"GOT : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
g
,String
"WANT: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
w
,String
"FULL OUTPUT FOR GOT:"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
got
matchStar :: String -> String -> Bool
matchStar :: String -> String -> Bool
matchStar (Char
'*':String
xs) String
ys = (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
matchStar String
xs) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ String -> [String]
forall a. [a] -> [[a]]
tails String
ys
matchStar (Char
'/':Char
x:String
xs) (Char
'\\':Char
'\\':String
ys) | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' = String -> String -> Bool
matchStar (Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:String
xs) String
ys
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
eq :: Char -> Char -> Bool
eq Char
'/' Char
y = Char -> Bool
isPathSeparator Char
y
eq Char
x Char
y = Char
x Char -> Char -> Bool
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 (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"**") [String]
want of
([String]
_, []) -> ([String]
want, [String]
got)
([String]
w1,String
_:[String]
w2) -> ([String]
w1[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String]
w2, [String]
g1 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
takeEnd ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
w2) [String]
g2)
where ([String]
g1,[String]
g2) = 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]
w1) [String]
got