{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
#if defined(mingw32_HOST_OS)
{-# LANGUAGE RecordWildCards #-}
#endif
module Test.Main.Internal where
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as B
import GHC.Generics (Generic)
import System.Exit (ExitCode)
data ProcessResult =
ProcessResult
{ prStdout :: !B.ByteString
, prStderr :: !B.ByteString
, prExitCode :: !ExitCode
, prException :: !(Maybe E.SomeException)
} deriving (Show, Generic)
instance Eq ProcessResult where
pr1 == pr2 =
prStdout pr1 == prStdout pr2
&& prStderr pr1 == prStderr pr2
&& prStderr pr1 == prStderr pr2
&& prExitCode pr1 == prExitCode pr2
&& fmap show (prException pr1) == fmap show (prException pr2)
normalizeNewLines :: ProcessResult -> ProcessResult
#if defined(mingw32_HOST_OS)
normalizeNewLines ProcessResult {..} =
ProcessResult (nl prStdout) (nl prStderr) prExitCode prException
where
nl = B.concat . B.split '\r'
#else
normalizeNewLines = id
#endif