Option to write test results to a file as JSON

app/Main.hs

@@ -9,6 +9,7 @@ import qualified Codec.Compression.GZip        as GZ
 import           Control.Monad
 import           Data.Aeson
 import qualified Data.ByteString.Lazy          as B
+import           Data.Foldable
 import           Data.List
 import qualified Data.List.NonEmpty            as NE
 import           Data.Maybe
@@ -33,18 +34,25 @@ data CurlRunnings = CurlRunnings
   { file           :: FilePath
   , grep           :: Maybe T.Text
   , upgrade        :: Bool
+  , json_output    :: Maybe FilePath
   , skip_tls_check :: Bool
   } deriving (Show, Data, Typeable, Eq)
 
 -- | cmdargs object
 argParser :: CurlRunnings
 argParser =
   CurlRunnings
-  { file = def &= typFile &= help "File to run"
-  , grep = def &= help "Regex to filter test cases by name"
-  , upgrade = def &= help "Pull the latest version of curl runnings"
-  , skip_tls_check = def &= help "Don't perform a TLS check (USE WITH CAUTION. Only use this if you signed your own certs)"
-  } &=
+    { file = def &= typFile &= help "File to run"
+    , grep = def &= help "Regex to filter test cases by name"
+    , upgrade = def &= help "Pull the latest version of curl runnings"
+    , json_output =
+        def &= typFile &=
+        help "Write test results to a json file specified by path"
+    , skip_tls_check =
+        def &=
+        help
+          "Don't perform a TLS check (USE WITH CAUTION. Only use this if you signed your own certs)"
+    } &=
   summary ("curl-runnings " ++ showVersion version) &=
   program "curl-runnings" &=
   verbosity &=
@@ -74,17 +82,26 @@ instance FromJSON GithubReleasesResponse
 setGithubReqHeaders :: Request -> Request
 setGithubReqHeaders = setRequestHeaders [("User-Agent", "aviaviavi")]
 
-runFile :: FilePath -> Verbosity -> Maybe T.Text -> TLSCheckType -> IO ()
-runFile "" _ _ _ =
+runFile ::
+     FilePath
+  -> Verbosity
+  -> Maybe T.Text
+  -> TLSCheckType
+  -> Maybe FilePath
+  -> IO ()
+runFile "" _ _ _ _ =
   putStrLn
     "Please specify an input file with the --file (-f) flag or use --help for more information"
-runFile path verbosityLevel regexp tlsType = do
+runFile path verbosityLevel regexp tlsType maybeOutputFile = do
   home <- getEnv "HOME"
   suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path)
   case suite of
     Right s -> do
       results <-
-        runSuite (s {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) $ tlsType
+        runSuite (s {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) tlsType
+      for_ maybeOutputFile $ \outputFile -> do
+        let jsonSummary = encode results
+        B.writeFile (outputFile) jsonSummary
       if any isFailing results
         then putStrLn (T.unpack $ makeRed "Some tests failed") >>
              exitWith (ExitFailure 1)
@@ -190,7 +207,15 @@ main :: IO ()
 main = do
   userArgs <- cmdArgs argParser
   verbosityLevel <- getVerbosity
-  let tlsCheckType = if skip_tls_check userArgs then SkipTLSCheck else DoTLSCheck
+  let tlsCheckType =
+        if skip_tls_check userArgs
+          then SkipTLSCheck
+          else DoTLSCheck
   if upgrade userArgs
     then upgradeCurlRunnings
-    else runFile (file userArgs) verbosityLevel (grep userArgs) tlsCheckType
+    else runFile
+           (file userArgs)
+           verbosityLevel
+           (grep userArgs)
+           tlsCheckType
+           (json_output userArgs)

curl-runnings.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 184f34d36c0d081262571516a7ddbef911407a4dc5c3c08f6b67982a7d30d485
+-- hash: 36f3a328f46ddf05fd9e94383935542233bc1674c49698580add7c9ef9473fe0
 
 name:           curl-runnings
-version:        0.12.0
+version:        0.13.0
 synopsis:       A framework for declaratively writing curl based API tests
 description:    Please see the README on Github at <https://github.com/aviaviavi/curl-runnings#readme>
 category:       Testing

package.yaml

@@ -1,5 +1,5 @@
 name:                curl-runnings
-version:             0.12.0
+version:             0.13.0
 github:              aviaviavi/curl-runnings
 license:             MIT
 author:              Avi Press

src/Testing/CurlRunnings/Internal.hs

@@ -13,7 +13,7 @@ module Testing.CurlRunnings.Internal
   , makeUnsafeLogger
   , pShow
   , nowMillis
-  , roundToStr
+  , millisToS
   , LogLevel(..)
   , CurlRunningsLogger
   , CurlRunningsUnsafeLogger
@@ -86,3 +86,6 @@ nowMillis = do
 
 roundToStr :: (PrintfArg a, Floating a) => a -> String
 roundToStr = printf "%0.2f"
+
+millisToS :: Integer -> Double
+millisToS t = (fromIntegral t :: Double) / 1000.0

src/Testing/CurlRunnings/Types.hs

@@ -129,13 +129,16 @@ data QueryError
   -- | Tried to access a value in a null object.
   | NullPointer T.Text -- full query
                 T.Text -- message
+                deriving (Generic)
 
 instance Show QueryError where
   show (QueryParseError t q) = printf "error parsing query %s: %s" q $ T.unpack t
   show (NullPointer full part) = printf "null pointer in %s at %s" (T.unpack full) $ T.unpack part
   show (QueryTypeMismatch message val) = printf "type error: %s %s" message $ show val
   show (QueryValidationError message) = printf "invalid query: %s" message
 
+instance ToJSON QueryError
+
 instance FromJSON HeaderMatcher where
   parseJSON o@(String v) =
     either
@@ -232,8 +235,9 @@ data AssertionFailure
   | QueryFailure CurlCase
                  QueryError
   -- | Something else
-  | UnexpectedFailure
+  | UnexpectedFailure deriving (Generic)
 
+instance ToJSON AssertionFailure
 
 colorizeExpects :: String -> String
 colorizeExpects t =
@@ -309,9 +313,6 @@ instance Show AssertionFailure where
     printf "JSON query error in spec %s: %s" (name curlCase) (show queryErr)
   show UnexpectedFailure = "Unexpected Error D:"
 
-formatSecToMS :: Integer -> String
-formatSecToMS t = roundToStr ((fromIntegral t :: Double) / 1000.0)
-
 -- | A type representing the result of a single curl, and all associated
 -- assertions
 data CaseResult
@@ -327,16 +328,36 @@ data CaseResult
       , caseResponseValue   :: Maybe Value
       , failures            :: [AssertionFailure]
       , elapsedTime         :: Integer -- ^ Elapsed time
-      }
+      } deriving (Generic)
+
 instance Show CaseResult where
-  show CasePass{curlCase, elapsedTime} = T.unpack . makeGreen $ "[PASS] " <> (T.pack $ printf "%s (%s seconds)" (name curlCase) (formatSecToMS elapsedTime))
+  show CasePass{curlCase, elapsedTime} = T.unpack . makeGreen $ "[PASS] " <> (T.pack $ printf "%s (%0.2f seconds)" (name curlCase) (millisToS elapsedTime))
   show CaseFail{curlCase, failures, elapsedTime} =
     T.unpack $ makeRed "[FAIL] " <>
     name curlCase <>
-    (T.pack $ printf " (%s seconds) " (formatSecToMS elapsedTime)) <>
+    (T.pack $ printf " (%0.2f seconds) " (millisToS elapsedTime)) <>
     "\n" <>
     mconcat (map ((\s -> "\nAssertion failed: " <> s) . (<> "\n") . (T.pack . show)) failures)
 
+instance ToJSON CaseResult where
+  toJSON CasePass {curlCase, caseResponseHeaders, caseResponseValue, elapsedTime} =
+    object
+      [ "testPassed" .= (Bool True)
+      , "case" .= curlCase
+      , "responseHeaders" .= caseResponseHeaders
+      , "responseValue" .= caseResponseValue
+      , "elapsedTimeSeconds" .= millisToS elapsedTime
+      ]
+  toJSON CaseFail {curlCase, caseResponseHeaders, caseResponseValue, elapsedTime, failures} =
+    object
+      [ "testPassed" .= (Bool False)
+      , "case" .= curlCase
+      , "responseHeaders" .= caseResponseHeaders
+      , "responseValue" .= caseResponseValue
+      , "elapsedTimeSeconds" .= millisToS elapsedTime
+      , "failures" .= failures
+      ]
+
 -- | A wrapper type around a set of test cases. This is the top level spec type
 -- that we parse a test spec file into
 data CurlSuite = CurlSuite