test: start adding golden tests

example/petstore/app/Main.hs

@@ -3,4 +3,4 @@ module Main where
 import Petstore
 
 main :: IO ()
-main = libMain
+main = libMain 8080

example/petstore/src/Petstore.hs

@@ -17,13 +17,13 @@ import Servant
 ------------------------------------------------------------------------
 
 type PetstoreAPI =
-  "pet"    :> Capture "petId" Int :> Get '[JSON] Pet :<|>
-  "pet"    :> ReqBody '[JSON] Pet :> Post '[JSON] () :<|>
-  "health" :> Get '[JSON] () :<|>
-  "_reset" :> Delete '[JSON] ()
+  "pet" :> Capture "petId" Int :> Get '[JSON] Pet
+    :<|> "pet" :> ReqBody '[JSON] Pet :> Post '[JSON] ()
+    :<|> "health" :> Get '[JSON] ()
+    :<|> "_reset" :> Delete '[JSON] ()
 
 data Pet = Pet
-  { petId   :: Int
+  { petId :: Int
   , petName :: String
   }
   deriving (Eq, Show, Generic)
@@ -38,14 +38,14 @@ server store = getPet :<|> addPet :<|> health :<|> reset
     getPet pid = do
       pets <- liftIO (readIORef store)
       case find (\pet -> petId pet == pid) pets of
-        Nothing  -> throwError err404
+        Nothing -> throwError err404
         Just pet -> return pet
 
     addPet :: Pet -> Handler ()
     addPet pet = do
       pets <- liftIO (readIORef store)
       when (pet `elem` pets) $
-        throwError err409 { errBody = "Pet already exists" }
+        throwError err409 {errBody = "Pet already exists"}
       liftIO (writeIORef store (pet : pets))
 
     health :: Handler ()
@@ -60,9 +60,8 @@ petstoreAPI = Proxy
 app :: IORef [Pet] -> Application
 app store = serve petstoreAPI (server store)
 
-libMain :: IO ()
-libMain = do
+libMain :: Port -> IO ()
+libMain port = do
   store <- newIORef [Pet 1 "apa"]
-  putStrLn "Running petstore on localhost:8080"
-  run 8080 (app store)
-
+  putStrLn $ "Running petstore on localhost:" <> show port
+  run port (app store)

spex.cabal

@@ -2,8 +2,8 @@ cabal-version:   3.0
 name:            spex
 version:         0.0.0
 synopsis:        The Spex specification language
-description:     See README at <https://github.com/stevana/spex#readme>
-homepage:        https://github.com/stevana/spex#readme
+description:     See README at <https://github.com/spex-lang/spex#readme>
+homepage:        https://github.com/spex-lang/spex#readme
 license:         BSD-2-Clause
 license-file:    LICENSE
 author:          Stevan A
@@ -117,4 +117,11 @@ test-suite test
   main-is:          Main.hs
   build-depends:
     , base
+    , directory
+    , filepath
+    , petstore
     , spex
+    , tasty
+    , tasty-golden
+    , tasty-hunit
+    , temporary

src/Spex/CommandLine/Ansi.hs

@@ -1,5 +1,7 @@
 module Spex.CommandLine.Ansi where
 
+import Data.Text (Text)
+import Data.Text qualified as Text
 import System.Console.ANSI
 import System.IO
 
@@ -8,22 +10,22 @@ import System.IO
 hasAnsiSupport :: IO Bool
 hasAnsiSupport = hNowSupportsANSI stdout
 
-withSGR :: [SGR] -> String -> String
-withSGR sgr s = setSGRCode sgr ++ s ++ setSGRCode []
+withSGR :: [SGR] -> Text -> Text
+withSGR sgr s = Text.pack (setSGRCode sgr) <> s <> Text.pack (setSGRCode [])
 
-cyan :: String -> String
+cyan :: Text -> Text
 cyan = withSGR [SetColor Foreground Vivid Cyan]
 
-green :: String -> String
+green :: Text -> Text
 green = withSGR [SetColor Foreground Vivid Green]
 
-red :: String -> String
+red :: Text -> Text
 red = withSGR [SetColor Foreground Vivid Red]
 
-boldRed :: String -> String
+boldRed :: Text -> Text
 boldRed =
   withSGR
     [SetColor Foreground Vivid Red, SetConsoleIntensity BoldIntensity]
 
-faint :: String -> String
+faint :: Text -> Text
 faint = withSGR [SetConsoleIntensity FaintIntensity]

src/Spex/CommandLine/Option.hs

@@ -21,9 +21,11 @@ import Spex.CommandLine.GitHash (tGitHash)
 data Options = Options
   { optsCommand :: Command
   , logging :: Logging
+  , logFile :: Maybe FilePath
   , nonInteractive :: Bool
   }
 
+-- XXX: renmae veryVerbose to trace?
 data Logging = Quiet Bool | Verbose Bool | VeryVerbose Bool
 
 data Command
@@ -142,6 +144,11 @@ parser =
                   )
               )
         )
+    <*> optional
+      ( strOption
+          ( long "log-file" <> metavar "FILE" <> help "File to append log output to"
+          )
+      )
     <*> switch
       ( long "non-interactive"
           <> help "Disable fancy logging"

src/Spex/LibMain.hs

@@ -25,6 +25,7 @@ libMain = do
   setLocaleEncoding utf8
   opts <- parseCliOptions
   mainWith opts
+  exitSuccess
 
 mainWith :: Options -> IO ()
 mainWith (optsCommand -> Repl {}) = notSupportedYet
@@ -37,12 +38,12 @@ mainWith opts = do
         Format fopts -> (formatApp fopts, fopts.specFilePath)
         Check copts -> (checkApp copts, copts.specFilePath)
         _ -> error "impossible"
-  runApp appEnv app >>= \case
+  runApp appEnv (app >> flushLogger >> closeLogger) >>= \case
     Left err -> do
       lbs <- LBS.readFile specFile
       Right () <- runApp appEnv (logError (displayAppError specFile lbs err))
       exitFailure
-    Right () -> exitSuccess
+    Right () -> return ()
 
 notSupportedYet :: IO ()
 notSupportedYet = do

src/Spex/Monad.hs

@@ -9,17 +9,21 @@ module Spex.Monad (
 
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
-import Control.Monad.Trans.Reader hiding (asks)
+import Control.Monad.Trans.Reader (ReaderT (ReaderT), runReaderT)
 import Control.Monad.Trans.Reader qualified as Reader
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as BS8
 import Data.ByteString.Lazy (LazyByteString)
 import Data.ByteString.Lazy qualified as LBS
+import Data.Text (Text)
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
 import Network.HTTP.Client (
   HttpException (..),
   HttpExceptionContent (..),
  )
 import Network.HTTP.Client qualified as Http
+import System.IO
 
 import Spex.CommandLine.Ansi
 import Spex.CommandLine.Option
@@ -49,12 +53,21 @@ newAppEnv :: Options -> IO AppEnv
 newAppEnv opts = do
   hasAnsi <- hasAnsiSupport
 
+  (printer, flusher, closer) <- case opts.logFile of
+    Nothing -> return (Text.putStrLn, return (), return ())
+    Just fp -> do
+      -- XXX: can fail...
+      h <- openFile fp WriteMode
+      hSetBuffering h LineBuffering
+      return (Text.hPutStrLn h, hFlush h, hClose h)
+
   let logger'
-        | not hasAnsi || opts.nonInteractive = noAnsiLogger
-        | otherwise = ansiLogger
+        | not hasAnsi || opts.nonInteractive =
+            noAnsiLogger printer flusher closer
+        | otherwise = ansiLogger printer flusher closer
       logger'' = case opts.logging of
-        Verbose True -> verboseLogger logger'
-        VeryVerbose True -> veryVerboseLogger logger'
+        Verbose True -> verboseLogger printer logger'
+        VeryVerbose True -> veryVerboseLogger printer logger'
         Quiet True -> quietLogger logger'
         _otherwise -> logger'
 
@@ -64,83 +77,99 @@ newAppEnv opts = do
       }
 
 data Logger = Logger
-  { loggerInfo :: Bool -> String -> IO ()
-  , loggerError :: String -> IO ()
-  , loggerDebug :: String -> IO ()
-  , loggerTrace :: String -> IO ()
+  { loggerInfo :: Bool -> Text -> IO ()
+  , loggerError :: Text -> IO ()
+  , loggerDebug :: Text -> IO ()
+  , loggerTrace :: Text -> IO ()
+  , loggerFlush :: IO ()
+  , loggerClose :: IO ()
   }
 
 -- XXX: Check for unicode support, for checkmark?
-noAnsiLogger :: Logger
-noAnsiLogger =
+noAnsiLogger :: (Text -> IO ()) -> IO () -> IO () -> Logger
+noAnsiLogger printer flusher closer =
   Logger
     { loggerInfo = \b ->
         if b
-          then putStrLn . ("✓ " ++)
-          else putStrLn . ("i " ++)
-    , loggerError = putStrLn . ("Error: " ++)
+          then printer . ("✓ " <>)
+          else printer . ("i " <>)
+    , loggerError = printer . ("Error: " <>)
     , loggerDebug = \_s -> return ()
     , loggerTrace = \_s -> return ()
+    , loggerFlush = flusher
+    , loggerClose = closer
     }
 
-ansiLogger :: Logger
-ansiLogger =
+ansiLogger :: (Text -> IO ()) -> IO () -> IO () -> Logger
+ansiLogger printer flusher closer =
   Logger
     { loggerInfo = \b ->
         if b
-          then putStrLn . (green "✓ " ++)
-          else putStrLn . (cyan "i " ++)
-    , loggerError = putStrLn . ((boldRed "Error" ++ ": ") ++)
+          then printer . (green "✓ " <>)
+          else printer . (cyan "i " <>)
+    , loggerError = printer . ((boldRed "Error" <> ": ") <>)
     , loggerDebug = \_s -> return ()
     , loggerTrace = \_s -> return ()
+    , loggerFlush = flusher
+    , loggerClose = closer
     }
 
 quietLogger :: Logger -> Logger
 quietLogger l = l {loggerInfo = \_ _ -> return ()}
 
-verboseLogger :: Logger -> Logger
-verboseLogger l = l {loggerDebug = putStrLn . (faint "d " ++)}
+verboseLogger :: (Text -> IO ()) -> Logger -> Logger
+verboseLogger printer l = l {loggerDebug = printer . (faint "d " <>)}
 
-veryVerboseLogger :: Logger -> Logger
-veryVerboseLogger l =
-  (verboseLogger l)
-    { loggerTrace = putStrLn . (faint "t " ++)
+veryVerboseLogger :: (Text -> IO ()) -> Logger -> Logger
+veryVerboseLogger printer l =
+  (verboseLogger printer l)
+    { loggerTrace = printer . (faint "t " <>)
     }
 
 info :: String -> App ()
 info s = do
   l <- asks logger
-  liftIO (l.loggerInfo False s)
+  liftIO (l.loggerInfo False (Text.pack s))
 
 info_ :: String -> App ()
 info_ s = do
   l <- asks logger
-  liftIO (l.loggerInfo False ("\b\b  " ++ s))
+  liftIO (l.loggerInfo False (Text.pack ("\b\b  " ++ s)))
 
 logError :: String -> App ()
 logError s = do
   l <- asks logger
-  liftIO (l.loggerError s)
+  liftIO (l.loggerError (Text.pack s))
 
 debug :: String -> App ()
 debug s = do
   l <- asks logger
-  liftIO (l.loggerDebug s)
+  liftIO (l.loggerDebug (Text.pack s))
 
 debug_ :: String -> App ()
 debug_ s = do
   l <- asks logger
-  liftIO (l.loggerDebug ("\b\b  " ++ s))
+  liftIO (l.loggerDebug (Text.pack ("\b\b  " ++ s)))
 
 trace :: String -> App ()
 trace s = do
   l <- asks logger
-  liftIO (l.loggerTrace s)
+  liftIO (l.loggerTrace (Text.pack s))
 
 done :: String -> App ()
 done s = do
   l <- asks logger
-  liftIO (l.loggerInfo True s)
+  liftIO (l.loggerInfo True (Text.pack s))
+
+flushLogger :: App ()
+flushLogger = do
+  l <- asks logger
+  liftIO l.loggerFlush
+
+closeLogger :: App ()
+closeLogger = do
+  l <- asks logger
+  liftIO l.loggerClose
 
 ------------------------------------------------------------------------
 
@@ -235,7 +264,7 @@ displayScopeError fp lbs pos tids =
         lpad
         ++ " │ "
         ++ replicate c' ' '
-        ++ red (replicate (length (displayTypeId tid)) '^')
+        ++ Text.unpack (red (Text.replicate (length (displayTypeId tid)) "^"))
         ++ "\n\n"
         ++ "Either define the type or mark it as abstract, in case it shouldn't be\ngenerated."