summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJasperVanDerJeugt <>2020-06-29 15:49:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-06-29 15:49:00 (GMT)
commitf9ca33974f1f42781500dece0e9f6b18de72066f (patch)
treec6fee8e138a52efb14eda58418d9aaefc9514974
parent589575acc49d9050a108a171f8c407bc86315bcb (diff)
version 0.1.1HEAD0.1.1master
-rw-r--r--CHANGELOG.md7
-rw-r--r--README.md130
-rw-r--r--goldplate.cabal4
-rw-r--r--src/Data/Aeson/Extended.hs23
-rw-r--r--src/Main.hs224
-rw-r--r--src/Text/Regex/PCRE/Simple.hs1
-rw-r--r--src/Text/Splice.hs40
7 files changed, 243 insertions, 186 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 85745c4..12ef785 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,4 +1,9 @@
# CHANGELOG
- - 0.1.0 (2020-06-20)
+ - 0.1.1 (2020-06-29)
+ * Add `GOLDPLATE_BASENAME` and `GOLDPLATE_INPUT_BASENAME` environment
+ variables.
+ * Fix issue with `GOLDPLATE_FILE` environment variable.
+
+ - 0.1.0 (2020-06-21)
* Initial release.
diff --git a/README.md b/README.md
index 6afef06..7d8355a 100644
--- a/README.md
+++ b/README.md
@@ -26,7 +26,7 @@ since 2016, so it should be pretty stable.
## Table of Contents
- [Tutorial](#tutorial)
- - [Simple asserts](#simple-asserts)
+ - [Creating a first test](#creating-a-first-test)
- [Feeding input on stdin](#feeding-input-on-stdin)
- [Setting environment
variables](#setting-environment-variables)
@@ -47,59 +47,100 @@ since 2016, so it should be pretty stable.
## Tutorial
-You can follow along with the tutorial by cloning the repository and running
-this command:
+### Creating a first test
- $ goldplate tests
+Imagine we are up to testing the behaviour of `echo` command. In this very
+simple example, we run `echo "Hello, world!"` and expect it to print `Hello,
+world!` to the stdout stream as a result.
-As you can see, `goldplate` itself is tested using `goldplate`. In this
-tutorial, we'll walk through some examples. By the end, you should have a good
-idea of how to test your CLI application using `goldplate`.
+Create a new file `echo.goldplate` and add the following content:
-### Simple asserts
+```json
+{
+ "command": "echo",
+ "arguments": ["Hello, world!"],
+ "asserts": [
+ {"exit_code": 0},
+ {"stdout": "hello-world.txt"}
+ ]
+}
+```
-View example: [`tests/echo.goldplate`](tests/echo.goldplate)
+Let's go through this bit by bit.
-In this very simple example, we just run `echo "Hello, world!"`. This is
-specified in the `command` and `arguments` fields.
+The test invocation is specified by the `command` and `arguments` fields. We
+are invoking the `echo` process with a single argument, `"Hello, world!"`.
-The actual tests that we're executing live in the `asserts` field. This simple
-test has two asserts:
+The expected results of our test live in the `asserts` field. This simple test
+has two asserts:
1. We verify that the exit code is 0 (success).
-2. We check the `stdout` (output) of the command against the file
- `${GOLDPLATE_NAME}.stdout`. `GOLDPLATE_NAME` is the name of the
- specification without the extension; so our expected output lives in
- [`tests/echo.stdout`](tests/echo.stdout) in this case.
+2. We check the `stdout` (output) of the command against the contents of
+ the file `hello-world.txt`.
-We can check that our asserts are correct:
+We haven't created `hello-world.txt` yet, but that's not a problem. We can
+invoke `goldplate --fix` to create it:
- $ goldplate tests/echo.goldplate
+ $ goldplate echo.goldplate --pretty-diff --fix
+ ...
+ echo.goldplate: stdout: does not match
+ echo.goldplate: fixed ./hello-world.txt
+ ...
+ Ran 1 specs, 1 executions, 2 asserts, 1 failed.
-If we want to regenerate the expected output, we can simply do:
+After `hello-world.txt` has been created with proper contents, subsequent
+`goldplate` invocations will pass:
- $ rm tests/echo.stdout
- $ goldplate --fix --pretty-diff tests/echo.goldplate
+ $ goldplate echo.goldplate
+ ...
+ Ran 1 specs, 1 executions, 2 asserts, all A-OK!
-And `goldplate` will show you that it fixed one file.
+You can view the full example here:
+
+ - [`tests/echo.goldplate`](tests/echo.goldplate)
+ - [`tests/hello-world.txt`](tests/hello-world.txt)
### Feeding input on stdin
-View example: [`tests/cat.goldplate`](tests/cat.goldplate)
+View example:
+
+ - [`tests/cat.goldplate`](tests/cat.goldplate)
+ - [`tests/cat.stdout`](tests/cat.stdout)
You can pass one or multiple lines of input to the command by using the `stdin`
field.
### Setting environment variables
-View example: [`tests/env.goldplate`](tests/env.goldplate)
+View example:
+
+ - [`tests/env.goldplate`](tests/env.goldplate)
+ - [`tests/env.stdout`](tests/env.stdout)
The `environment` field can be used to set environment variables for the
program.
+`goldplate` also sets [a number of environment
+variables](#environment-variables). You can use these directly within the
+configuration JSON. In this example, we use:
+
+ {"stdout": "${GOLDPLATE_NAME}.stdout"}
+
+Rather than:
+
+ {"stdout": "env.stdout"}
+
+We found this to be good practice, it makes mass-renaming of tests much easier.
+
### Globbing input files
-View example: [`tests/glob.goldplate`](tests/glob.goldplate)
+View example:
+
+ - [`tests/glob.goldplate`](tests/glob.goldplate)
+ - [`tests/glob-1.txt`](tests/glob-1.txt)
+ - [`tests/glob-1.stdout`](tests/glob-1.stdout)
+ - [`tests/glob-2.txt`](tests/glob-2.txt)
+ - [`tests/glob-2.stdout`](tests/glob-2.stdout)
`.goldplate` files are fairly small but if you have a whole directory of files
that you just want to run the same command on, they can get very repetitive.
@@ -113,7 +154,10 @@ matching input file. `goldplate` will set the following variables:
### Post processing: find and replace
-View example: [`tests/replace.goldplate`](tests/replace.goldplate)
+View example:
+
+ - [`tests/replace.goldplate`](tests/replace.goldplate)
+ - [`tests/replace.stdout`](tests/replace.stdout)
Sometimes you may want to do a find-and-replace on the actual output, for
example to filter out timestamps or other information that you do not expect to
@@ -121,7 +165,10 @@ match up against the expected output.
### Post processing: prettify JSON
-View example: [`tests/prettify-json.goldplate`](tests/prettify-json.goldplate)
+View example:
+
+ - [`tests/prettify-json.goldplate`](tests/prettify-json.goldplate)
+ - [`tests/prettify-json.json`](tests/prettify-json.json)
Many modern CLI tools output JSON. You can use the `prettify_json` post
processor to make sure the JSON is converted to a normalized form with sorted
@@ -129,7 +176,10 @@ keys and consistent indentation.
### Created files and directories
-View example: [`tests/create.goldplate`](tests/create.goldplate)
+View example:
+
+ - [`tests/create.goldplate`](tests/create.goldplate)
+ - [`tests/create.file`](tests/create.file)
`goldplate` is geared towards checking the `stdout` and `stderr` outputs of a
program, but you can also check that files were created with specific contents.
@@ -168,18 +218,26 @@ syntax within strings. To escape this syntax, use `$${VAR}` to get a literal
The test is always executed in the directory that holds the `.goldplate` file.
`goldplate` will always set the following environment variables:
- - `GOLDPLATE_FILE`: The filename of the `.goldplate` file, e.g.
- `echo.goldplate`.
- - `GOLDPLATE_NAME`: The filename of the `.goldplate` file without the
- extension, e.g. `echo`.
+ - `GOLDPLATE_FILE`: The filename of the `.goldplate` file.
+ - `GOLDPLATE_NAME`: The filename of the `.goldplate` file _without_ the
+ extension.
+ - `GOLDPLATE_BASENAME`: The basename (filename without directory) of
+ the `.goldplate` file.
When dealing with [multiple input files](#globbing-input-files), the following
additional variables are set:
- - `GOLDPLATE_INPUT_FILE`: The input file name, relative to the current
- directory.
+ - `GOLDPLATE_INPUT_FILE`: The input file name (relative to the current
+ directory).
- `GOLDPLATE_INPUT_NAME`: The same as `GOLDPLATE_INPUT_FILE` but without
- any extensions.
+ the extension.
+ - `GOLDPLATE_INPUT_BASENAME`: The basename (filename without directory) of
+ the input file.
+
+Here is an example that outputs all of these environment variables:
+
+ - [`tests/builtin.goldplate`](tests/builtin.goldplate)
+ - [`tests/builtin.stdout`](tests/builtin.stdout)
## Similar projects
diff --git a/goldplate.cabal b/goldplate.cabal
index 17dbeae..b97256b 100644
--- a/goldplate.cabal
+++ b/goldplate.cabal
@@ -1,5 +1,5 @@
Name: goldplate
-Version: 0.1.0
+Version: 0.1.1
Synopsis: A lightweight golden test runner
License: Apache-2.0
License-file: LICENSE
@@ -21,8 +21,8 @@ Executable goldplate
Ghc-options: -Wall -rtsopts -threaded -O2
Other-modules:
- Data.Aeson.Extended
Text.Regex.PCRE.Simple
+ Text.Splice
Paths_goldplate
Build-depends:
diff --git a/src/Data/Aeson/Extended.hs b/src/Data/Aeson/Extended.hs
deleted file mode 100644
index c41e72d..0000000
--- a/src/Data/Aeson/Extended.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-module Data.Aeson.Extended
- ( module Data.Aeson
- , Multiple (..)
- , multipleToList
- ) where
-
-import Control.Applicative ((<|>))
-import Data.Aeson
-
-data Multiple a
- = Multiple [a]
- | Single a
- deriving (Foldable, Functor, Traversable)
-
-instance FromJSON a => FromJSON (Multiple a) where
- parseJSON val = (Multiple <$> parseJSON val) <|> (Single <$> parseJSON val)
-
-multipleToList :: Multiple a -> [a]
-multipleToList (Multiple xs) = xs
-multipleToList (Single x) = [x]
diff --git a/src/Main.hs b/src/Main.hs
index d1c0d65..4d46835 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,31 +1,30 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveFoldable #-}
-{-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Main
( main
) where
-
import Control.Applicative ((<|>))
import Control.Concurrent (threadDelay)
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.MVar as MVar
-import Control.Exception (Exception, throwIO)
+import Control.Exception (finally, throwIO)
import Control.Monad (forM, forM_, forever, mzero, unless,
when)
+import qualified Data.Aeson as A
import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty
-import qualified Data.Aeson.Extended as A
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
+import qualified Data.Foldable as F
import Data.Function (on)
import qualified Data.HashMap.Strict as HMS
import qualified Data.IORef as IORef
@@ -34,65 +33,45 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time (NominalDiffTime, diffUTCTime,
getCurrentTime)
-import Data.Typeable (Typeable)
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import Paths_goldplate (version)
-import System.Directory (doesDirectoryExist, doesFileExist,
- removeDirectoryRecursive,
- removeFile, withCurrentDirectory)
+import qualified System.Directory as Dir
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..), exitFailure)
-import System.FilePath (dropExtension, isAbsolute,
- isPathSeparator, normalise,
- takeBaseName, takeDirectory, (</>))
+import qualified System.FilePath as FP
import qualified System.FilePath.Glob as Glob
import qualified System.IO as IO
import qualified System.Process as Process
import Text.Printf (printf)
import qualified Text.Regex.PCRE.Simple as Pcre
+import Text.Splice
+--------------------------------------------------------------------------------
--- | Environment for splicing in things.
-type SpliceEnv = [(String, String)]
+-- | This is a little helper type that we use when we either support multiple
+-- things (e.g. lines of stdin) or a single thing (e.g. a single string of
+-- stdin).
+data Multiple a = Multiple [a] | Single a
+ deriving (Foldable, Functor, Traversable)
-data MissingEnvVar = MissingEnvVar String
- deriving (Typeable)
+instance A.FromJSON a => A.FromJSON (Multiple a) where
+ parseJSON v = (Multiple <$> A.parseJSON v) <|> (Single <$> A.parseJSON v)
-instance Show MissingEnvVar where
- show (MissingEnvVar k) = "Missing environment variable: " ++ k
+multipleToList :: Multiple a -> [a]
+multipleToList = F.toList
-instance Exception MissingEnvVar
+--------------------------------------------------------------------------------
--- | Splice in a string with "Hello ${FOO}" syntax.
-splice :: SpliceEnv -> String -> Either MissingEnvVar String
-splice env = go
- where
- go str = case break (== '$') str of
- -- Splice
- (xs, '$' : '{' : ys) -> case break (== '}') ys of
- (key, '}' : zs) -> case lookup key env of
- Nothing -> Left $ MissingEnvVar key
- Just val -> fmap ((xs ++ val) ++) (go zs)
- (_, _) -> fmap ((xs ++ "${") ++) (go ys)
- -- Escape
- (xs, '$' : '$' : ys) ->
- let (dollars, zs) = break (== '{') ys in
- if all (== '$') dollars && "{" `List.isPrefixOf` zs
- then (xs ++) . (dollars ++) . ("${" ++) <$> go (drop 1 zs)
- else (xs ++) . ("$$" ++) <$> go ys
- (xs, []) -> Right xs
- (xs, (y : ys)) -> (xs ++) . (y :) <$> (go ys)
-
-
--- | The type parameter indicates the fields that we allow splicing over.
+-- | A specification that we parse from a JSON file.
+-- The type parameter indicates the fields that we allow splicing over.
data Spec a = Spec
- { sInputFiles :: !(Maybe a)
- , sCommand :: !a
- , sArguments :: ![a]
- , sStdin :: !(Maybe (A.Multiple a))
- , sEnv :: ![(a, a)]
- , sAsserts :: ![Assert a]
+ { specInputFiles :: !(Maybe a)
+ , specCommand :: !a
+ , specArguments :: ![a]
+ , specStdin :: !(Maybe (Multiple a))
+ , specEnv :: ![(a, a)]
+ , specAsserts :: ![Assert a]
} deriving (Foldable, Functor, Traversable)
instance A.FromJSON (Spec String) where
@@ -104,7 +83,9 @@ instance A.FromJSON (Spec String) where
<*> (maybe [] HMS.toList <$> o A..:? "environment")
<*> o A..: "asserts"
+--------------------------------------------------------------------------------
+-- | Post processing of stdout or created files.
type PostProcess = [PostProcessStep]
data PostProcessStep
@@ -112,21 +93,18 @@ data PostProcessStep
| ReplaceStep !Pcre.Regex !T.Text
instance A.FromJSON PostProcessStep where
- parseJSON (A.String s) = case s of
- "prettify_json" -> pure PrettifyJsonStep
- _ -> fail $ "Unknown PostProcessStep: " ++ show s
-
- parseJSON (A.Object o) = ReplaceStep
- <$> (do
- p <- o A..: "pattern"
- either (fail . show) return (Pcre.compile copts eopts p))
- <*> o A..: "replacement"
+ parseJSON = \case
+ A.String "prettify_json" -> pure PrettifyJsonStep
+ A.Object o -> ReplaceStep
+ <$> (do
+ p <- o A..: "pattern"
+ either (fail . show) return (Pcre.compile copts eopts p))
+ <*> o A..: "replacement"
+ _ -> mzero
where
copts = Pcre.optionUtf8 <> Pcre.optionMultiline
eopts = mempty
- parseJSON _ = mzero
-
postProcess :: PostProcess -> B.ByteString -> B.ByteString
postProcess ps bs0 = List.foldl' (flip postProcessStep) bs0 ps
@@ -144,6 +122,7 @@ postProcessStep (ReplaceStep regex replacement) bs =
either (const bs) T.encodeUtf8 .
Pcre.replaceAll regex replacement $ T.decodeUtf8 bs
+--------------------------------------------------------------------------------
-- | Asserts that can happen after an execution.
data Assert a
@@ -169,21 +148,13 @@ data Assert a
instance A.FromJSON a => A.FromJSON (Assert a) where
parseJSON = A.withObject "FromJSON Assert" $ \o ->
(ExitCodeAssert <$> o A..: "exit_code") <|>
- (StdoutAssert
- <$> o A..: "stdout"
- <*> parsePostProcess o) <|>
- (StderrAssert
- <$> o A..: "stderr"
- <*> parsePostProcess o) <|>
+ (StdoutAssert <$> o A..: "stdout" <*> pp o) <|>
+ (StderrAssert <$> o A..: "stderr" <*> pp o) <|>
(CreatedFileAssert
- <$> o A..: "created_file"
- <*> o A..:? "contents"
- <*> parsePostProcess o) <|>
- (CreatedDirectoryAssert
- <$> o A..: "created_directory")
+ <$> o A..: "created_file" <*> o A..:? "contents" <*> pp o) <|>
+ (CreatedDirectoryAssert <$> o A..: "created_directory")
where
- parsePostProcess o =
- maybe [] A.multipleToList <$> o A..:? "post_process"
+ pp o = maybe [] multipleToList <$> o A..:? "post_process"
describeAssert :: Assert a -> String
describeAssert (ExitCodeAssert _) = "exit_code"
@@ -192,11 +163,14 @@ describeAssert (StderrAssert _ _) = "stderr"
describeAssert (CreatedFileAssert _ _ _) = "created_file"
describeAssert (CreatedDirectoryAssert _) = "created_directory"
-data Verbosity = Debug | Message | Error
- deriving (Eq, Ord)
+--------------------------------------------------------------------------------
+-- | Embarrassingly simple logger.
type Logger = Verbosity -> [String] -> IO ()
+data Verbosity = Debug | Message | Error
+ deriving (Eq, Ord)
+
makeLogger :: Bool -> IO Logger
makeLogger verbose = do
lock <- MVar.newMVar ()
@@ -204,13 +178,13 @@ makeLogger verbose = do
unless (not verbose && verbosity == Debug) $
MVar.withMVar lock $ \() -> mapM_ (IO.hPutStrLn IO.stderr) msgs
+--------------------------------------------------------------------------------
+
+-- | A plain 'Spec' parsed from a JSON file usually gives us one more or
+-- executions of a process. This contains more info than a plain 'Spec'.
data Execution = Execution
- { executionInputFile :: Maybe FilePath
- , executionCommand :: FilePath
- , executionArguments :: [String]
- , executionStdin :: Maybe (A.Multiple String)
- , executionAsserts :: [Assert String]
- , executionEnv :: SpliceEnv
+ { executionSpec :: Spec String
+ , executionInputFile :: Maybe FilePath
, executionSpecPath :: FilePath
, executionSpecName :: String
, executionDirectory :: FilePath
@@ -218,9 +192,8 @@ data Execution = Execution
specExecutions :: FilePath -> Spec String -> IO [Execution]
specExecutions specPath spec = do
- let specBaseName = takeBaseName specPath
- specDirectory = takeDirectory specPath
- specName = dropExtension specBaseName
+ let (specDirectory, specBaseName) = FP.splitFileName specPath
+ specName = FP.dropExtension specBaseName
-- Compute initial environment to get input files.
env0 <- getEnvironment
@@ -228,17 +201,18 @@ specExecutions specPath spec = do
List.nubBy ((==) `on` fst) $
("GOLDPLATE_NAME", specName) :
("GOLDPLATE_FILE", specBaseName) :
- sEnv spec ++ env0
+ ("GOLDPLATE_BASENAME", specBaseName) :
+ specEnv spec ++ env0
-- Get a list of concrete input files (a list maybes).
- concreteInputFiles <- case sInputFiles spec of
+ concreteInputFiles <- case specInputFiles spec of
Nothing -> return [Nothing]
Just glob0 -> do
glob <- hoistEither $ splice env1 glob0
- inputFiles <- withCurrentDirectory specDirectory $ do
+ inputFiles <- Dir.withCurrentDirectory specDirectory $ do
matches <- globCurrentDir glob
length matches `seq` return matches
- return (map (Just . normalise) inputFiles)
+ return (map (Just . FP.normalise) inputFiles)
-- Create an execution for every concrete input.
forM concreteInputFiles $ \mbInputFile -> do
@@ -247,19 +221,16 @@ specExecutions specPath spec = do
Nothing -> env1
Just inputFile ->
("GOLDPLATE_INPUT_FILE", inputFile) :
- ("GOLDPLATE_INPUT_NAME", dropExtension inputFile) :
+ ("GOLDPLATE_INPUT_NAME", FP.dropExtension inputFile) :
+ ("GOLDPLATE_INPUT_BASENAME", snd $ FP.splitFileName inputFile) :
env1
-- Return execution after doing some splicing.
hoistEither $ do
spec' <- traverse (splice env2) spec
pure Execution
- { executionInputFile = mbInputFile
- , executionCommand = sCommand spec'
- , executionArguments = sArguments spec'
- , executionStdin = sStdin spec'
- , executionAsserts = sAsserts spec'
- , executionEnv = env2
+ { executionSpec = spec' {specEnv = env2}
+ , executionInputFile = mbInputFile
, executionSpecPath = specPath
, executionSpecName = specName
, executionDirectory = specDirectory
@@ -275,6 +246,8 @@ executionHeader execution =
Nothing -> ": "
Just fp -> " (" ++ fp ++ "): "
+--------------------------------------------------------------------------------
+
data Env = Env
{ envLogger :: !Logger
, envDiff :: !Bool
@@ -296,11 +269,12 @@ data ExecutionResult = ExecutionResult
runExecution
:: Env -> Execution -> IO ()
runExecution env execution@Execution {..} = do
+ let Spec {..} = executionSpec
envLogger env Debug [executionHeader execution ++ "running..."]
-- Create a "CreateProcess" description.
- let createProcess = (Process.proc executionCommand executionArguments)
- { Process.env = Just executionEnv
+ let createProcess = (Process.proc specCommand specArguments)
+ { Process.env = Just specEnv
, Process.cwd = Just executionDirectory
, Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
@@ -309,16 +283,14 @@ runExecution env execution@Execution {..} = do
-- Actually run the process.
envLogger env Debug [executionHeader execution ++
- executionCommand ++ " " ++ unwords executionArguments]
+ specCommand ++ " " ++ unwords specArguments]
(Just hIn, Just hOut, Just hErr, hProc) <-
Process.createProcess createProcess
- let writeStdin = do
- case executionStdin of
- Nothing -> pure ()
- Just (A.Single str) -> IO.hPutStr hIn str
- Just (A.Multiple strs) -> mapM_ (IO.hPutStrLn hIn) strs
- IO.hClose hIn
+ let writeStdin = (`finally` IO.hClose hIn) $ case specStdin of
+ Nothing -> pure ()
+ Just (Single str) -> IO.hPutStr hIn str
+ Just (Multiple strs) -> mapM_ (IO.hPutStrLn hIn) strs
Async.withAsync writeStdin $ \_ ->
Async.withAsync (B.hGetContents hOut) $ \outAsync ->
Async.withAsync (B.hGetContents hErr) $ \errAsync ->
@@ -341,11 +313,10 @@ runExecution env execution@Execution {..} = do
-- Perform checks.
envLogger env Debug [executionHeader execution ++ "checking assertions..."]
- forM_ executionAsserts $ runAssert env execution executionResult
+ forM_ specAsserts $ runAssert env execution executionResult
envLogger env Debug [executionHeader execution ++ "done"]
-
--- | Check an assertion.
+-- | Check a single assertion.
runAssert :: Env -> Execution -> ExecutionResult -> Assert String -> IO ()
runAssert env execution@Execution {..} ExecutionResult {..} assert =
case assert of
@@ -365,7 +336,7 @@ runAssert env execution@Execution {..} ExecutionResult {..} assert =
CreatedFileAssert {..} -> do
let path = inExecutionDir createdFilePath
- exists <- doesFileExist path
+ exists <- Dir.doesFileExist path
assertTrue exists $ createdFilePath ++ " was not created"
when exists $ do
case createdFileContents of
@@ -375,21 +346,22 @@ runAssert env execution@Execution {..} ExecutionResult {..} assert =
checkAgainstFile
(inExecutionDir expectedPath)
createdFilePostProcess actual
- removeFile path
+ Dir.removeFile path
envLogger env Debug [executionHeader execution ++
"removed " ++ createdFilePath]
CreatedDirectoryAssert {..} -> do
let path = inExecutionDir createdDirectoryPath
- exists <- doesDirectoryExist path
+ exists <- Dir.doesDirectoryExist path
assertTrue exists $ createdDirectoryPath ++ " was not created"
when exists $ do
- removeDirectoryRecursive path
+ Dir.removeDirectoryRecursive path
envLogger env Debug [executionHeader execution ++
"removed " ++ createdDirectoryPath]
where
inExecutionDir :: FilePath -> FilePath
- inExecutionDir fp = if isAbsolute fp then fp else executionDirectory </> fp
+ inExecutionDir fp =
+ if FP.isAbsolute fp then fp else executionDirectory FP.</> fp
checkAgainstFile :: FilePath -> PostProcess -> B.ByteString -> IO ()
checkAgainstFile expectedPath processor actual0 = do
@@ -432,21 +404,22 @@ runAssert env execution@Execution {..} ExecutionResult {..} assert =
describeAssert assert ++ ": " ++ err]
incrementCount (envCountFailures env)
+--------------------------------------------------------------------------------
+
+-- | Read a file if it exists, otherwise pretend it's empty.
readFileOrEmpty :: FilePath -> IO B.ByteString
readFileOrEmpty fp = do
- exists <- doesFileExist fp
+ exists <- Dir.doesFileExist fp
if exists then B.readFile fp else return B.empty
-
-- | Recursively finds all '.goldplate' files in bunch of files or directories.
findSpecs :: [FilePath] -> IO [FilePath]
findSpecs fps = fmap concat $ forM fps $ \fp -> do
- isDir <- doesDirectoryExist fp
+ isDir <- Dir.doesDirectoryExist fp
case isDir of
False -> return [fp]
True -> Glob.globDir1 (Glob.compile "**/*.goldplate") fp
-
-- | Perform a glob match in the current directory.
--
-- This is a drop-in replacement for `glob` from the `Glob` library, which has a
@@ -455,11 +428,13 @@ globCurrentDir :: String -> IO [FilePath]
globCurrentDir pattern =
map dropLeadingDot <$> Glob.globDir1 (Glob.compile pattern) "."
where
- dropLeadingDot fp0 = case break isPathSeparator fp0 of
+ dropLeadingDot fp0 = case break FP.isPathSeparator fp0 of
(".", fp1) -> drop 1 fp1
_ -> fp0
+--------------------------------------------------------------------------------
+-- | Command-line options.
data Options = Options
{ oPaths :: [FilePath]
, oVerbose :: Bool
@@ -469,7 +444,6 @@ data Options = Options
, oJobs :: Int
}
-
parseOptions :: OA.Parser Options
parseOptions = Options
<$> OA.some (OA.strArgument (
@@ -498,6 +472,7 @@ parserInfo = OA.info (OA.helper <*> parseOptions) $
OA.fullDesc <>
OA.header ("goldplate v" <> showVersion version)
+--------------------------------------------------------------------------------
-- | Spawn a worker thread that takes workloads from a shared pool.
worker
@@ -512,6 +487,7 @@ worker pool f = do
Nothing -> return ()
Just workload -> f workload >> worker pool f
+--------------------------------------------------------------------------------
main :: IO ()
main = do
diff --git a/src/Text/Regex/PCRE/Simple.hs b/src/Text/Regex/PCRE/Simple.hs
index 4a2e35c..f1b8d22 100644
--- a/src/Text/Regex/PCRE/Simple.hs
+++ b/src/Text/Regex/PCRE/Simple.hs
@@ -1,3 +1,4 @@
+-- | Very simple wrapper around PCRE. Just kind of exports what we needs.
module Text.Regex.PCRE.Simple
( CompileOptions
, optionUtf8
diff --git a/src/Text/Splice.hs b/src/Text/Splice.hs
new file mode 100644
index 0000000..3b87bf6
--- /dev/null
+++ b/src/Text/Splice.hs
@@ -0,0 +1,40 @@
+module Text.Splice
+ ( SpliceEnv
+ , MissingEnvVar (..)
+ , splice
+ ) where
+
+import Control.Exception (Exception)
+import qualified Data.List as List
+import Data.Typeable (Typeable)
+
+-- | Environment for splicing in things.
+type SpliceEnv = [(String, String)]
+
+data MissingEnvVar = MissingEnvVar String
+ deriving (Typeable)
+
+instance Show MissingEnvVar where
+ show (MissingEnvVar k) = "Missing environment variable: " ++ k
+
+instance Exception MissingEnvVar
+
+-- | Splice in a string with "Hello ${FOO}" syntax.
+splice :: SpliceEnv -> String -> Either MissingEnvVar String
+splice env = go
+ where
+ go str = case break (== '$') str of
+ -- Splice
+ (xs, '$' : '{' : ys) -> case break (== '}') ys of
+ (key, '}' : zs) -> case lookup key env of
+ Nothing -> Left $ MissingEnvVar key
+ Just val -> fmap ((xs ++ val) ++) (go zs)
+ (_, _) -> fmap ((xs ++ "${") ++) (go ys)
+ -- Escape
+ (xs, '$' : '$' : ys) ->
+ let (dollars, zs) = break (== '{') ys in
+ if all (== '$') dollars && "{" `List.isPrefixOf` zs
+ then (xs ++) . (dollars ++) . ("${" ++) <$> go (drop 1 zs)
+ else (xs ++) . ("$$" ++) <$> go ys
+ (xs, []) -> Right xs
+ (xs, (y : ys)) -> (xs ++) . (y :) <$> (go ys)