content: module TestSuite.Tests.StdIO (testGroupStdIO) where
  
  import Control.Concurrent
  import Control.Monad
  import Data.Monoid
  import System.Exit
  import System.Random
  import Test.Tasty
  import Test.HUnit
  import qualified Data.ByteString.UTF8       as S
  import qualified Data.ByteString.Lazy       as L
  import qualified Data.ByteString.Lazy.UTF8  as L
  import qualified Data.Text                  as T
  
  import IdeSession
  import TestSuite.Assertions
  import TestSuite.Session
  import TestSuite.State
  
  testGroupStdIO :: TestSuiteEnv -> TestTree
  testGroupStdIO env = testGroup "Standard I/O" $ [
      stdTest env "Capture stdout (single putStrLn)"               test_CaptureStdout_SinglePutStrLn
    , stdTest env "Capture stdout (single putStr)"                 test_CaptureStdout_SinglePutStr
    , stdTest env "Capture stdout (single putStr with delay)"      test_CaptureStdout_SinglePutStr_Delay
    , stdTest env "Capture stdout (multiple putStrLn)"             test_CaptureStdout_MultiplePutStrLn
    , stdTest env "Capture stdout (mixed putStr and putStrLn)"     test_CaptureStdout_Mixed
    , stdTest env "Capture stdin (simple echo process)"            test_CaptureStdin_SimpleEcho
    , stdTest env "Capture stdin (infinite echo process)"          test_CaptureStdin_InfiniteEcho
    , stdTest env "Capture stderr"                                 test_Stderr
    , stdTest env "Merge stdout and stderr"                        test_Merge
    , stdTest env "Interrupt, then capture stdout"                 test_Interrupt_CaptureStdout
    , stdTest env "Snippet closes stdin; next snippet unaffected"  test_ClosesStdin
    , stdTest env "Snippet closes stdin (interrupted 'interact'); next snippet unaffected" test_ClosesStdin_Interact
    , stdTest env "Snippet closes stdout; next snippet unaffected" test_ClosesStdout
    , stdTest env "Snippet closes stderr; next snippet unaffected" test_ClosesStderr
    , stdTest env "Snippet closes stderr, using timeout buffering" test_ClosesStderr_Timeout
    , stdTest env "Make sure encoding is UTF8"                     test_UTF8
    ] ++ exeTests env [
      stdTest env "Capture stdin (interleave runStmt and runExe)"  test_Interleaved
    , stdTest env "Merge stdout and stderr (in runExe)"            test_Merge_runExe
    ]
  
  test_CaptureStdout_SinglePutStrLn :: TestSuiteEnv -> Assertion
  test_CaptureStdout_SinglePutStrLn env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "Hello World\n" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "hello :: IO ()"
              , "hello = putStrLn \"Hello World\""
              ])
  
  test_CaptureStdout_SinglePutStr :: TestSuiteEnv -> Assertion
  test_CaptureStdout_SinglePutStr env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "Hello World" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "hello :: IO ()"
              , "hello = putStr \"Hello World\""
              ])
  
  test_CaptureStdout_SinglePutStr_Delay :: TestSuiteEnv -> Assertion
  test_CaptureStdout_SinglePutStr_Delay env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "hellohi" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import Control.Concurrent (threadDelay)"
              , "import System.IO"
              , "hello :: IO ()"
              , "hello = hSetBuffering stdout LineBuffering >> putStr \"hello\" >> threadDelay 1000000 >> putStr \"hi\""
              ])
  
  test_CaptureStdout_MultiplePutStrLn :: TestSuiteEnv -> Assertion
  test_CaptureStdout_MultiplePutStrLn env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "Hello World 1\nHello World 2\nHello World 3\n" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "hello :: IO ()"
              , "hello = do putStrLn \"Hello World 1\""
              , "           putStrLn \"Hello World 2\""
              , "           putStrLn \"Hello World 3\""
              ])
  
  test_CaptureStdout_Mixed :: TestSuiteEnv -> Assertion
  test_CaptureStdout_Mixed env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "Hello World 1\nHello World 2Hello World 3\n" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "hello :: IO ()"
              , "hello = do putStrLn \"Hello World 1\""
              , "           putStr   \"Hello World 2\""
              , "           putStrLn \"Hello World 3\""
              ])
  
  test_CaptureStdin_SimpleEcho :: TestSuiteEnv -> Assertion
  test_CaptureStdin_SimpleEcho env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
  
      do runActions <- runStmt session "M" "echo"
         supplyStdin runActions "ECHO!\n"
         (output, result) <- runWaitAll runActions
         assertEqual "" RunOk result
         assertEqual "" "ECHO!\n" output
  
      ifTestingExe env $ do
         let m = "M"
             updExe = buildExe [] [(T.pack m, "M.hs")]
         updateSessionD session updExe 2
         runActionsExe <- runExe session m
         supplyStdin runActionsExe "ECHO!\n"
         (outExe, statusExe) <- runWaitAll runActionsExe
         assertEqual "Output from runExe"
                     "ECHO!\n"
                     outExe
         assertEqual "after runExe" ExitSuccess statusExe
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "echo :: IO ()"
              , "echo = getLine >>= putStrLn"
              , "main :: IO ()"
              , "main = echo"
              ])
  
  test_CaptureStdin_InfiniteEcho :: TestSuiteEnv -> Assertion
  test_CaptureStdin_InfiniteEcho env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "echo"
  
      do supplyStdin runActions "ECHO 1!\n"
         result <- runWait runActions
         assertEqual "" (Left "ECHO 1!\n") result
  
      do supplyStdin runActions "ECHO 2!\n"
         result <- runWait runActions
         assertEqual "" (Left "ECHO 2!\n") result
  
      do interrupt runActions
         resOrEx <- runWait runActions
         case resOrEx of
           Right result -> assertBool "" (isAsyncException result)
           _ -> assertFailure $ "Unexpected run result: " ++ show resOrEx
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import System.IO"
              , "import Control.Monad"
              , "echo :: IO ()"
              , "echo = do hSetBuffering stdout LineBuffering"
              , "          forever $ getLine >>= putStrLn"
              , "main :: IO ()"
              , "main = echo"
              ])
  
  test_Interleaved :: TestSuiteEnv -> Assertion
  test_Interleaved env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
  
      let m = "M"
          updExe = buildExe [] [(T.pack m, "M.hs")]
      updateSessionD session updExe 2
  
      runActions <- runStmt session "M" "echo"
      runActionsExe <- runExe session m
  
      do supplyStdin runActions "ECHO 1!\n"
         result <- runWait runActions
         assertEqual "" (Left "ECHO 1!\n") result
  
      do supplyStdin runActionsExe "ECHO 1!\n"
         result <- runWait runActionsExe
         assertEqual "" (Left "ECHO 1!\n") result
  
      do supplyStdin runActions "ECHO 2!\n"
         result <- runWait runActions
         assertEqual "" (Left "ECHO 2!\n") result
  
      do supplyStdin runActionsExe "ECHO 2!\n"
         result <- runWait runActionsExe
         assertEqual "" (Left "ECHO 2!\n") result
  
      do interrupt runActions
         resOrEx <- runWait runActions
         case resOrEx of
           Right result -> assertBool "" (isAsyncException result)
           _ -> assertFailure $ "Unexpected run result: " ++ show resOrEx
  
      do supplyStdin runActionsExe "ECHO 3!\n"
         result <- runWait runActionsExe
         assertEqual "" (Left "ECHO 3!\n") result
  
      do interrupt runActionsExe
         resOrEx <- runWait runActionsExe
         case resOrEx of
           Right result -> assertEqual "after runExe" (ExitFailure (-2)) result -- SIGINT
           _ -> assertFailure $ "Unexpected run result: " ++ show resOrEx
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import System.IO"
              , "import Control.Monad"
              , "echo :: IO ()"
              , "echo = do hSetBuffering stdout LineBuffering"
              , "          forever $ getLine >>= putStrLn"
              , "main :: IO ()"
              , "main = echo"
              ])
  
  test_Stderr :: TestSuiteEnv -> Assertion
  test_Stderr env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "Hello World\n" output
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import System.IO"
              , "hello :: IO ()"
              , "hello = hPutStrLn stderr \"Hello World\""
              ])
  
  test_Merge :: TestSuiteEnv -> Assertion
  test_Merge env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "hello"
      (output, result) <- runWaitAll runActions
      let expectedOutput = L.concat [
              "Hello World 1\n"
            , "Hello World 2\n"
            , "Hello World 3"
            , "Hello World 4"
            , "Hello World 5\n"
            , "Hello World 6\n"
            , "Hello World 7"
            , "Hello World 8"
            ]
      assertEqual "" RunOk result
      assertEqual "" expectedOutput output
    where
      upd = (updateCodeGeneration True)
         <> (updateStdoutBufferMode RunNoBuffering)
         <> (updateStderrBufferMode RunNoBuffering)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import System.IO"
              , "hello :: IO ()"
              , "hello = do hPutStrLn stderr \"Hello World 1\""
              , "           hPutStrLn stdout \"Hello World 2\""
              , "           hPutStr   stderr \"Hello World 3\""
              , "           hPutStr   stdout \"Hello World 4\""
              , "           hPutStrLn stderr \"Hello World 5\""
              , "           hPutStrLn stdout \"Hello World 6\""
              , "           hPutStr   stderr \"Hello World 7\""
              , "           hPutStr   stdout \"Hello World 8\""
              ])
  
  test_Merge_runExe :: TestSuiteEnv -> Assertion
  test_Merge_runExe env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
  
      let m = "M"
          updExe = buildExe [] [(T.pack m, "M.hs")]
      updateSessionD session updExe 2
  
      runActions <- runExe session "M"
      (output, result) <- runWaitAll runActions
      let expectedOutput = L.concat [
              "Hello World 1\n"
            , "Hello World 2\n"
            , "Hello World 3"
            , "Hello World 4"
            , "Hello World 5\n"
            , "Hello World 6\n"
            , "Hello World 7"
            , "Hello World 8"
            ]
      assertEqual "" ExitSuccess result 
      assertEqual "" expectedOutput output
    where
      -- Note that we have to set buffering here, to match the default
      -- buffering for snippets.
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "import System.IO"
              , "main :: IO ()"
              , "main  = do hSetBuffering stdout NoBuffering"
              , "           hPutStrLn stderr \"Hello World 1\""
              , "           hPutStrLn stdout \"Hello World 2\""
              , "           hPutStr   stderr \"Hello World 3\""
              , "           hPutStr   stdout \"Hello World 4\""
              , "           hPutStrLn stderr \"Hello World 5\""
              , "           hPutStrLn stdout \"Hello World 6\""
              , "           hPutStr   stderr \"Hello World 7\""
              , "           hPutStr   stdout \"Hello World 8\""
              ])
  
  test_Interrupt_CaptureStdout :: TestSuiteEnv -> Assertion
  test_Interrupt_CaptureStdout env = withAvailableSession env $ \session -> do
      updateSession session (updateCodeGeneration True) (\_ -> return ())
      let upd1 = updateSourceFile "Main.hs" . unlinesUtf8 $
                   [ "import Control.Monad"
                   , "main = forever $ print 1"
                   ]
          upd2 = updateSourceFile "Main.hs" . unlinesUtf8 $
                   [ "main = print 1234" ]
  
      do updateSessionD session upd1 1
         runActions <- runStmt session "Main" "main"
         -- TODO: Not sure why 'interrupt' doesn't work here.
         --interrupt runActions
         forceCancel runActions
         randomRIO (0, 1000000) >>= threadDelay -- Wait between 0 and 1sec
         void $ runWaitAll runActions
  
      ifTestingExe env $ do
         let m = "Main"
             updExe = buildExe [] [(T.pack m, "Main.hs")]
         updateSessionD session updExe 2
         runActionsExe <- runExe session m
         interrupt runActionsExe
         randomRIO (0, 1000000) >>= threadDelay -- Wait between 0 and 1sec
         void $ runWaitAll runActionsExe
  
      do updateSessionD session upd2 1
         runActions <- runStmt session "Main" "main"
         (output, result) <- runWaitAll runActions
         assertEqual "" RunOk result
         assertEqual "" "1234\n" output
  
      ifTestingExe env $ do
         let m = "Main"
             updExe = buildExe [] [(T.pack m, "Main.hs")]
         updateSessionD session updExe 2
         runActionsExe <- runExe session m
         (outExe, statusExe) <- runWaitAll runActionsExe
         assertEqual "Output from runExe"
                     "1234\n"
                     outExe
         assertEqual "after runExe" ExitSuccess statusExe
  
  test_ClosesStdin :: TestSuiteEnv -> Assertion
  test_ClosesStdin env = withAvailableSession env $ \session -> do
      updateSession session updates2 $ const $ return ()
      ra2 <- runStmt session "Main" "main"
      out2b <- runWait ra2
      assertEqual "" out2b (Right RunOk)
  
      updateSession session updates3 $ const $ return ()
      ra3 <- runStmt session "Main" "main"
      supplyStdin ra3 "Michael\n"
      (output, out3b) <- runWaitAll ra3
      assertEqual "" RunOk out3b
      assertEqual "" "Michael\n" output
    where
      updates2 = mconcat
          [ updateCodeGeneration True
          , updateSourceFile "Main.hs" "import System.IO\nmain = hClose stdin"
          ]
  
      updates3 =
        updateSourceFile "Main.hs" "main = getLine >>= putStrLn"
  
  test_ClosesStdin_Interact :: TestSuiteEnv -> Assertion
  test_ClosesStdin_Interact env = withAvailableSession env $ \session -> do
      updateSession session updates2 $ const $ return ()
      ra2 <- runStmt session "Main" "main"
      supplyStdin ra2 "hello\n"
      out2a <- runWait ra2
      out2a @?= Left "hello\n"
      interrupt ra2
      out2b <- runWait ra2
      case out2b of
        Right result -> assertBool "" (isAsyncException result)
        _ -> assertFailure $ "Unexpected run result: " ++ show out2b
  
      updateSession session updates3 $ const $ return ()
      ra3 <- runStmt session "Main" "main"
      out3a <- runWait ra3
      out3a @?= Left "Hi!\n"
      supplyStdin ra3 "Michael\n"
      out3b <- runWait ra3
      assertEqual "" out3b (Right RunOk)
    where
      updates2 = mconcat
          [ updateCodeGeneration True
          , updateSourceFile "Main.hs" "main = getContents >>= putStr"
          , updateStdoutBufferMode $ RunLineBuffering Nothing
          ]
  
      updates3 = mconcat
          [ updateCodeGeneration True
          , updateSourceFile "Main.hs" "main = putStrLn \"Hi!\" >> getLine >> return ()"
          , updateStdoutBufferMode $ RunLineBuffering Nothing
          ]
  
  test_ClosesStdout :: TestSuiteEnv -> Assertion
  test_ClosesStdout env = withAvailableSession env $ \session -> do
      updateSession session updates2 $ const $ return ()
      ra2 <- runStmt session "Main" "main"
      out2b <- runWait ra2
      assertEqual "" out2b (Right RunOk)
  
      updateSession session updates3 $ const $ return ()
      ra3 <- runStmt session "Main" "main"
      supplyStdin ra3 "Michael\n"
      (output, out3b) <- runWaitAll ra3
      assertEqual "" RunOk out3b
      assertEqual "" "Michael\n" output
    where
      updates2 = mconcat
          [ updateCodeGeneration True
          , updateSourceFile "Main.hs" "import System.IO\nmain = hClose stdout"
          ]
  
      updates3 =
        updateSourceFile "Main.hs" "main = getLine >>= putStrLn"
  
  test_ClosesStderr :: TestSuiteEnv -> Assertion
  test_ClosesStderr env = withAvailableSession env $ \session -> do
      updateSession session updates2 $ const $ return ()
      ra2 <- runStmt session "Main" "main"
      out2b <- runWait ra2
      assertEqual "" out2b (Right RunOk)
  
      updateSession session updates3 $ const $ return ()
      ra3 <- runStmt session "Main" "main"
      supplyStdin ra3 "Michael\n"
      (output, out3b) <- runWaitAll ra3
      assertEqual "" RunOk out3b
      assertEqual "" "Michael\n" output
    where
      updates2 = mconcat
          [ updateCodeGeneration True
          , updateSourceFile "Main.hs" "import System.IO\nmain = hClose stderr"
          ]
  
      updates3 =
        updateSourceFile "Main.hs" "import System.IO\nmain = getLine >>= hPutStrLn stderr"
  
  test_ClosesStderr_Timeout :: TestSuiteEnv -> Assertion
  test_ClosesStderr_Timeout env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      ra <- runStmt session "Main" "main"
      forM_ [1 :: Int .. 3] $ \i -> do
        result <- runWait ra
        result @?= Left (S.fromString $ show i ++ "\n")
  
      finalResult <- runWait ra
      assertEqual "" finalResult (Right RunOk)
    where
      upd = mconcat [
                updateCodeGeneration True
              , updateStdoutBufferMode $ RunLineBuffering Nothing
              , updateStderrBufferMode $ RunBlockBuffering (Just 4096) (Just 250000)
              , updateSourceFile "Main.hs" . unlinesUtf8 $ [
                    "import Control.Concurrent"
                  , "import Control.Monad"
                  , "import System.IO"
                  , "main :: IO ()"
                  , "main = do"
                  , "  hClose stderr"
                  , "  forM_ [1 :: Int .. 3] $ \\i -> do"
                  , "    print i"
                  , "    threadDelay 500000"
                  ]
              ]
  
  test_UTF8 :: TestSuiteEnv -> Assertion
  test_UTF8 env = withAvailableSession env $ \session -> do
      updateSessionD session upd 1
      assertNoErrors session
      runActions <- runStmt session "M" "main"
      (output, result) <- runWaitAll runActions
      assertEqual "" RunOk result
      assertEqual "" "你好. 怎么样?\n" (L.toString output)
  
      {- This is probably not fixable, because the code itself would need
      -- to specify IO.utf8, and we don't want to modify it.
      let m = "M"
          updExe = buildExe [] [(Text.pack m, "M.hs")]
      updateSessionD session updExe 2
      runActionsExe <- runExe session m
      (outExe, statusExe) <- runWaitAll runActionsExe
      assertEqual "Output from runExe"
                 "你好\n"
                  outExe
      assertEqual "after runExe" ExitSuccess statusExe
      -}
    where
      upd = (updateCodeGeneration True)
         <> (updateSourceFile "M.hs" . unlinesUtf8 $
              [ "module M where"
              , "main :: IO ()"
              , "main = putStrLn \"你好. 怎么样?\""
              ])
  
  unlinesUtf8 :: [String] -> L.ByteString
  unlinesUtf8 = L.fromString . unlines
  