    {-# 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
        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"
        xs <- pure $ filter ((==) ".test" . takeExtension) xs
        forM_ xs $ \String
    file -> do
            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)
            forM_ (zipFrom 1 ios) $ \(Integer
    i,io :: InputOutput
    io@InputOutput{String
    [String]
    [(String, String)]
    Maybe ExitCode
    name :: String
    files :: [(String, String)]
    run :: [String]
    output :: String
    exit :: Maybe ExitCode
    exit :: InputOutput -> Maybe ExitCode
    output :: InputOutput -> String
    run :: InputOutput -> [String]
    files :: InputOutput -> [(String, String)]
    name :: InputOutput -> String
    ..}) -> 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}
            liftIO $ mapM_ (removeFile . fst) $ concatMap files 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

    ---------------------------------------------------------------------
    -- 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 :: InputOutput -> Maybe ExitCode
    output :: InputOutput -> String
    run :: InputOutput -> [String]
    files :: InputOutput -> [(String, String)]
    name :: InputOutput -> String
    name :: String
    files :: [(String, String)]
    run :: [String]
    output :: String
    exit :: Maybe ExitCode
    ..} = do
        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
        got <- liftIO $ fmap (reverse . dropWhile null . reverse . map trimEnd . lines . fst) $ captureOutput $
            handle (\(SomeException
    e::SomeException) -> SomeException -> IO ()
    forall a. Show a => a -> IO ()
    print SomeException
    e) $
            handle (\(ExitCode
    e::ExitCode) -> IORef ExitCode -> ExitCode -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef ExitCode
    code ExitCode
    e) $
            bracket getVerbosity setVerbosity $ const $ setVerbosity Normal >> main run
        code <- liftIO $ readIORef code
        (want,got) <- pure $ matchStarStar (lines output) got

        if maybe False (/= code) exit then
            failed
                ["TEST FAILURE IN tests/" ++ name
                ,"WRONG EXIT CODE"
                ,"GOT : " ++ show code
                ,"WANT: " ++ show exit
                ]
         else if length got == length want && and (zipWith matchStar want got) then
            passed
         else do
            let 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 (i,g,w):_ = [(i,g,w) | (i,g,w) <- zip3 [1..] (got++trail) (want++trail), not $ matchStar w g]
            failed $
                ["TEST FAILURE IN tests/" ++ name
                ,"DIFFER ON LINE: " ++ show i
                ,"GOT : " ++ g
                ,"WANT: " ++ w
                ,"FULL OUTPUT FOR GOT:"] ++ got

    -- | First string may have stars in it (the want)
    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 -- 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 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