diff --git a/.ghci b/.ghci index c93c997..e3a7f28 100644 --- a/.ghci +++ b/.ghci @@ -1,5 +1,6 @@ :seti -XNoImplicitPrelude :seti -XOverloadedStrings +:seti -XScopedTypeVariables :set -Wall :set -fno-warn-type-defaults diff --git a/.gitignore b/.gitignore index 2ff9982..5bb7e51 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,3 @@ .stack-work/ .#* -etc-spec/.tasty-rerun-log \ No newline at end of file +.tasty-rerun-log \ No newline at end of file diff --git a/.tasty-rerun-log b/.tasty-rerun-log deleted file mode 100644 index 9e33892..0000000 --- a/.tasty-rerun-log +++ /dev/null @@ -1 +0,0 @@ -fromList [(["etc","cli","command","fails when command not given"],Completed True),(["etc","cli","command","when command given","argument input","entry gets validated with a type"],Completed True),(["etc","cli","command","when command given","argument input","entry with required fails when argument not given"],Completed True),(["etc","cli","command","when command given","argument input","entry with required false does not barf"],Completed True),(["etc","cli","command","when command given","argument input","supports same cli input on multiple arguments"],Completed True),(["etc","cli","command","when command given","option input","entry accepts long"],Completed True),(["etc","cli","command","when command given","option input","entry accepts short"],Completed True),(["etc","cli","command","when command given","option input","entry gets validated with a type"],Completed True),(["etc","cli","command","when command given","option input","entry with required fails when option not given"],Completed True),(["etc","cli","command","when command given","option input","entry with required false does not barf"],Completed True),(["etc","cli","plain","argument input","entry gets validated with a type"],Completed True),(["etc","cli","plain","argument input","entry with required fails when argument not given"],Completed True),(["etc","cli","plain","argument input","entry with required false does not barf"],Completed True),(["etc","cli","plain","option input","entry accepts long"],Completed True),(["etc","cli","plain","option input","entry accepts short"],Completed True),(["etc","cli","plain","option input","entry gets validated with a type"],Completed True),(["etc","cli","plain","option input","entry with required fails when option not given"],Completed True),(["etc","cli","plain","option input","entry with required false does not barf"],Completed True),(["etc","default","default can be raw JSON value on entries spec"],Completed True),(["etc","default","default is used when defined on spec"],Completed True),(["etc","env","does not add entries to config if env var is not present"],Completed True),(["etc","env","env entry is present when env var is defined"],Completed True),(["etc","env","has precedence over default and file values"],Completed True),(["etc","file","does not fail if file doesn't exist"],Completed True),(["etc","file","does not support any other file extension"],Completed True),(["etc","file","supports json, yaml and yml extensions"],Completed True),(["etc","spec","cli","cli entry accepts command"],Completed True),(["etc","spec","cli","cli entry does not accept unrecognized keys"],Completed True),(["etc","spec","cli","cli entry settings requires an input"],Completed True),(["etc","spec","cli","cli option entry requires either short or long"],Completed True),(["etc","spec","cli","cli option entry works when setting long and type"],Completed True),(["etc","spec","cli","cli option entry works when setting short and type"],Completed True),(["etc","spec","env","env key creates an ENV source"],Completed True),(["etc","spec","general","does not fail when etc/entries is not defined"],Completed True),(["etc","spec","general","entries can have many levels of nesting"],Completed True),(["etc","spec","general","entries cannot finish in an array"],Completed True),(["etc","spec","general","entries cannot finish in an empty map"],Completed True),(["etc","spec","general","entries that finish with raw values sets them as default value"],Completed True),(["etc","spec","general","spec map cannot be a JSON array"],Completed True),(["etc","spec","general","spec map cannot be a JSON bool"],Completed True),(["etc","spec","general","spec map cannot be a JSON number"],Completed True),(["etc","spec","general","spec map cannot be a JSON string"],Completed True),(["etc","spec","general","spec map cannot be empty object"],Completed True),(["etc","spec","general","spec map cannot have any other key that is not etc/spec"],Completed True),(["etc","spec","yaml parser","should work with Aeson instances"],Completed True)] \ No newline at end of file diff --git a/Makefile b/Makefile index 64a38bd..2a1fac6 100644 --- a/Makefile +++ b/Makefile @@ -5,7 +5,7 @@ help: ## Display this message .DEFAULT_GOAL := help TEST_RESOLVER ?= lts-8 -TEST:=stack build --resolver $(TEST_RESOLVER) --install-ghc --test --haddock --no-haddock-deps --pedantic --flag etc:yaml --flag etc:cli --flag etc:printer +TEST:=stack build --resolver $(TEST_RESOLVER) --install-ghc --test --haddock --no-haddock-deps --pedantic --flag etc:yaml --flag etc:cli --flag etc:extra test: ## Execute test suite with all compiler flags $(TEST) etc:etc-testsuite .PHONY: test diff --git a/README.md b/README.md index ebe8e2e..bb6de23 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,7 @@ these values are to be found and located in a configuration map. * [Reading From Pure Sources](#reading-from-pure-sources) * [Accessing configuration values](#accessing-configuration-values) * [Printing your configuration values](#printing-your-configuration-values) +* [Reporting Misspellings on Environment Variables](#reporting-misspellings-on-environment-variables) * [Cabal Flags](#cabal-flags) * [Full Example](#full-example) @@ -464,6 +465,48 @@ program. You an use the `System.Etc.printPrettyConfig` function to render the configuration map and the different values/sources that were resolved when calculating it. This function is _really_ useful for debugging purposes. +### Example + +Here is the output of one of +the +[example applications](https://github.com/roman/Haskell-etc/tree/master/etc-command-example): + +```bash +$ MY_APP_USERNAME=foo etc-command-example run -u bar -p 123 +Executing main program +credentials.username + bar [ Cli ] + foo [ Env: MY_APP_USERNAME ] + root [ Default ] + +credentials.password + 123 [ Cli ] +``` + +The output displays all the configuration values and their sources, the first +value on the list is the value that `System.Etc.getConfigValue` returns for that +particular key. + +## Report Misspellings on Environment Variables + +When you define `env` keys on the `etc/entries` map of your spec file, we can +infer what are the valid Environment Variables that need to be defined for your +application, knowing this, `etc` can infer when there is a typo on one of this +environment variables and report this. You need to have the `extra` cabal flag and +call the `System.Etc.reportEnvMisspellingWarnings` with the configuration spec as +as an argument. + +### Example + +Here is an example of the output this function prints to `stderr` when the given +Environment Variables are almost identical to the ones found on the spec file: + +```bash +$ MY_AP_USERNAME=foo etc-command-example run -u bar -p 123 + +WARNING: Environment variable `MY_AP_USERNAME' found, perhaps you meant `MY_APP_USERNAME' + +``` ## Cabal Flags @@ -475,8 +518,8 @@ the exact bits of functionality you need for your application. - `cli`: Provides the CLI functionality explained in this README -- `printer`: Provides helper functions for printing the resolved configuration map - with all its entries + sources +- `extra`: Provides helper functions for inspecting the resolved configuration + as well as providing warning messages for misspelled environment variables ## Full Example @@ -537,6 +580,8 @@ getConfiguration :: IO (Cmd, Etc.Config) getConfiguration = do spec <- Etc.readConfigSpec "./path/to/spec.yaml" + Etc.reportEnvMisspellingWarnings spec + let defaultConfig = Etc.resolveDefault spec diff --git a/etc-command-example/src/Main.hs b/etc-command-example/src/Main.hs index 5a648f2..0727f2c 100644 --- a/etc-command-example/src/Main.hs +++ b/etc-command-example/src/Main.hs @@ -54,6 +54,8 @@ main = do specPath <- getDataFileName "spec.yaml" configSpec <- Etc.readConfigSpec (Text.pack specPath) + Etc.reportEnvMisspellingWarnings configSpec + (configFiles, _fileWarnings) <- Etc.resolveFiles configSpec (cmd, configCli) <- Etc.resolveCommandCli configSpec configEnv <- Etc.resolveEnv configSpec diff --git a/etc-plain-example/src/Main.hs b/etc-plain-example/src/Main.hs index 7422705..f906ae1 100644 --- a/etc-plain-example/src/Main.hs +++ b/etc-plain-example/src/Main.hs @@ -18,6 +18,8 @@ main = do specPath <- getDataFileName "spec.yaml" configSpec <- Etc.readConfigSpec (Text.pack specPath) + Etc.reportEnvMisspellingWarnings configSpec + (configFiles, _fileWarnings) <- Etc.resolveFiles configSpec configEnv <- Etc.resolveEnv configSpec configOptParser <- Etc.resolvePlainCli configSpec diff --git a/etc/etc.cabal b/etc/etc.cabal index 542906c..cf16b69 100644 --- a/etc/etc.cabal +++ b/etc/etc.cabal @@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: etc -version: 0.0.0.1 +version: 0.0.0.2 synopsis: Declarative configuration spec for Haskell projects description: Please see README.md category: Configuration, System @@ -30,8 +30,8 @@ source-repository head type: git location: https://github.com/roman/Haskell-etc -flag printer - description: Include support for config printer +flag extra + description: Include extra utilities manual: False default: False @@ -78,12 +78,15 @@ library default-language: Haskell2010 - if flag(printer) - cpp-options: -DWITH_PRINTER + if flag(extra) + cpp-options: -DWITH_EXTRA build-depends: - ansi-wl-pprint >=0.6 && <0.7 + ansi-wl-pprint >=0.6 && <0.7, + edit-distance >=0.2 && <0.3 + exposed-modules: - System.Etc.Internal.Printer + System.Etc.Internal.Extra.Printer + System.Etc.Internal.Extra.EnvMisspell if flag(cli) cpp-options: -DWITH_CLI @@ -130,6 +133,10 @@ test-suite etc-testsuite cpp-options: -DWITH_YAML build-depends: yaml >=0.8 && <0.9 + if flag(extra) + cpp-options: -DWITH_EXTRA + build-depends: + edit-distance >=0.2 && <0.3 other-modules: Paths_etc System.Etc.Resolver.CliTest @@ -138,5 +145,6 @@ test-suite etc-testsuite System.Etc.Resolver.DefaultTest System.Etc.Resolver.EnvTest System.Etc.Resolver.FileTest + System.Etc.Extra.EnvMisspellTest System.Etc.SpecTest default-language: Haskell2010 diff --git a/etc/src/System/Etc.hs b/etc/src/System/Etc.hs index 3de716d..beda31e 100644 --- a/etc/src/System/Etc.hs +++ b/etc/src/System/Etc.hs @@ -43,12 +43,19 @@ module System.Etc ( , CliConfigError(..) #endif -#ifdef WITH_PRINTER - -- * Printer - -- $printer +#ifdef WITH_EXTRA + -- * Extra utilities + -- $extra , renderConfig , printPrettyConfig , hPrintPrettyConfig + + , EnvMisspell(..) + , getEnvMisspellings + , getEnvMisspellingsPure + , renderEnvMisspellings + , hPrintEnvMisspellings + , reportEnvMisspellingWarnings #endif ) where @@ -63,8 +70,17 @@ import System.Etc.Internal.Resolver.Cli.Common (CliConfigError (..), getErrorMe import System.Etc.Internal.Resolver.Cli.Plain (resolvePlainCli, resolvePlainCliPure) #endif -#ifdef WITH_PRINTER -import System.Etc.Internal.Printer (hPrintPrettyConfig, printPrettyConfig, renderConfig) +#ifdef WITH_EXTRA +import System.Etc.Internal.Extra.EnvMisspell + ( EnvMisspell (..) + , getEnvMisspellings + , getEnvMisspellingsPure + , hPrintEnvMisspellings + , renderEnvMisspellings + , reportEnvMisspellingWarnings + ) +import System.Etc.Internal.Extra.Printer + (hPrintPrettyConfig, printPrettyConfig, renderConfig) #endif import System.Etc.Internal.Config @@ -93,8 +109,7 @@ import System.Etc.Internal.Resolver.File (resolveFiles) together using the mappend function -} -{- $printer +{- $extra - Use these function to render the configuration map and understand how the - resolving was performed. + Some extra utilities that are great for debugging (miss)-configurations. -} diff --git a/etc/src/System/Etc/Internal/Extra/EnvMisspell.hs b/etc/src/System/Etc/Internal/Extra/EnvMisspell.hs new file mode 100644 index 0000000..32bb028 --- /dev/null +++ b/etc/src/System/Etc/Internal/Extra/EnvMisspell.hs @@ -0,0 +1,105 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +module System.Etc.Internal.Extra.EnvMisspell ( + EnvMisspell (..) + , getEnvMisspellings + , getEnvMisspellingsPure + , renderEnvMisspellings + , hPrintEnvMisspellings + , reportEnvMisspellingWarnings + ) where + +import Protolude hiding ((<$>), (<>)) + +import Data.Vector (Vector) +import System.Environment (getEnvironment) + +import qualified Data.HashMap.Strict as HashMap +import qualified Data.Text as Text +import qualified Data.Vector as Vector +import qualified Text.EditDistance as Distance + +import System.Etc.Internal.Spec.Types +import Text.PrettyPrint.ANSI.Leijen + +data EnvMisspell + = EnvMisspell { + currentText :: Text + , suggestionText :: Text + } + deriving (Show, Eq, Generic) + +lookupSpecEnvKeys :: ConfigSpec a -> Vector Text +lookupSpecEnvKeys spec = + let + foldEnvSettings val acc = + case val of + ConfigValue _ sources -> + maybe acc (`Vector.cons` acc) (envVar sources) + SubConfig hsh -> + HashMap.foldr foldEnvSettings acc hsh + in + foldEnvSettings (SubConfig $ specConfigValues spec) Vector.empty + +{-| + +-} +getEnvMisspellingsPure :: ConfigSpec a -> Vector Text -> Vector EnvMisspell +getEnvMisspellingsPure spec env = do + specEnvName <- lookupSpecEnvKeys spec + currentEnvName <- env + + let + distance = + Distance.levenshteinDistance + Distance.defaultEditCosts + (Text.unpack specEnvName) + (Text.unpack currentEnvName) + + guard (distance >= 1 && distance < 4) + return $ EnvMisspell currentEnvName specEnvName + +{-| + +-} +getEnvMisspellings :: ConfigSpec a -> IO (Vector EnvMisspell) +getEnvMisspellings spec = + getEnvironment + & fmap (Vector.fromList . map (Text.pack . fst)) + & fmap (getEnvMisspellingsPure spec) + +{-| + +-} +renderEnvMisspellings :: Vector EnvMisspell -> Doc +renderEnvMisspellings misspells + | Vector.null misspells = + mempty + | otherwise = + misspells + & Vector.map + (\misspell -> + text "WARNING: Environment variable `" + <> text (Text.unpack $ currentText misspell) + <> text "' found, perhaps you meant `" + <> text (Text.unpack $ suggestionText misspell) + <> text "'") + & Vector.foldl' (<$>) mempty + & (<$> mempty) + & (<$> mempty) + +{-| + +-} +hPrintEnvMisspellings :: Handle -> Vector EnvMisspell -> IO () +hPrintEnvMisspellings h = + hPutDoc h . renderEnvMisspellings + +{-| + +-} +reportEnvMisspellingWarnings :: ConfigSpec a -> IO () +reportEnvMisspellingWarnings spec = + getEnvMisspellings spec >>= + hPrintEnvMisspellings stderr diff --git a/etc/src/System/Etc/Internal/Printer.hs b/etc/src/System/Etc/Internal/Extra/Printer.hs similarity index 98% rename from etc/src/System/Etc/Internal/Printer.hs rename to etc/src/System/Etc/Internal/Extra/Printer.hs index 7f6dba3..34d45c9 100644 --- a/etc/src/System/Etc/Internal/Printer.hs +++ b/etc/src/System/Etc/Internal/Extra/Printer.hs @@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-deprecations #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module System.Etc.Internal.Printer ( +module System.Etc.Internal.Extra.Printer ( renderConfig , printPrettyConfig , hPrintPrettyConfig diff --git a/etc/test/System/Etc/Extra/EnvMisspellTest.hs b/etc/test/System/Etc/Extra/EnvMisspellTest.hs new file mode 100644 index 0000000..0843568 --- /dev/null +++ b/etc/test/System/Etc/Extra/EnvMisspellTest.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module System.Etc.Extra.EnvMisspellTest where + +import Protolude + +import Test.Tasty (TestTree, testGroup) +import Test.Tasty.HUnit (assertBool, assertEqual, testCase) + +import qualified Data.Vector as Vector + +import System.Etc + +tests :: TestTree +tests = + testGroup "env misspells" + [ + testCase "it warns when misspell is present" $ do + let + input = + mconcat + [ + "{\"etc/entries\": {" + , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}" + ] + + (spec :: ConfigSpec ()) <- parseConfigSpec input + + let + result = + getEnvMisspellingsPure spec ["GREEING"] + + assertBool "expecting to get a warning for typo" + (not $ Vector.null result) + + assertEqual "expecting to get typo for key GREETING" + (EnvMisspell "GREEING" "GREETING") + (Vector.head result) + ] diff --git a/etc/test/TestSuite.hs b/etc/test/TestSuite.hs index cbd1599..ae36f79 100644 --- a/etc/test/TestSuite.hs +++ b/etc/test/TestSuite.hs @@ -18,6 +18,10 @@ import qualified System.Etc.SpecTest import qualified System.Etc.Resolver.CliTest #endif +#ifdef WITH_EXTRA +import qualified System.Etc.Extra.EnvMisspellTest +#endif + main :: IO () main = defaultMainWithIngredients @@ -29,4 +33,8 @@ main = #ifdef WITH_CLI , System.Etc.Resolver.CliTest.tests #endif + +#ifdef WITH_EXTRA + , System.Etc.Extra.EnvMisspellTest.tests +#endif ]) diff --git a/stack.yaml b/stack.yaml index e0c06d4..2b8dc6e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -46,7 +46,7 @@ extra-deps: [] # Override default flag values for local packages and extra-deps flags: etc: - printer: true + extra: true cli: true yaml: true