content: {-# 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 main = do
      xs <- liftIO $ getDirectoryContents "tests"
      xs <- pure $ filter ((==) ".test" . takeExtension) xs
      forM_ xs $ \file -> do
          ios <- liftIO $ parseInputOutputs <$> readFile ("tests" </> file)
          forM_ (zipFrom 1 ios) $ \(i,io@InputOutput{..}) -> do
              progress
              liftIO $ forM_ files $ \(name,contents) -> do
                  createDirectoryIfMissing True $ takeDirectory name
                  writeFile name contents
              checkInputOutput main io{name= "_" ++ takeBaseName file ++ "_" ++ show i}
          liftIO $ mapM_ (removeFile . fst) $ concatMap files ios
  
  data InputOutput = InputOutput
      {name :: String
      ,files :: [(FilePath, String)]
      ,run :: [String]
      ,output :: String
      ,exit :: Maybe ExitCode
      } deriving Eq
  
  parseInputOutputs :: String -> [InputOutput]
  parseInputOutputs = f z . lines
      where
          z = InputOutput "unknown" [] [] "" Nothing
          interest x = any (`isPrefixOf` x) ["----","FILE","RUN","OUTPUT","EXIT"]
          outputTemplateVars = [ ("__VERSION__", showVersion version) ]
          substituteTemplateVars = mconcatMap (uncurry replace) outputTemplateVars
  
          f io ((stripPrefix "RUN " -> Just flags):xs) = f io{run = splitArgs flags} xs
          f io ((stripPrefix "EXIT " -> Just code):xs) = f io{exit = Just $ let i = read code in if i == 0 then ExitSuccess else ExitFailure i} xs
          f io ((stripPrefix "FILE " -> Just file):xs) | (str,xs) <- g xs = f io{files = files io ++ [(file,unlines str)]} xs
          f io ("OUTPUT":xs) | (str,xs) <- g xs = f io{output = unlines str} xs
          f io ((isPrefixOf "----" -> True):xs) = [io | io /= z] ++ f z xs
          f io [] = [io | io /= z]
          f io (x:xs) = error $ "Unknown test item, " ++ x
  
          g = first (fmap substituteTemplateVars . reverse . dropWhile null . reverse) . break interest
  
  
  ---------------------------------------------------------------------
  -- CHECK INPUT/OUTPUT PAIRS
  
  checkInputOutput :: ([String] -> IO ()) -> InputOutput -> Test ()
  checkInputOutput main InputOutput{..} = do
      code <- liftIO $ newIORef ExitSuccess
      got <- liftIO $ fmap (reverse . dropWhile null . reverse . map trimEnd . lines . fst) $ captureOutput $
          handle (\(e::SomeException) -> print e) $
          handle (\(e::ExitCode) -> writeIORef code 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 = replicate (max (length got) (length want)) "<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 ('*':xs) ys = any (matchStar xs) $ tails ys
  matchStar ('/':x:xs) ('\\':'\\':ys) | x /= '/' = matchStar (x:xs) ys -- JSON escaped newlines
  matchStar (x:xs) (y:ys) = eq x y && matchStar xs ys
      where
          -- allow path differences between Windows and Linux
          eq '/' y = isPathSeparator y
          eq x y = x == y
  matchStar [] [] = True
  matchStar _ _ = False
  
  
  matchStarStar :: [String] -> [String] -> ([String], [String])
  matchStarStar want got = case break (== "**") want of
      (_, []) -> (want, got)
      (w1,_:w2) -> (w1++w2, g1 ++ takeEnd (length w2) g2)
          where (g1,g2) = splitAt (length w1) got
  