diff --git a/CHANGELOG.md b/CHANGELOG.md --- 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 --- a/README.md +++ b/README.md @@ -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 diff --git a/goldplate.cabal b/goldplate.cabal --- 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 @@ 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 --- 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 --- 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.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 diff --git a/src/Text/Regex/PCRE/Simple.hs b/src/Text/Regex/PCRE/Simple.hs --- 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 --- /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)