feat: add json logging and json result output

spex.cabal

@@ -87,6 +87,7 @@ library
     , prettyprinter
     , random
     , template-haskell
+    , time
     , utf8-string
     , vector
     , wai

src/Spex/CommandLine/Option.hs

@@ -23,6 +23,7 @@ data Options = Options
   , logging :: Logging
   , logFile :: Maybe FilePath
   , nonInteractive :: Bool
+  , jsonLogging :: Bool
   }
 
 data Logging = Quiet Bool | Verbose Bool | Trace Bool
@@ -44,6 +45,7 @@ data VerifyOptions = VerifyOptions
   , numTests :: Word
   , seed :: Maybe Int
   , noShrinking :: Bool
+  , jsonResult :: Bool
   , specFilePath :: FilePath
   }
 
@@ -168,6 +170,10 @@ parser =
       ( long "non-interactive"
           <> help "Disable fancy logging"
       )
+    <*> switch
+      ( long "json-logging"
+          <> help "Enable logging in JSON format"
+      )
   where
     verify :: Parser VerifyOptions
     verify =
@@ -217,6 +223,10 @@ parser =
           ( long "no-shrinking"
               <> help "Disable shrinking"
           )
+        <*> switch
+          ( long "json-result"
+              <> help "Output the result in JSON format"
+          )
         <*> specFile
 
     specFile :: Parser FilePath

src/Spex/LibMain.hs

@@ -3,6 +3,7 @@
 module Spex.LibMain where
 
 import Control.Exception
+import Data.Aeson qualified as Json
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as LBS
 import Data.Text qualified as Text
@@ -48,6 +49,7 @@ mainWith opts testing = do
           -- During testing, redirect the printing of the result to the logs,
           -- so it's easier to test the complete output using one golden test.
           | testing -> (verifyAppLog vopts, vopts.specFilePath)
+          | vopts.jsonResult -> (verifyAppJson vopts, vopts.specFilePath)
           | otherwise -> (verifyAppStdout vopts, vopts.specFilePath)
         Format fopts -> (formatApp fopts, fopts.specFilePath)
         Mock mopts -> (mockApp mopts, mopts.specFilePath)
@@ -77,6 +79,16 @@ verifyAppLog opts =
     opts
     (\spec result seed -> info_ (displayResult spec result seed))
 
+verifyAppJson :: VerifyOptions -> App ()
+verifyAppJson opts =
+  verifyApp
+    opts
+    ( \_spec result seed ->
+        liftIO $
+          LBS.putStr
+            (Json.encode (ResultJson result.failingTests result.coverage seed))
+    )
+
 verifyApp ::
   VerifyOptions -> (Spec -> Result -> Int -> App ()) -> App ()
 verifyApp opts handleResult = do

src/Spex/Logger.hs

@@ -3,15 +3,25 @@
 module Spex.Logger (module Spex.Logger) where
 
 import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Time.Clock
+import Data.Time.Format.ISO8601
 
 import Spex.CommandLine.Ansi
 
 ------------------------------------------------------------------------
 
+data LoggerKind = PlainLogger | JsonLogger
+
+data InfoKind = PlainInfo | NormalInfo | DoneInfo
+
+data DebugKind = PlainDebug | NormalDebug
+
 data Logger = Logger
-  { loggerInfo :: Bool -> Text -> IO ()
+  { loggerKind :: LoggerKind
+  , loggerInfo :: InfoKind -> Text -> IO ()
   , loggerError :: Text -> IO ()
-  , loggerDebug :: Text -> IO ()
+  , loggerDebug :: DebugKind -> Text -> IO ()
   , loggerTrace :: Text -> IO ()
   , loggerFlush :: IO ()
   , loggerClose :: IO ()
@@ -21,39 +31,84 @@ data Logger = Logger
 noAnsiLogger :: (Text -> IO ()) -> IO () -> IO () -> Logger
 noAnsiLogger printer flusher closer =
   Logger
-    { loggerInfo = \b ->
-        if b
-          then printer . ("✓ " <>)
-          else printer . ("i " <>)
+    { loggerKind = PlainLogger
+    , loggerInfo = \k -> case k of
+        PlainInfo -> printer
+        NormalInfo -> printer . ("i " <>)
+        DoneInfo -> printer . ("✓ " <>)
     , loggerError = printer . ("Error: " <>)
-    , loggerDebug = \_s -> return ()
-    , loggerTrace = \_s -> return ()
+    , loggerDebug = \_k _msg -> return ()
+    , loggerTrace = \_msg -> return ()
     , loggerFlush = flusher
     , loggerClose = closer
     }
 
 ansiLogger :: (Text -> IO ()) -> IO () -> IO () -> Logger
 ansiLogger printer flusher closer =
   Logger
-    { loggerInfo = \b ->
-        if b
-          then printer . (green "✓ " <>)
-          else printer . (cyan "i " <>)
+    { loggerKind = PlainLogger
+    , loggerInfo = \k -> case k of
+        PlainInfo -> printer
+        NormalInfo -> printer . (cyan "i " <>)
+        DoneInfo -> printer . (green "✓ " <>)
     , loggerError = printer . ((boldRed "Error" <> ": ") <>)
-    , loggerDebug = \_s -> return ()
-    , loggerTrace = \_s -> return ()
+    , loggerDebug = \_k _msg -> return ()
+    , loggerTrace = \_msg -> return ()
+    , loggerFlush = flusher
+    , loggerClose = closer
+    }
+
+jsonLogger :: (Text -> IO ()) -> IO () -> IO () -> Logger
+jsonLogger printer flusher closer =
+  Logger
+    { loggerKind = JsonLogger
+    , loggerInfo = \_k -> logJson printer "info"
+    , loggerError = logJson printer "error"
+    , loggerDebug = \_k _msg -> return ()
+    , loggerTrace = \_msg -> return ()
     , loggerFlush = flusher
     , loggerClose = closer
     }
 
+logJson :: (Text -> IO ()) -> Text -> Text -> IO ()
+logJson printer level msg = do
+  if Text.null (Text.strip msg)
+    then return ()
+    else do
+      t <- getCurrentTime
+      printer $
+        Text.concat
+          [ "{\"timestamp\":\""
+          , Text.pack (iso8601Show t)
+          , "\","
+          , "\"level\":\""
+          , level
+          , "\","
+          , "\"message\":\""
+          , Text.strip msg
+          , "\"}"
+          ]
+
 quietLogger :: Logger -> Logger
 quietLogger l = l {loggerInfo = \_ _ -> return ()}
 
 verboseLogger :: (Text -> IO ()) -> Logger -> Logger
-verboseLogger printer l = l {loggerDebug = printer . (faint "d " <>)}
+verboseLogger printer l = case l.loggerKind of
+  PlainLogger ->
+    l
+      { loggerDebug = \k -> case k of
+          PlainDebug -> printer
+          NormalDebug -> printer . (faint "d " <>)
+      }
+  JsonLogger -> l {loggerDebug = \_k -> logJson printer "debug"}
 
 traceLogger :: (Text -> IO ()) -> Logger -> Logger
-traceLogger printer l =
-  (verboseLogger printer l)
-    { loggerTrace = printer . (faint "t " <>)
-    }
+traceLogger printer l = case l.loggerKind of
+  PlainLogger ->
+    (verboseLogger printer l)
+      { loggerTrace = printer . (faint "t " <>)
+      }
+  JsonLogger ->
+    (verboseLogger printer l)
+      { loggerTrace = logJson printer "trace"
+      }

src/Spex/Monad.hs

@@ -63,6 +63,7 @@ newAppEnv opts = do
       return (Text.hPutStrLn h, hFlush h, hClose h)
 
   let logger'
+        | opts.jsonLogging = jsonLogger printer flusher closer
         | not hasAnsi || opts.nonInteractive =
             noAnsiLogger printer flusher closer
         | otherwise = ansiLogger printer flusher closer
@@ -82,12 +83,12 @@ newAppEnv opts = do
 info :: Text -> App ()
 info t = do
   l <- asks logger
-  liftIO (l.loggerInfo False t)
+  liftIO (l.loggerInfo NormalInfo t)
 
 info_ :: Text -> App ()
 info_ t = do
   l <- asks logger
-  liftIO (l.loggerInfo False ("\b\b  " <> t))
+  liftIO (l.loggerInfo PlainInfo t)
 
 logError :: Text -> App ()
 logError t = do
@@ -97,12 +98,12 @@ logError t = do
 debug :: Text -> App ()
 debug t = do
   l <- asks logger
-  liftIO (l.loggerDebug t)
+  liftIO (l.loggerDebug NormalDebug t)
 
 debug_ :: Text -> App ()
 debug_ t = do
   l <- asks logger
-  liftIO (l.loggerDebug ("\b\b  " <> t))
+  liftIO (l.loggerDebug PlainDebug t)
 
 trace :: Text -> App ()
 trace t = do
@@ -112,7 +113,7 @@ trace t = do
 done :: Text -> App ()
 done t = do
   l <- asks logger
-  liftIO (l.loggerInfo True t)
+  liftIO (l.loggerInfo DoneInfo t)
 
 flushLogger :: App ()
 flushLogger = do

src/Spex/PrettyPrinter.hs

@@ -10,6 +10,8 @@ import Data.Map qualified as Map
 import Data.String
 import Data.Text (Text)
 import Data.Text qualified as Text
+import Data.Vector (Vector)
+import Data.Vector qualified as Vector
 import Prettyprinter
 import Prettyprinter.Render.Text
 import System.IO
@@ -116,6 +118,9 @@ prettyRecord p =
 prettyFields :: (a -> Doc x) -> Map Field a -> [Doc x]
 prettyFields p = map (\(Field f, x) -> pretty f <+> p x) . Map.toList
 
+prettyArray :: (a -> Doc x) -> Vector a -> Doc x
+prettyArray p = list . map p . Vector.toList
+
 prettyBS :: (Coercible a ByteString) => a -> Doc x
 prettyBS = fromString . BS8.unpack . coerce
 
@@ -129,7 +134,7 @@ prettyValue UnitV = "()"
 prettyValue (BoolV b) = viaShow b
 prettyValue (IntV i) = viaShow i
 prettyValue (StringV t) = pretty t
-prettyValue (ArrayV vs) = undefined
+prettyValue (ArrayV vs) = prettyArray prettyValue vs
 prettyValue (RecordV fvs) = prettyRecord (\val -> "=" <+> prettyValue val) fvs
 
 displayValue :: Value -> Text

src/Spex/Verifier.hs

@@ -90,7 +90,7 @@ verifyLoop opts spec deployment client = go
             -- If we've seen a failure already, then don't add it to the test
             -- cases.
             if failure0 `elem` map failure res.failingTests
-              then return (res {coverage = cov'})
+              then return (res {coverage = cov'} :: Result)
               else do
                 test <-
                   counterExample

src/Spex/Verifier/Result.hs

@@ -17,6 +17,14 @@ import Spex.Verifier.Coverage
 
 ------------------------------------------------------------------------
 
+data ResultJson = ResultJson
+  { failingTests :: [FailingTest]
+  , coverage :: Coverage
+  , seed :: Int
+  }
+  deriving stock (Generic)
+  deriving anyclass (ToJSON)
+
 data Result = Result
   { failingTests :: [FailingTest] -- XXX: Set?
   , coverage :: Coverage

test/golden/verify_example-petstore-modal-faults.spex_--seed_8800299288541500217.golden

@@ -1,4 +1,4 @@
-i   
+
 i Verifying the deployment:    http://localhost:8080
   against the specification:   example/petstore-modal-faults.spex
 
@@ -11,7 +11,7 @@ i Waiting for health check to pass...
 i Starting to run tests...
 
 ✓ Done testing!
-i     
+
   Found 2 intereresting test cases:
 
     1. getBadPet : GET /pet/badJson/{petId = 0} -> Pet