content: {-# LANGUAGE Rank2Types, ScopedTypeVariables #-}
  
  module Test.Command(main) where
  
  import Development.Shake
  import Development.Shake.FilePath
  import Control.Exception.Extra
  import System.Time.Extra
  import General.Extra
  import Control.Monad.Extra
  import System.Directory
  import Test.Type
  import System.Exit
  import System.Process
  import Data.Tuple.Extra
  import Data.List.Extra
  import Control.Monad.IO.Class
  import System.Info.Extra
  import qualified Data.ByteString.Char8 as BS
  import qualified Data.ByteString.Lazy.Char8 as LBS
  
  
  main = testBuild test $ do
      -- shake_helper must be in a subdirectory so we can test placing that subdir on the $PATH
      let helper = toNative $ "helper/shake_helper" <.> exe
      let name !> test = do want [name]
                            name ~> do need ["helper/shake_helper" <.> exe]; test
  
      let helper_source = unlines
              ["import System.Process"
              ,"import Control.Monad"
              ,"import Control.Concurrent"
              ,"import System.Directory"
              ,"import System.Environment"
              ,"import System.Exit"
              ,"import System.IO"
              ,"import qualified Data.ByteString.Lazy.Char8 as LBS"
              ,"main = do"
              ,"    args <- getArgs"
              ,"    exe <- getExecutablePath"
              ,"    forM_ args $ \\(a:rg) -> do"
              ,"        case a of"
              ,"            'o' -> putStrLn rg"
              ,"            'e' -> hPutStrLn stderr rg"
              ,"            'x' -> exitFailure"
              ,"            'c' -> putStrLn =<< getCurrentDirectory"
              ,"            'v' -> putStrLn =<< getEnv rg"
              ,"            'w' -> threadDelay $ ceiling $ (read rg :: Double) * 1000000"
              ,"            'r' -> LBS.putStr $ LBS.replicate (read rg) 'x'"
              ,"            'i' -> putStr =<< getContents"
              ,"            's' -> void $ readProcess exe [rg] \"\""
              ,"        hFlush stdout"
              ,"        hFlush stderr"
              ]
  
      "shake_helper.hs" %> \out -> do
          need ["../../src/Test/Command.hs"]
          writeFileChanged out helper_source
      ["helper/shake_helper" <.> exe, "shake_helper.o", "shake_helper.hi"] &%> \_ -> do
          need ["shake_helper.hs"]
          cmd "ghc --make" "shake_helper.hs -o helper/shake_helper"
  
      "capture" !> do
          (Stderr err, Stdout out) <- cmd helper ["ostuff goes here","eother stuff here"]
          liftIO $ out === "stuff goes here\n"
          liftIO $ err === "other stuff here\n"
          liftIO $ waits $ \w -> do
              Stdouterr out <- cmd helper Shell ["o1",w,"e2",w,"o3"]
              out === "1\n2\n3\n"
  
      "failure" !> do
          (Exit e, Stdout (), Stderr ()) <- cmd helper "oo ee x"
          when (e == ExitSuccess) $ error "/= ExitSuccess"
          liftIO $ assertException ["BAD"] $ cmd_ helper "oo eBAD x" (EchoStdout False) (EchoStderr False)
          liftIO $ assertException ["MORE"] $ cmd_ helper "oMORE eBAD x" (WithStdout True) (WithStderr False) (EchoStdout False) (EchoStderr False)
  
      "throws" ~>
          cmd Shell "not_a_process foo"
  
      "cwd" !> do
          -- FIXME: Linux searches the Cwd argument for the file, Windows searches getCurrentDirectory
          helper <- liftIO $ canonicalizePath $ "helper/shake_helper" <.> exe
          liftIO $ createDirectoryRecursive "helper/tests"
          Stdout out <- cmd (Cwd "helper/tests") (Cwd "..") helper "c"
          let norm = fmap dropTrailingPathSeparator . canonicalizePath . trim
          liftIO $ join $ liftM2 (===) (norm out) (norm "helper")
  
      let checkTimeout act = do
              offset <- liftIO offsetTime
              act
              t <- liftIO offset
              putInfo $ "Timed out in " ++ showDuration t
              when (t < 2 || t > 8) $ error $ "failed to timeout, took " ++ show t
  
      "timeout1" !> checkTimeout (do
          Exit exit <- cmd (Timeout 2) helper "w20"
          liftIO $ assertBool (exit /= ExitSuccess) "exit was ExitSuccess")
  
      "timeout2" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "w20"
  
      -- disabled on Windows because when you abort a Shell process you get a
      -- "Do you want to terminate the batch file (Y/N)"
      unless isWindows $ "timeout3" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ Shell helper "w20"
  
      "timeout4" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "sw20"
  
      "timeout5" !> do checkTimeout $ liftIO $ timeout 2 $ cmd_ helper "i w20"
  
      "env" !> do
          -- use liftIO since it blows away PATH which makes lint-tracker stop working
          Stdout out <- liftIO $ cmd (Env [("FOO","HELLO SHAKE")]) Shell helper "vFOO"
          liftIO $ out === "HELLO SHAKE\n"
          StdoutTrim out <- cmd (AddEnv "FOO" "GOODBYE SHAKE") Shell helper "vFOO"
          liftIO $ out === "GOODBYE SHAKE"
  
      "space" !> do
          Stdout out <- cmd helper ["oSPACE 1"]
          liftIO $ out === "SPACE 1\n"
          Stdout out <- cmd Shell helper "\"oSPACE 2\""
          liftIO $ out === "SPACE 2\n"
          whenM (liftIO hasTracker) $ do
              Stdout out <- cmd Shell AutoDeps helper "\"oSPACE 2\""
              liftIO $ out === "SPACE 2\n"
          (Stdout (), CmdLine x) <- cmd helper ["oSPACE 3","oDIRECT"]
          unless (" \"oSPACE 3\" oDIRECT" `isSuffixOf` replace "\'" "\"" x) $
              fail $ "Invalid CmdLine, " ++ x
  
      "path" !> do
          let path = AddPath [dropTrailingPathSeparator "helper"] []
          cmd_ "helper/shake_helper"
          cmd_ $ "helper/shake_helper" <.> exe
          cmd_ path Shell "shake_helper"
          cmd_ path "shake_helper"
  
      "file" !> do
          let file = "file.txt"
          cmd_ helper (FileStdout file) (FileStderr file) (EchoStdout False) (EchoStderr False) (WithStderr False) "ofoo ebar obaz"
          liftIO $ assertContents file "foo\nbar\nbaz\n"
          liftIO $ waits $ \w -> do
              Stderr err <- cmd helper (FileStdout file) (FileStderr file) ["ofoo",w,"ebar",w,"obaz"]
              err === "bar\n"
              assertContents file "foo\nbar\nbaz\n"
  
      "timer" !> do
          timer $ cmd helper
  
      "binary" !> do
          (Stdout str, Stdout bs) <- cmd BinaryPipes helper "ofoo"
          liftIO $ (===) (str, bs) $ second BS.pack $ dupe $ if isWindows then "foo\r\n" else "foo\n"
          (Stdout str, Stdout bs) <- cmd helper "ofoo"
          liftIO $ (str, bs) === ("foo\n", BS.pack $ if isWindows then "foo\r\n" else "foo\n")
          pure ()
  
      "large" !> do
          (Stdout (_ :: String), CmdTime t1) <- cmd helper "r10000000"
          (Stdout (_ :: LBS.ByteString), CmdTime t2) <- cmd helper "r10000000"
          t3 <- withTempFile $ \file -> fromCmdTime <$> cmd helper "r10000000" (FileStdout file)
          liftIO $ putStrLn $ "Capturing 10Mb takes: " ++ intercalate ","
              [s ++ " = " ++ showDuration d | (s,d) <- [("String",t1),("ByteString",t2),("File",t3)]]
  
      "stdin" !> do
          withTempFile $ \file -> do
              liftIO $ writeFile file " "
              Stdout (x :: String) <- cmd helper "i" (Stdin "hello") (FileStdin file) (StdinBS $ LBS.pack "world")
              liftIO $ x === "hello world"
  
      "async" !> do
          let file = "async.txt"
          pid <- cmd helper (FileStdout file) "w2" "ohello"
          Nothing <- liftIO $ getProcessExitCode pid
          ExitSuccess <- liftIO $ waitForProcess pid
          liftIO $ assertContents file "hello\n"
  
  
  test build = do
      -- reduce the overhead by running all the tests in parallel
      -- lint can make a big different to the command lines, so test with and without
      whenM hasTracker $
          build ["-j4","--no-lint"]
      build ["-j4"]
  
      assertException ["not_a_process foo"] (build ["throws","--quiet"])
  
  
  timer :: (CmdResult r, MonadIO m) => (forall r . CmdResult r => m r) -> m r
  timer act = do
      (CmdTime t, CmdLine x, r) <- act
      liftIO $ putStrLn $ "Command " ++ x ++ " took " ++ show t ++ " seconds"
      pure r
  
  waits :: (String -> IO ()) -> IO ()
  waits op = f 0
      where f w | w > 1 = op "w10"
                | otherwise = catch_ (op $ "w" ++ show w) $ const $ f $ w + 0.1
  