goldplate 0.1.0 → 0.1.1
raw patch · 7 files changed
+243/−186 lines, 7 files
Files
- CHANGELOG.md +6/−1
- README.md +94/−36
- goldplate.cabal +2/−2
- src/Data/Aeson/Extended.hs +0/−23
- src/Main.hs +100/−124
- src/Text/Regex/PCRE/Simple.hs +1/−0
- src/Text/Splice.hs +40/−0
CHANGELOG.md view
@@ -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.
README.md view
@@ -26,7 +26,7 @@ ## 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,60 +47,101 @@ ## 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. This is why `goldplate` provides a simple way to pull in multiple input files.@@ -113,24 +154,33 @@ ### 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 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 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. If you do this, `goldplate` will remove these files and directories afterwards@@ -168,18 +218,26 @@ 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
goldplate.cabal view
@@ -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 @@ Ghc-options: -Wall -rtsopts -threaded -O2 Other-modules:- Data.Aeson.Extended Text.Regex.PCRE.Simple+ Text.Splice Paths_goldplate Build-depends:
− src/Data/Aeson/Extended.hs
@@ -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]
src/Main.hs view
@@ -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.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----- | Environment for splicing in things.-type SpliceEnv = [(String, String)]+import Text.Splice -data MissingEnvVar = MissingEnvVar String- deriving (Typeable)+-------------------------------------------------------------------------------- -instance Show MissingEnvVar where- show (MissingEnvVar k) = "Missing environment variable: " ++ k+-- | 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) -instance Exception MissingEnvVar+instance A.FromJSON a => A.FromJSON (Multiple a) where+ parseJSON v = (Multiple <$> A.parseJSON v) <|> (Single <$> A.parseJSON v) --- | 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)+multipleToList :: Multiple a -> [a]+multipleToList = F.toList +-------------------------------------------------------------------------------- --- | 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 @@ <*> (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 @@ | 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 @@ 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 @@ 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 (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 @@ 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 @@ 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 @@ 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 @@ 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 @@ Nothing -> ": " Just fp -> " (" ++ fp ++ "): " +--------------------------------------------------------------------------------+ data Env = Env { envLogger :: !Logger , envDiff :: !Bool@@ -296,11 +269,12 @@ 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 @@ -- 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 @@ -- 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 @@ 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 @@ 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 @@ 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 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 @@ , oJobs :: Int } - parseOptions :: OA.Parser Options parseOptions = Options <$> OA.some (OA.strArgument (@@ -498,6 +472,7 @@ OA.fullDesc <> OA.header ("goldplate v" <> showVersion version) +-------------------------------------------------------------------------------- -- | Spawn a worker thread that takes workloads from a shared pool. worker@@ -512,6 +487,7 @@ Nothing -> return () Just workload -> f workload >> worker pool f +-------------------------------------------------------------------------------- main :: IO () main = do
src/Text/Regex/PCRE/Simple.hs view
@@ -1,3 +1,4 @@+-- | Very simple wrapper around PCRE. Just kind of exports what we needs. module Text.Regex.PCRE.Simple ( CompileOptions , optionUtf8
+ src/Text/Splice.hs view
@@ -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)