main-tester (empty) → 0.1.0.0

raw patch · 9 files changed

+319/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed

Dependencies added: QuickCheck, base, bytestring, directory, doctest, hspec, hspec-core, main-tester, text

Files

• ChangeLog.md +3/−0
• LICENSE +13/−0
• README.md +22/−0
• Setup.hs +2/−0
• main-tester.cabal +53/−0
• src/Test/Main.hs +135/−0
• src/Test/Main/Internal.hs +35/−0
• test/Spec.hs +50/−0
• test/doctest.hs +6/−0

@@ -0,0 +1,3 @@+# 0.1.0.0++- Initial release.

@@ -0,0 +1,13 @@+Copyright Yuji Yamamoto (c) 2018++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++    http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.

@@ -0,0 +1,22 @@+# main-tester++Capture stdout/stderr/exit code, and replace stdin of your main function.++## Why?++Against the best practice, I often prefer large, end-to-end (E2E) tests.  +Because:++- E2E tests can directly test your users' requirement.+- E2E tests can detect bugs caused by misassumption of external components+    - Which happenes relatively more often than the others, according to my experience.+- I often write small programs where E2E tests are sufficient.++This library main-tester provides utility functions for E2E testing of your CLI applications.  +With main-tester, You can test your apps with arbitrary stdin data, check their output and exit code.++## Comparison with [silently](https://hackage.haskell.org/package/silently) and [System.IO.Fake](https://hackage.haskell.org/package/imperative-edsl-0.7.1/docs/System-IO-Fake.html)++- Can test exit code of your main.+- All input and outputs are strict bytestrings except the command line arguments, which is very important when testing with non-UTF8 input and output.+- Currently doesn't support suppressing stdout and stderr (Pull request welcome!).

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,53 @@+name:                main-tester+version:             0.1.0.0+synopsis:            Capture stdout/stderr/exit code, and replace stdin of your main function.+description:         See README.md for detail.+homepage:            https://gitlab.com/igrep/main-tester#readme+license:             Apache-2.0+license-file:        LICENSE+author:              Yuji Yamamoto+maintainer:          whosekiteneverfly@gmail.com+copyright:           2018 Yuji Yamamoto+category:            System, Testing+build-type:          Simple+extra-source-files:  README.md+                   , ChangeLog.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Test.Main+                     , Test.Main.Internal+  build-depends:       base >= 4.7 && < 5+                     , bytestring+                     , directory+  default-language:    Haskell2010++test-suite main-tester-doctest+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             doctest.hs+  build-depends:       base+                     , doctest+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings++test-suite main-tester-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , main-tester+                     , bytestring+                     , hspec+                     , hspec-core+                     , QuickCheck+                     , text+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010+  default-extensions:  OverloadedStrings++source-repository head+  type:     git+  location: https://gitlab.com/igrep/main-tester

@@ -0,0 +1,135 @@+{-# LANGUAGE RecordWildCards #-}++module Test.Main+  ( -- * Utilities for testing your main function+    captureProcessResult+  , ProcessResult(..)+  , withStdin++  -- ** Re-export from System.Environment+  , withArgs++  -- ** Re-export from System.Exit+  , ExitCode(..)+  ) where+++import qualified Control.Exception as E+import qualified Data.ByteString as B+import           GHC.IO.Handle (hDuplicate, hDuplicateTo)+import           System.Directory (removeFile, getTemporaryDirectory)+import           System.Environment (withArgs)+import           System.Exit (ExitCode(ExitSuccess))+import           System.IO+                   ( Handle+                   , SeekMode(AbsoluteSeek)+                   , stdin+                   , stderr+                   , stdout+                   , hClose+                   , hFlush+                   , hSetBinaryMode+                   , hGetBuffering+                   , hSetBuffering+                   , hGetEncoding+                   , hSetEncoding+                   , hSeek+                   , openBinaryTempFile+                   , withBinaryFile+                   , IOMode(ReadMode)+                   )++import           Test.Main.Internal (ProcessResult(..))+++-- |+-- Capture stdout, stderr, and exit code of the given IO action.+--+-- >>> let main = putStr "hello"+-- >>> captureProcessResult main+-- ProcessResult {prStdout = "hello", prStderr = "", prExitCode = ExitSuccess}+--+-- If the IO action exit with error message, the exit code of result is 'ExitFailure'.+--+-- >>> import System.IO+-- >>> import System.Exit+-- >>> let main = hPutStr stderr "OMG!" >> exitWith (ExitFailure 1)+-- >>> captureProcessResult main+-- ProcessResult {prStdout = "", prStderr = "OMG!", prExitCode = ExitFailure 1}+captureProcessResult :: IO () -> IO ProcessResult+captureProcessResult action = do+  tDir <- getTemporaryDirectory+  withBinaryTmpFile tDir "test-stdout" $ \(_oPath, oHd) ->+    withBinaryTmpFile tDir "test-stderr" $ \(_ePath, eHd) ->+      redirectingHandle stdout oHd $+        redirectingHandle stderr eHd $ do+          prExitCode <-+            either id (const ExitSuccess) <$> E.try action+          prStdout <- readFromHead oHd stdout+          prStderr <- readFromHead eHd stderr+          return ProcessResult {..}++  where+    readFromHead tmpH stdH = do+      hFlush stdH+      hSeek tmpH AbsoluteSeek 0+      B.hGetContents tmpH+++withBinaryTmpFile :: FilePath -> String -> ((FilePath, Handle) -> IO a) -> IO a+withBinaryTmpFile parent name =+  E.bracket+    (openBinaryTempFile parent name)+    (\(path, hd) -> do+      hClose hd+      removeFile path `E.catch` doNothing+    )++  where+    doNothing :: IOError-> IO ()+    doNothing _ = return ()+++redirectingHandle :: Handle -> Handle -> IO r -> IO r+redirectingHandle from to action = do+  saveEnc <- hGetEncoding from+  saveBuf <- hGetBuffering from+  let redirect = do+        save <- hDuplicate from+        hDuplicateTo to from+        setEnc to+        return save+      restore save = do+        hDuplicateTo save from+        setEnc from+        hSetBuffering from saveBuf++      setEnc h =+        maybe (hSetBinaryMode h True) (hSetEncoding h) saveEnc+  E.bracket redirect restore (const action)+++-- |+-- Pass the ByteString to stdin of the given IO action.+--+-- >>> import Data.ByteString.Char8 ()+-- >>> :set -XOverloadedStrings+-- >>> let main = putStrLn . reverse =<< getLine+-- >>> withStdin "abcde" main+-- edcba+withStdin :: B.ByteString -> IO a -> IO a+withStdin bs action =+  E.bracket+    prepareInputFile+    removeFile+    (\inPath ->+      withBinaryFile inPath ReadMode $ \tmpHd ->+        redirectingHandle stdin tmpHd action+    )+  where+    prepareInputFile = do+      tDir <- getTemporaryDirectory+      E.bracket+        (openBinaryTempFile tDir "test-stdin")+        (\(_path, hd) -> hClose hd)+        (\(path, hd) -> B.hPut hd bs >> return path)

@@ -0,0 +1,35 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+#if defined(mingw32_HOST_OS)+{-# LANGUAGE RecordWildCards #-}+#endif++module Test.Main.Internal where+++import qualified Data.ByteString.Char8 as B+import           GHC.Generics (Generic)+import           System.Exit (ExitCode)++++-- | Used for the result of 'Test.Main.captureProcessResult'.+data ProcessResult =+  ProcessResult+    { prStdout :: !B.ByteString+    , prStderr :: !B.ByteString+    , prExitCode :: !ExitCode+    } deriving (Eq, Show, Generic)+++-- | Use to avoid errors in related to new line code in tests.+--   Currently I use this function only for this module's test.+normalizeNewLines :: ProcessResult -> ProcessResult+#if defined(mingw32_HOST_OS)+normalizeNewLines ProcessResult {..} =+  ProcessResult (nl prStdout) (nl prStderr) (prExitCode)+  where+    nl = B.concat . B.split '\r'+#else+normalizeNewLines = id+#endif

@@ -0,0 +1,50 @@+import           Control.Monad (mapM_)+import           Data.ByteString.Char8 (pack)+import           System.Environment (getArgs)+import           System.Exit (ExitCode(ExitSuccess, ExitFailure) , exitWith)+import           System.IO (stderr, hPutStr)+import           Test.Hspec+import           Test.Hspec.QuickCheck+import           Test.QuickCheck+                   ( Arbitrary+                   , arbitrary+                   , choose+                   , oneof+                   , listOf+                   )++import           Test.Main+import           Test.Main.Internal+++newtype AExitCode = AExitCode ExitCode deriving Show++instance Arbitrary AExitCode where+  arbitrary =+    AExitCode <$> oneof [pure ExitSuccess, ExitFailure <$> choose (1, maxBound)]+++newtype PrintableAsciiString =+  PrintableAsciiString { getPrintableAsciiString :: String } deriving Show++-- https://en.wikipedia.org/wiki/ASCII#Character_set+instance Arbitrary PrintableAsciiString where+  arbitrary = PrintableAsciiString <$> listOf (choose (' ', '~'))+++main :: IO ()+main = hspec $+  describe "Test.Main" $+    prop "passes stdin and arguments to the program, and capture stdin data, stderr data, and exitCode" $+      \(argsA, inDataA, AExitCode eCode) -> do+        let args = map getPrintableAsciiString argsA+            inData = pack $ getPrintableAsciiString inDataA+            testedMain = do+              mapM_ putStrLn =<< getArgs+              hPutStr stderr =<< getContents+              exitWith eCode++        actual <- withStdin inData $ withArgs args $ captureProcessResult testedMain++        normalizeNewLines actual `shouldBe`+          normalizeNewLines (ProcessResult (pack $ unlines args) inData eCode)

@@ -0,0 +1,6 @@+module Main where++import Test.DocTest++main :: IO ()+main = doctest ["src/Test/Main.hs"]