packages feed

etc (empty) → 0.0.0.0

raw patch · 31 files changed

+3479/−0 lines, 31 filesdep +aesondep +ansi-wl-pprintdep +base

Dependencies added: aeson, ansi-wl-pprint, base, bytestring, containers, directory, etc, exceptions, hashable, optparse-applicative, protolude, tasty, tasty-hunit, tasty-rerun, text, unordered-containers, vector, yaml

Files

+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2017 Roman Gonzalez++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,8 @@+# etc++`etc` gathers configuration values from multiple sources (cli options, OS+environment variables, files) using a declarative spec file that defines where+this values are to be found and located in a configuration map.++For more information about `etc` API and how to use it, see+the [`etc` homepage](https://github.com/roman/Haskell-etc)
+ etc.cabal view
@@ -0,0 +1,140 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           etc+version:        0.0.0.0+synopsis:       Declarative configuration spec for Haskell projects+description:    Please see README.md+category:       Configuration, System+homepage:       https://github.com/roman/Haskell-etc+author:         Roman Gonzalez+maintainer:     romanandreg@gmail.com+copyright:      2017 Roman Gonzalez+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+data-files:+    test/fixtures/config.foo+    test/fixtures/config.json+    test/fixtures/config.spec.yaml+    test/fixtures/config.yaml+    test/fixtures/config.yml+extra-source-files:+  README.md++source-repository head+  type: git+  location: https://github.com/roman/Haskell-etc++flag printer+  description: Include support for config printer+  manual: False+  default: False++flag cli+  description: Include support for cli arguments+  manual: False+  default: False++flag yaml+  description: Include support to parse YAML files+  manual: False+  default: False++library+  hs-source-dirs: src+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , aeson >=1.0 && <1.1+    , bytestring >=0.10 && <0.11+    , containers >=0.5 && <0.6+    , text >=1.2 && <1.3+    , protolude >=0.1 && <0.2+    , unordered-containers >=0.2 && <0.3+    , directory >=1.3 && <1.4+    , exceptions >=0.8 && <0.9+    , hashable >=1.2 && <1.3+    , vector >=0.11 && <0.12+++  exposed-modules:+      System.Etc+      System.Etc.Spec+      System.Etc.Internal.Config+      System.Etc.Internal.Spec.JSON+      System.Etc.Internal.Spec.Types+      System.Etc.Internal.Types+      System.Etc.Internal.Resolver.Default+      System.Etc.Internal.Resolver.File+      System.Etc.Internal.Resolver.Env++  other-modules:+      Paths_etc++  default-language: Haskell2010++  if flag(printer)+    cpp-options: -DWITH_PRINTER+    build-depends:+      ansi-wl-pprint >=0.6 && <0.7+    exposed-modules:+      System.Etc.Internal.Printer++  if flag(cli)+    cpp-options: -DWITH_CLI+    build-depends:+      optparse-applicative >=0.13 && <0.14+    exposed-modules:+      System.Etc.Internal.Resolver.Cli+      System.Etc.Internal.Resolver.Cli.Common+      System.Etc.Internal.Resolver.Cli.Plain+      System.Etc.Internal.Resolver.Cli.Command++  if flag(yaml)+    cpp-options: -DWITH_YAML+    build-depends:+      yaml >=0.8 && <0.9+    exposed-modules:+      System.Etc.Internal.Spec.YAML++test-suite etc-testsuite+  type: exitcode-stdio-1.0+  main-is: TestSuite.hs+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base >=4.7 && <5+    , aeson >=1.0 && <1.1+    , bytestring >=0.10 && <0.11+    , containers >=0.5 && <0.6+    , text >=1.2 && <1.3+    , protolude >=0.1 && <0.2+    , unordered-containers >=0.2 && <0.3+    , vector >=0.11 && <0.12+    , tasty >=0.11 && <0.12+    , tasty-hunit >=0.9 && <0.10+    , tasty-rerun >=1.1 && <1.2+    , etc++  if flag(cli)+    cpp-options: -DWITH_CLI+    build-depends:+      optparse-applicative >=0.13 && <0.14+  if flag(yaml)+    cpp-options: -DWITH_YAML+    build-depends:+      yaml >=0.8 && <0.9+  other-modules:+      Paths_etc+      System.Etc.Resolver.CliTest+      System.Etc.Resolver.Cli.CommandTest+      System.Etc.Resolver.Cli.PlainTest+      System.Etc.Resolver.DefaultTest+      System.Etc.Resolver.EnvTest+      System.Etc.Resolver.FileTest+      System.Etc.SpecTest+  default-language: Haskell2010
+ src/System/Etc.hs view
@@ -0,0 +1,100 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++{-|++-}++module System.Etc (+  -- * Config+  -- $config+    Config+  , getConfigValue+  , getConfigValueWith+  , getSelectedConfigSource+  , getAllConfigSources++  -- * ConfigSpec+  -- $config_spec+  , ConfigSource (..)+  , ConfigValue+  , ConfigSpec+  , ConfigurationError (..)+  , parseConfigSpec+  , readConfigSpec++  -- ** Resolvers+  -- $resolvers+  , resolveDefault+  , resolveFiles+  , resolveEnvPure+  , resolveEnv++#ifdef WITH_CLI++  , resolvePlainCliPure+  , resolveCommandCliPure+  , resolvePlainCli+  , resolveCommandCli++  -- ** CLI Resolver Error type+  , getErrorMessage+  , CliConfigError(..)+#endif++#ifdef WITH_PRINTER+  -- * Printer+  -- $printer+  , renderConfig+  , printPrettyConfig+  , hPrintPrettyConfig+#endif+  ) where++import System.Etc.Internal.Resolver.Default (resolveDefault)+import System.Etc.Internal.Types            (Config, ConfigSource (..), ConfigValue)+import System.Etc.Spec+    (ConfigSpec, ConfigurationError (..), parseConfigSpec, readConfigSpec)++#ifdef WITH_CLI+import System.Etc.Internal.Resolver.Cli.Command (resolveCommandCli, resolveCommandCliPure)+import System.Etc.Internal.Resolver.Cli.Common  (CliConfigError (..), getErrorMessage)+import System.Etc.Internal.Resolver.Cli.Plain   (resolvePlainCli, resolvePlainCliPure)+#endif++#ifdef WITH_PRINTER+import System.Etc.Internal.Printer (hPrintPrettyConfig, printPrettyConfig, renderConfig)+#endif++import System.Etc.Internal.Config+    (getAllConfigSources, getConfigValue, getConfigValueWith, getSelectedConfigSource)+import System.Etc.Internal.Resolver.Env  (resolveEnv, resolveEnvPure)+import System.Etc.Internal.Resolver.File (resolveFiles)++{- $config++   Use this functions to fetch values from the Etc.Config and cast them to types+   that make sense in your program+-}++{- $config_spec++   Use this functions to read the configuration spec. Remember you can+   use JSON or YAML(*) filepaths++   * The yaml cabal flag must be used to support yaml syntax+-}++{- $resolvers++   Use this functions to gather configuration values from different sources+   (environment variables, command lines or files). Then compose results+   together using the mappend function+-}++{- $printer++   Use these function to render the configuration map and understand how the+   resolving was performed.+-}
+ src/System/Etc/Internal/Config.hs view
@@ -0,0 +1,152 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Config where++import Protolude++import Control.Monad.Catch (MonadThrow (..))++import qualified Data.Aeson          as JSON+import qualified Data.Aeson.Internal as JSON (IResult (..), formatError, iparse)+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set            as Set+import qualified Data.Text           as Text++import System.Etc.Internal.Types++--------------------------------------------------------------------------------++configValueToJsonObject :: ConfigValue -> JSON.Value+configValueToJsonObject configValue =+  case configValue of+    ConfigValue sources ->+      case Set.maxView sources of+        Nothing ->+          undefined++        Just (source, _) ->+          value source++    SubConfig configm ->+      configm+      & HashMap.foldrWithKey+          (\key innerConfigValue acc ->+              HashMap.insert key (configValueToJsonObject innerConfigValue) acc)+          HashMap.empty+      & JSON.Object++-- Can't add signature given JSON.Parser is not exposed ¯\_(ツ)_/¯+-- getConfigValueWith+--   :: MonadThrow m+--   => (JSON.Value -> JSON.Parser value)+--   -> [Text]+--   -> Config+--   -> m value+getConfigValueWith parser keys0 (Config configValue0) =+  let+    loop keys configValue =+      case (keys, configValue) of+        ([], ConfigValue sources) ->+          case Set.maxView sources of+            Nothing ->+              throwM $ InvalidConfigKeyPath keys0++            Just (None, _) ->+              throwM $ InvalidConfigKeyPath keys0++            Just (source, _) ->+              case JSON.iparse parser (value source) of+                JSON.IError path err ->+                  JSON.formatError path err+                  & Text.pack+                  & InvalidConfiguration+                  & throwM++                JSON.ISuccess result ->+                  return result++        ([], innerConfigValue) ->+          case JSON.iparse parser (configValueToJsonObject innerConfigValue) of+            JSON.IError path err ->+              JSON.formatError path err+              & Text.pack+              & InvalidConfiguration+              & throwM++            JSON.ISuccess result ->+              return result++        (k:keys1, SubConfig configm) ->+          case HashMap.lookup k configm of+            Nothing ->+              throwM $ InvalidConfigKeyPath keys0+            Just configValue1 ->+              loop keys1 configValue1++        _ ->+          throwM $ InvalidConfigKeyPath keys0+  in+    loop keys0 configValue0++getSelectedConfigSource+  :: (MonadThrow m)+  => [Text]+  -> Config+  -> m ConfigSource+getSelectedConfigSource keys0 (Config configValue0) =+  let+    loop keys configValue =+      case (keys, configValue) of+        ([], ConfigValue sources) ->+          case Set.maxView sources of+            Nothing ->+              throwM $ InvalidConfigKeyPath keys0++            Just (source, _) ->+              return source++        (k:keys1, SubConfig configm) ->+          case HashMap.lookup k configm of+            Nothing ->+              throwM $ InvalidConfigKeyPath keys0+            Just configValue1 ->+              loop keys1 configValue1++        _ ->+          throwM $ InvalidConfigKeyPath keys0+  in+    loop keys0 configValue0+++getAllConfigSources+  :: (MonadThrow m)+  => [Text]+  -> Config+  -> m (Set ConfigSource)+getAllConfigSources keys0 (Config configValue0) =+  let+    loop keys configValue =+      case (keys, configValue) of+        ([], ConfigValue sources) ->+          return sources++        (k:keys1, SubConfig configm) ->+          case HashMap.lookup k configm of+            Nothing ->+              throwM $ InvalidConfigKeyPath keys0+            Just configValue1 ->+              loop keys1 configValue1++        _ ->+          throwM $ InvalidConfigKeyPath keys0+  in+    loop keys0 configValue0++getConfigValue+  :: (MonadThrow m, JSON.FromJSON result)+  => [Text]+  -> Config+  -> m result+getConfigValue =+  getConfigValueWith JSON.parseJSON
+ src/System/Etc/Internal/Printer.hs view
@@ -0,0 +1,145 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Printer (+    renderConfig+  , printPrettyConfig+  , hPrintPrettyConfig+  ) where++import Protolude hiding ((<>))++import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set            as Set+import qualified Data.Text           as Text++import Text.PrettyPrint.ANSI.Leijen++import System.Etc.Internal.Spec.Types (ConfigurationError (..))+import System.Etc.Internal.Types++renderJsonValue :: JSON.Value -> (Doc, Int)+renderJsonValue value' =+  case value' of+    JSON.String str ->+      (text $ Text.unpack str, Text.length str)++    JSON.Number scientific ->+      let+        number =+          show scientific+      in+        (text number, length number)+    JSON.Bool bool' ->+      if bool' then+        (text "true", 5)+      else+        (text "false", 5)+    _ ->+      value'+      & show+      & ("Invalid configuration value creation " `mappend`)+      & InvalidConfiguration+      & show+      & error+++renderConfig :: Config -> Doc+renderConfig (Config configValue0) =+  let+    brackets' = enclose (lbracket <> space) (space <> rbracket)++    renderSource :: ConfigSource -> ((Doc, Int), Doc)+    renderSource source' =+      case source' of+        Default value' ->+          ( renderJsonValue value'+          , brackets' (fill 10 (text "Default"))+          )++        File _index filepath' value' ->+          ( renderJsonValue value'+          , brackets' (fill 10 (text "File:" <+> text (Text.unpack filepath')))+          )++        Env varname value' ->+          ( renderJsonValue value'+          , brackets' (fill 10 (text "Env:" <+> text (Text.unpack varname)))+          )++        Cli value' ->+          ( renderJsonValue value'+          , brackets' (fill 10 (text "Cli"))+          )++        None ->+          ( (mempty, 0)+          , mempty+          )++    renderSources :: [ConfigSource] -> Doc+    renderSources sources0 =+      let+        sources@(((selValueDoc, _), selSourceDoc):others) =+          map renderSource sources0++        fillingWidth =+          sources+          & map (snd . fst)+          & maximum+          & max 10++        selectedValue =+          [ green $ fill fillingWidth selValueDoc <+> selSourceDoc ]++        otherValues =+          map (\((valueDoc, _), sourceDoc) ->+                  fill fillingWidth valueDoc <+> sourceDoc)+              others+      in+        selectedValue+        & flip mappend otherValues+        & vcat+        & indent 2++    configEntryRenderer :: [Text] -> [Doc] -> Text -> ConfigValue -> [Doc]+    configEntryRenderer keys resultDoc configKey configValue =+      resultDoc `mappend` loop (configKey : keys) configValue++    loop keys configValue =+      case configValue of+        SubConfig subConfigm ->+          HashMap.foldlWithKey'+            (configEntryRenderer keys)+            mempty+            subConfigm++        ConfigValue sources0 ->+          let+            configKey =+              keys+              & reverse+              & Text.intercalate "."++            sources =+              Set.toDescList sources0+          in+            if null sources then+              []+            else+              [ blue (text (Text.unpack configKey))+               <$$> renderSources sources ]+  in+    loop [] configValue0+    & intersperse (linebreak <> linebreak)+    & hcat+    & (<> linebreak)++printPrettyConfig :: Config -> IO ()+printPrettyConfig =+  putDoc . renderConfig++hPrintPrettyConfig :: Handle -> Config -> IO ()+hPrintPrettyConfig handle' =+  hPutDoc handle' . renderConfig
+ src/System/Etc/Internal/Resolver/Cli.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Cli+  ( PlainConfigSpec+  -- , resolveCommandCli+  -- , resolveCommandCliPure+  , resolvePlainCli+  , resolvePlainCliPure+  ) where++-- import System.Etc.Internal.Resolver.Cli.Command (resolveCommandCli, resolveCommandCliPure)+import System.Etc.Internal.Resolver.Cli.Plain+    (PlainConfigSpec, resolvePlainCli, resolvePlainCliPure)
+ src/System/Etc/Internal/Resolver/Cli/Command.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Cli.Command (resolveCommandCli, resolveCommandCliPure) where++import Protolude++import Control.Monad.Catch (MonadThrow, throwM)+import Data.Hashable       (Hashable)+import Data.HashMap.Strict (HashMap)+import Data.Maybe          (fromMaybe)+import Data.Vector         (Vector)+import System.Environment  (getArgs, getProgName)++import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text           as Text+import qualified Options.Applicative as Opt++import System.Etc.Internal.Resolver.Cli.Common+import System.Etc.Internal.Types++import qualified System.Etc.Internal.Spec.Types as Spec++--------------------------------------------------------------------------------++entrySpecToJsonCli+  :: (MonadThrow m)+    => Spec.CliEntrySpec cmd+    -> m (Vector cmd, Opt.Parser (Maybe JSON.Value))+entrySpecToJsonCli entrySpec =+  case entrySpec of+    Spec.CmdEntry commandJsonValue specSettings ->+      return ( commandJsonValue+             , settingsToJsonCli specSettings+             )++    Spec.PlainEntry {} ->+      throwM CommandKeyMissing++configValueSpecToCli+  :: (MonadThrow m, Eq cmd, Hashable cmd)+    => HashMap cmd (Opt.Parser ConfigValue)+    -> Text+    -> Spec.ConfigSources cmd+    -> m (HashMap cmd (Opt.Parser ConfigValue))+configValueSpecToCli acc0 specEntryKey sources =+  let+    updateAccConfigOptParser configValueParser accOptParser =+      (\configValue accSubConfig ->+        case accSubConfig of+          ConfigValue {} ->+            accSubConfig++          SubConfig subConfigMap ->+            subConfigMap+              & HashMap.alter (const $ Just configValue) specEntryKey+              & SubConfig)+        <$> configValueParser+        <*> accOptParser+  in+    case Spec.cliEntry sources of+      Nothing ->+        return acc0++      Just entrySpec -> do+        (commands, jsonOptParser) <-+          entrySpecToJsonCli entrySpec++        let+          configValueParser =+            jsonToConfigValue <$> jsonOptParser++        foldM (\acc command ->+                 acc+                   & HashMap.alter+                        (\mAccParser ->+                          mAccParser+                            & fromMaybe (pure $ SubConfig HashMap.empty)+                            & updateAccConfigOptParser configValueParser+                            & Just)+                        command+                   & return)+              acc0+              commands++subConfigSpecToCli+  :: (MonadThrow m, JSON.FromJSON cmd, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => Text+    -> HashMap.HashMap Text (Spec.ConfigValue cmd)+    -> HashMap cmd (Opt.Parser ConfigValue)+    -> m (HashMap cmd (Opt.Parser ConfigValue))+subConfigSpecToCli specEntryKey subConfigSpec acc =+  let+    updateAccConfigOptParser subConfigParser accOptParser =+      (\subConfig accSubConfig ->+          case accSubConfig of+            ConfigValue {} ->+              accSubConfig++            SubConfig subConfigMap ->+              subConfigMap+                & HashMap.alter (const $ Just subConfig) specEntryKey+                & SubConfig)+        <$> subConfigParser+        <*> accOptParser++    addSubParserCommand command subConfigParser =+      HashMap.alter+        (\mAccOptParser ->+           case mAccOptParser of+             Nothing -> do+               commandText <- commandToKey command+               throwM $ UnknownCommandKey (Text.intercalate ", " commandText)++             Just accOptParser ->+               Just+               $ updateAccConfigOptParser subConfigParser accOptParser)+        command++  in do+     parserPerCommand <-+       foldM specToConfigValueCli+             HashMap.empty+             (HashMap.toList subConfigSpec)++     parserPerCommand+       & HashMap.foldrWithKey+                  addSubParserCommand+                  acc+       & return++specToConfigValueCli+  :: (MonadThrow m, JSON.FromJSON cmd, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => HashMap cmd (Opt.Parser ConfigValue)+    -> ( Text, Spec.ConfigValue cmd )+    -> m (HashMap cmd (Opt.Parser ConfigValue))+specToConfigValueCli acc (specEntryKey, specConfigValue) =+  case specConfigValue of+    Spec.ConfigValue _ sources ->+      configValueSpecToCli+        acc+        specEntryKey+        sources++    Spec.SubConfig subConfigSpec ->+      subConfigSpecToCli+        specEntryKey+        subConfigSpec+        acc++configValueCliAccInit+  :: (MonadThrow m, JSON.FromJSON cmd, Eq cmd, Hashable cmd)+    => Spec.ConfigSpec cmd+    -> m (HashMap cmd (Opt.Parser ConfigValue))+configValueCliAccInit spec =+  let+    zeroParser =+      pure $ SubConfig HashMap.empty++    commandsSpec = do+      programSpec <- Spec.specCliProgramSpec spec+      Spec.cliCommands programSpec++  in+    case commandsSpec of+      Nothing ->+        throwM CommandsKeyNotDefined++      Just commands ->+        foldM (\acc (commandVal, _) -> do+                command <- parseCommandJsonValue (JSON.String commandVal)+                return $ HashMap.insert command zeroParser acc)+              HashMap.empty+              (HashMap.toList commands)++joinCommandParsers+  :: (MonadThrow m, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => HashMap cmd (Opt.Parser ConfigValue)+    -> m (Opt.Parser (cmd, Config))+joinCommandParsers parserPerCommand =+  let+    joinParser acc (command, subConfigParser) =+      let+        parser =+          fmap (\subConfig -> (command, Config subConfig))+               subConfigParser+      in do+        commandTexts <- commandToKey command++        let+          commandParsers =+            map (\commandText ->+                    Opt.command (Text.unpack commandText)+                    (Opt.info (Opt.helper <*> parser) Opt.idm))+                commandTexts++        [acc]+          & (++ commandParsers)+          & mconcat+          & return+  in do+    mergedParsers <-+      foldM joinParser Opt.idm (HashMap.toList parserPerCommand)+    return (Opt.subparser mergedParsers)++specToConfigCli+  :: (MonadThrow m, JSON.FromJSON cmd, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => Spec.ConfigSpec cmd+    -> m (Opt.Parser (cmd, Config))+specToConfigCli spec = do+  acc <- configValueCliAccInit spec+  parsers <-+    foldM specToConfigValueCli+          acc+          (HashMap.toList $ Spec.specConfigValues spec)++  joinCommandParsers parsers++{-|++Dynamically generate an OptParser CLI with sub-commands from the spec settings+declared on the @ConfigSpec@. This will process the OptParser from given input+rather than fetching it from the OS.++This will return the selected record parsed from the sub-command input and the+configuration map with keys defined for that sub-command.++-}+resolveCommandCliPure+  :: (MonadThrow m, JSON.FromJSON cmd, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => Spec.ConfigSpec cmd  -- ^ Config Spec (normally parsed from json or yaml file)-- ^ The+    -> Text                 -- ^ Name of the program running the CLI+    -> [Text]               -- ^ Arglist for the program+    -> m (cmd, Config)      -- ^ Selected command and Configuration Map+resolveCommandCliPure configSpec progName args = do+  configParser <- specToConfigCli configSpec++  let+    programModFlags =+      case Spec.specCliProgramSpec configSpec of+           Just programSpec ->+             Opt.fullDesc+              `mappend` (programSpec+                        & Spec.cliProgramDesc+                        & Text.unpack+                        & Opt.progDesc)+              `mappend` (programSpec+                        & Spec.cliProgramHeader+                        & Text.unpack+                        & Opt.header)+           Nothing ->+             mempty++    programParser =+      Opt.info (Opt.helper <*> configParser)+               programModFlags++    programResult =+      args+        & map Text.unpack+        & Opt.execParserPure Opt.defaultPrefs programParser++  programResultToResolverResult progName programResult+++{-|++Dynamically generate an OptParser CLI with sub-commands from the spec settings+declared on the @ConfigSpec@.++Once it generates the CLI and gathers the input, it will return the selected+record parsed from the sub-command input and the configuration map with keys+defined for that sub-command.++-}+resolveCommandCli+  :: (JSON.FromJSON cmd, JSON.ToJSON cmd, Eq cmd, Hashable cmd)+    => Spec.ConfigSpec cmd  -- ^ Config Spec (normally parsed from json or yaml file)+    -> IO (cmd, Config)     -- ^ Selected command and Configuration Map+resolveCommandCli configSpec = do+  progName <- Text.pack <$> getProgName+  args     <- map Text.pack <$> getArgs++  handleCliResult+    $ resolveCommandCliPure configSpec progName args
+ src/System/Etc/Internal/Resolver/Cli/Common.hs view
@@ -0,0 +1,200 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Cli.Common where++import qualified Prelude   as P+import           Protolude++import           Control.Monad.Catch        (MonadThrow, throwM)+import qualified Data.Aeson                 as JSON+import qualified Data.Aeson.Internal        as JSON (IResult (..), iparse)+import qualified Data.ByteString.Lazy.Char8 as BL (unpack)+import qualified Data.Set                   as Set+import qualified Data.Text                  as Text+import qualified Data.Text.IO               as Text+import qualified Data.Vector                as Vector+import qualified Options.Applicative        as Opt++import qualified System.Etc.Internal.Spec.Types as Spec+import           System.Etc.Internal.Types++--------------------------------------------------------------------------------++{-| A wrapper for sub-routines that return an error message; this was+    created for error report purposes.+-}+newtype GetErrorMessage+  = GetErrorMessage {+    -- | Unwrap IO action with error message+    getErrorMessage :: IO Text+  }++instance Show GetErrorMessage where+  show _ = "<<error message>>"++{-| Error when evaluating the ConfigSpec or when executing the OptParser++-}+data CliConfigError+  -- | The type of the Command Key is invalid+  = InvalidCliCommandKey Text+  -- | Trying to use command for an entry without setting commands section+  | CommandsKeyNotDefined+  -- | Trying to use a command that is not defined in commands section+  | UnknownCommandKey Text+  -- | The command setting is missing on a Command Cli+  | CommandKeyMissing+  -- | There is a command setting on a plain Cli+  | CommandKeyOnPlainCli+  -- | The internal OptParser API failed+  | CliEvalExited ExitCode GetErrorMessage+  deriving (Show)++instance Exception CliConfigError++--------------------------------------------------------------------------------++specToCliSwitchFieldMod specSettings =+  maybe Opt.idm+        (Opt.long . Text.unpack)+        (Spec.optLong specSettings)+  `mappend` maybe Opt.idm+                  (Opt.short . Text.head)+                  (Spec.optShort specSettings)+  `mappend` maybe Opt.idm+                  (Opt.help . Text.unpack)+                  (Spec.optHelp specSettings)++specToCliVarFieldMod specSettings =+  specToCliSwitchFieldMod specSettings+  `mappend` maybe Opt.idm+                  (Opt.metavar . Text.unpack)+                  (Spec.optMetavar specSettings)+++commandToKey :: (MonadThrow m, JSON.ToJSON cmd) => cmd -> m [Text]+commandToKey cmd =+  case JSON.toJSON cmd of+    JSON.String commandStr ->+      return [commandStr]+    JSON.Array jsonList ->+      jsonList+        & Vector.toList+        & mapM commandToKey+        & (concat <$>)+    _ ->+      cmd+        & JSON.encode+        & BL.unpack+        & Text.pack+        & InvalidCliCommandKey+        & throwM++settingsToJsonCli+  :: Spec.CliEntryMetadata+    -> Opt.Parser (Maybe JSON.Value)+settingsToJsonCli specSettings =+  let+    requiredCombinator =+        if Spec.optRequired specSettings then+          (Just <$>)+        else+          Opt.optional+  in+    requiredCombinator $+    case specSettings of+      Spec.Opt {} ->+        case Spec.optValueType specSettings of+          Spec.StringOpt ->+            (JSON.String . Text.pack)+            <$> Opt.strOption (specToCliVarFieldMod specSettings)++          Spec.NumberOpt ->+            (JSON.Number . fromInteger)+            <$> Opt.option Opt.auto (specToCliVarFieldMod specSettings)++          Spec.SwitchOpt ->+            JSON.Bool+            <$> Opt.switch (specToCliSwitchFieldMod specSettings)++      Spec.Arg {} ->+        case Spec.argValueType specSettings of+          Spec.StringArg ->+            (JSON.String . Text.pack)+            <$> Opt.strArgument ( specSettings+                                  & Spec.argMetavar+                                  & maybe Opt.idm (Opt.metavar . Text.unpack))+          Spec.NumberArg ->+            (JSON.Number . fromInteger)+            <$> Opt.argument Opt.auto+                             ( specSettings+                                  & Spec.argMetavar+                                  & maybe Opt.idm (Opt.metavar . Text.unpack))++parseCommandJsonValue+  :: (MonadThrow m, JSON.FromJSON a)+    => JSON.Value+    -> m a+parseCommandJsonValue commandValue =+  case JSON.iparse JSON.parseJSON commandValue of+    JSON.IError _path err ->+      throwM (InvalidCliCommandKey $ Text.pack err)++    JSON.ISuccess result ->+      return result++jsonToConfigValue+  :: Maybe JSON.Value+    -> ConfigValue+jsonToConfigValue specEntryDefVal =+  ConfigValue+    $ Set.fromList+    $ maybe [] ((:[]) . Cli) specEntryDefVal++handleCliResult+  :: Either SomeException a -> IO a+handleCliResult result =+  case result of+    Right config ->+      return config++    Left err ->+      case fromException err of+        Just (CliEvalExited ExitSuccess (GetErrorMessage getMsg)) -> do+          getMsg >>= putStrLn+          exitSuccess++        Just (CliEvalExited exitCode (GetErrorMessage getMsg)) -> do+          getMsg >>= Text.hPutStrLn stderr+          exitWith exitCode++        _ ->+          throwIO err++programResultToResolverResult+  :: MonadThrow m+    => Text+    -> Opt.ParserResult a+    -> m a+programResultToResolverResult progName programResult =+  case programResult of+    Opt.Success result ->+      return result++    Opt.Failure failure ->+      let+        (outputMsg, exitCode) =+          Opt.renderFailure failure $ Text.unpack progName+      in+        throwM+        $ CliEvalExited exitCode (GetErrorMessage $ return (Text.pack outputMsg))++    Opt.CompletionInvoked compl ->+      let+        getMsg =+          Text.pack <$> Opt.execCompletion compl (Text.unpack progName)+      in+        throwM+        $ CliEvalExited ExitSuccess (GetErrorMessage getMsg)
+ src/System/Etc/Internal/Resolver/Cli/Plain.hs view
@@ -0,0 +1,219 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Cli.Plain (PlainConfigSpec, resolvePlainCli, resolvePlainCliPure) where++import Protolude++import           Control.Monad.Catch (MonadThrow, throwM)+import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text           as Text+import qualified Options.Applicative as Opt+import           System.Environment  (getArgs, getProgName)++import           System.Etc.Internal.Resolver.Cli.Common+import qualified System.Etc.Internal.Spec.Types          as Spec+import           System.Etc.Internal.Types++--------------------------------------------------------------------------------++type PlainConfigSpec =+  Spec.ConfigSpec ()++--------------------------------------------------------------------------------++entrySpecToConfigValueCli+  :: (MonadThrow m)+    => Spec.CliEntrySpec ()+    -> m (Opt.Parser (Maybe JSON.Value))+entrySpecToConfigValueCli entrySpec =+  case entrySpec of+    Spec.CmdEntry {} ->+      throwM CommandKeyOnPlainCli++    Spec.PlainEntry specSettings ->+      return (settingsToJsonCli specSettings)+++configValueSpecToCli+  :: (MonadThrow m)+    => Text+    -> Spec.ConfigSources ()+    -> Opt.Parser ConfigValue+    -> m (Opt.Parser ConfigValue)+configValueSpecToCli specEntryKey sources acc =+  let+    updateAccConfigOptParser configValueParser accOptParser =+      (\configValue accSubConfig ->+        case accSubConfig of+          ConfigValue {} ->+            accSubConfig++          SubConfig subConfigMap ->+            subConfigMap+              & HashMap.alter (const $ Just configValue) specEntryKey+              & SubConfig)+        <$> configValueParser+        <*> accOptParser+  in+    case Spec.cliEntry sources of+      Nothing ->+        return acc++      Just entrySpec -> do+        jsonOptParser <- entrySpecToConfigValueCli entrySpec++        let+          configValueParser =+            jsonToConfigValue <$> jsonOptParser++        return $ updateAccConfigOptParser configValueParser acc++subConfigSpecToCli+  :: (MonadThrow m)+    => Text+    -> HashMap.HashMap Text (Spec.ConfigValue ())+    -> Opt.Parser ConfigValue+    -> m (Opt.Parser ConfigValue)+subConfigSpecToCli specEntryKey subConfigSpec acc =+  let+    updateAccConfigOptParser subConfigParser accOptParser =+      (\subConfig accSubConfig ->+          case accSubConfig of+            ConfigValue {} ->+              accSubConfig++            SubConfig subConfigMap ->+              subConfigMap+                & HashMap.alter (const $ Just subConfig) specEntryKey+                & SubConfig)+        <$> subConfigParser+        <*> accOptParser+  in do+    configOptParser <-+       foldM specToConfigValueCli+             (pure $ SubConfig HashMap.empty)+             (HashMap.toList subConfigSpec)++    return+      $ updateAccConfigOptParser configOptParser acc++specToConfigValueCli+  :: (MonadThrow m)+    => Opt.Parser ConfigValue+    -> (Text, Spec.ConfigValue ())+    -> m (Opt.Parser ConfigValue)+specToConfigValueCli acc (specEntryKey, specConfigValue) =+  case specConfigValue of+    Spec.ConfigValue _ sources ->+      configValueSpecToCli+        specEntryKey+        sources+        acc++    Spec.SubConfig subConfigSpec ->+      subConfigSpecToCli+        specEntryKey+        subConfigSpec+        acc++configValueCliAccInit+  :: (MonadThrow m)+    => Spec.ConfigSpec ()+    -> m (Opt.Parser ConfigValue)+configValueCliAccInit spec =+  let+    zeroParser =+      pure $ SubConfig HashMap.empty++    commandsSpec = do+      programSpec <- Spec.specCliProgramSpec spec+      Spec.cliCommands programSpec+  in+    case commandsSpec of+      Nothing ->+        return zeroParser++      Just _ ->+        throwM CommandKeyOnPlainCli++specToConfigCli+  :: (MonadThrow m)+    => Spec.ConfigSpec ()+    -> m (Opt.Parser Config)+specToConfigCli spec = do+  acc <- configValueCliAccInit spec+  parser <-+    foldM specToConfigValueCli+          acc+          (HashMap.toList $ Spec.specConfigValues spec)++  parser+    & (Config <$>)+    & return++{-|++Dynamically generate an OptParser CLI from the spec settings declared on the+@ConfigSpec@. This will process the OptParser from given input+rather than fetching it from the OS.++Once it generates the CLI and gathers the input, it will return the+configuration map with keys defined for the program on @ConfigSpec@.++-}+resolvePlainCliPure+  :: MonadThrow m+  => PlainConfigSpec -- ^ Plain ConfigSpec (no sub-commands)+  -> Text            -- ^ Name of the program running the CLI+  -> [Text]          -- ^ Arglist for the program+  -> m Config        -- ^ returns Configuration Map+resolvePlainCliPure configSpec progName args = do+  configParser <- specToConfigCli configSpec++  let+    programModFlags =+      case Spec.specCliProgramSpec configSpec of+           Just programSpec ->+             Opt.fullDesc+              `mappend` (programSpec+                        & Spec.cliProgramDesc+                        & Text.unpack+                        & Opt.progDesc)+              `mappend` (programSpec+                        & Spec.cliProgramHeader+                        & Text.unpack+                        & Opt.header)+           Nothing ->+             mempty++    programParser =+      Opt.info (Opt.helper <*> configParser)+               programModFlags++    programResult =+      args+        & map Text.unpack+        & Opt.execParserPure Opt.defaultPrefs programParser++  programResultToResolverResult progName programResult+++{-|++Dynamically generate an OptParser CLI from the spec settings declared on the+@ConfigSpec@.++Once it generates the CLI and gathers the input, it will return the+configuration map with keys defined for the program on @ConfigSpec@.++-}+resolvePlainCli+  :: PlainConfigSpec  -- ^ Plain ConfigSpec (no sub-commands)+  -> IO Config        -- ^ returns Configuration Map+resolvePlainCli configSpec = do+  progName <- Text.pack <$> getProgName+  args     <- map Text.pack <$> getArgs++  handleCliResult+    $ resolvePlainCliPure configSpec progName args
+ src/System/Etc/Internal/Resolver/Default.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Default (resolveDefault) where++import Protolude++import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set            as Set++import qualified System.Etc.Internal.Spec.Types as Spec+import           System.Etc.Internal.Types++toDefaultConfigValue :: JSON.Value -> ConfigValue+toDefaultConfigValue =+  ConfigValue . Set.singleton . Default++buildDefaultResolver :: Spec.ConfigSpec cmd -> Maybe ConfigValue+buildDefaultResolver spec =+  let+    resolverReducer :: Text -> Spec.ConfigValue cmd -> Maybe ConfigValue -> Maybe ConfigValue+    resolverReducer specKey specValue mConfig =+      case specValue of+        Spec.ConfigValue def _ ->+          let+            mConfigSource =+              toDefaultConfigValue <$> def++            updateConfig =+              writeInSubConfig specKey <$> mConfigSource <*> mConfig+          in+            updateConfig <|> mConfig++        Spec.SubConfig specConfigMap ->+          let+            mSubConfig =+              specConfigMap+              & HashMap.foldrWithKey+                    resolverReducer+                    (Just emptySubConfig)+              & filterMaybe isEmptySubConfig++            updateConfig =+              writeInSubConfig specKey <$> mSubConfig <*> mConfig+          in+            updateConfig <|> mConfig+  in+    Spec.specConfigValues spec+    & HashMap.foldrWithKey+          resolverReducer+          (Just emptySubConfig)+    & filterMaybe isEmptySubConfig++{-|++Gathers all default values from the @etc/spec@ entries inside a @ConfigSpec@++-}+resolveDefault+  :: Spec.ConfigSpec cmd -- ^ ConfigSpec+  -> Config              -- ^ returns Configuration Map with default values included+resolveDefault spec =+  maybe (Config emptySubConfig)+        Config+        (buildDefaultResolver spec)
+ src/System/Etc/Internal/Resolver/Env.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.Env (resolveEnv, resolveEnvPure) where++import Protolude+import System.Environment (getEnvironment)++import           Control.Arrow       ((***))+import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Set            as Set+import qualified Data.Text           as Text++import qualified System.Etc.Internal.Spec.Types as Spec+import           System.Etc.Internal.Types++resolveEnvVarSource+  :: (Text -> Maybe Text)+  -> Spec.ConfigSources cmd+  -> Maybe ConfigSource+resolveEnvVarSource lookupEnv specSources =+  let+    toEnvSource varname envValue =+      envValue+      & JSON.String+      & Env varname+  in do+    varname <- Spec.envVar specSources+    toEnvSource varname <$> lookupEnv varname++buildEnvVarResolver :: (Text -> Maybe Text) -> Spec.ConfigSpec cmd -> Maybe ConfigValue+buildEnvVarResolver lookupEnv spec =+  let+    resolverReducer+      :: Text+      -> Spec.ConfigValue cmd+      -> Maybe ConfigValue+      -> Maybe ConfigValue+    resolverReducer specKey specValue mConfig =+      case specValue of+        Spec.ConfigValue _ sources ->+          let+            updateConfig = do+              envSource <- resolveEnvVarSource lookupEnv sources+              writeInSubConfig specKey (ConfigValue $ Set.singleton envSource) <$> mConfig+          in+            updateConfig <|> mConfig++        Spec.SubConfig specConfigMap ->+          let+            mSubConfig =+              specConfigMap+              & HashMap.foldrWithKey+                   resolverReducer+                   (Just emptySubConfig)+              & filterMaybe isEmptySubConfig++            updateConfig =+              writeInSubConfig specKey <$> mSubConfig <*> mConfig+          in+            updateConfig <|> mConfig+  in+    Spec.specConfigValues spec+    & HashMap.foldrWithKey+          resolverReducer+          (Just emptySubConfig)+    & filterMaybe isEmptySubConfig+{-|++Gathers all OS Environment Variable values (@env@ entries) from the @etc/spec@+entries inside a @ConfigSpec@. This version of the function gathers the input+from a list of tuples rather than the OS.++-}+resolveEnvPure+  :: Spec.ConfigSpec cmd -- ^ ConfigSpec+  -> [(Text, Text)]      -- ^ Environment Variable tuples+  -> Config              -- ^ returns Configuration Map with Environment Variables values filled in+resolveEnvPure spec envMap0 =+  let+    envMap =+      HashMap.fromList envMap0++    lookupEnv key =+      HashMap.lookup key envMap+  in+    maybe (Config emptySubConfig)+          Config+          (buildEnvVarResolver lookupEnv spec)+++{-|++Gathers all OS Environment Variable values (@env@ entries) from the @etc/spec@+entries inside a @ConfigSpec@.++-}+resolveEnv+  :: Spec.ConfigSpec cmd -- ^ Config Spec+  -> IO Config           -- ^ returns Configuration Map with Environment Variables values filled in+resolveEnv spec =+  let+    getEnvironmentTxt =+      map (Text.pack *** Text.pack)+        <$> getEnvironment+  in+    resolveEnvPure spec+      <$> getEnvironmentTxt
+ src/System/Etc/Internal/Resolver/File.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Resolver.File (resolveFiles) where++import Protolude++import Control.Monad.Catch (MonadThrow (..))+import Data.Vector         (Vector)+import System.Directory    (doesFileExist)+++#ifdef WITH_YAML+import qualified Data.Yaml as YAML+#endif++import qualified Data.Aeson                 as JSON+import qualified Data.Aeson.Internal        as JSON (IResult (..), iparse)+import qualified Data.ByteString.Lazy.Char8 as LB8+import qualified Data.HashMap.Strict        as HashMap+import qualified Data.Set                   as Set+import qualified Data.Text                  as Text+import qualified Data.Vector                as Vector++import qualified System.Etc.Internal.Spec.Types as Spec+import           System.Etc.Internal.Types      hiding (filepath)++--------------------------------------------------------------------------------++data ConfigFile+  = JsonFile Text LB8.ByteString+  | YamlFile Text LB8.ByteString+  deriving (Show, Eq)++--------------------------------------------------------------------------------++parseConfigValue+  :: Monad m+  => Int+  -> Text+  -> JSON.Value+  -> m ConfigValue+parseConfigValue fileIndex filepath json =+  case json of+    JSON.Object object ->+      SubConfig+        <$> foldM+              (\acc (key, subconfigValue) -> do+                  value1 <- parseConfigValue fileIndex filepath subconfigValue+                  return $ HashMap.insert key value1 acc)+              HashMap.empty+              (HashMap.toList object)++    _ ->+      return $+        ConfigValue (Set.singleton $ File fileIndex filepath json)+++eitherDecode :: ConfigFile -> Either [Char] JSON.Value+#ifdef WITH_YAML+eitherDecode contents0 =+  case contents0 of+    JsonFile _ contents ->+      JSON.eitherDecode contents+    YamlFile _ contents ->+      YAML.decodeEither (LB8.toStrict contents)+#else+eitherDecode contents0 =+  case contents0 of+    JsonFile _ contents ->+      JSON.eitherDecode contents+    YamlFile filepath _ ->+      Left ("Unsupported yaml file: " <> Text.unpack filepath)+#endif+++parseConfig+  :: MonadThrow m+  => Int+  -> Text+  -> ConfigFile+  -> m Config+parseConfig fileIndex filepath contents =+  case eitherDecode contents of+    Left err ->+      throwM $ InvalidConfiguration (Text.pack err)++    Right json ->+      case JSON.iparse (parseConfigValue fileIndex filepath) json of+        JSON.IError _ err ->+          throwM $ InvalidConfiguration (Text.pack err)++        JSON.ISuccess result ->+          return (Config result)++readConfigFile :: MonadThrow m => Text -> IO (m ConfigFile)+readConfigFile filepath =+  let+    filepathStr = Text.unpack filepath+  in do+    fileExists <- doesFileExist filepathStr+    if fileExists then do+      contents <- LB8.readFile filepathStr+      if ".json" `Text.isSuffixOf` filepath then+        return $ return (JsonFile filepath contents)+      else if (".yaml" `Text.isSuffixOf` filepath) ||+              (".yml" `Text.isSuffixOf` filepath) then+        return $ return (YamlFile filepath contents) else+        return (throwM $ InvalidConfiguration "Unsupported file extension")+    else+      return $ throwM $ ConfigurationFileNotFound filepath++readConfigFromFiles :: [Text] -> IO (Config, [SomeException])+readConfigFromFiles files =+  files+  & zip [1..]+  & mapM (\(fileIndex, filepath) -> do+                 mContents <- readConfigFile filepath+                 return (mContents >>= parseConfig fileIndex filepath))+  & (foldl' (\(result, errs) eCurrent ->+               case eCurrent of+                 Left err ->+                   (result, err:errs)+                 Right current ->+                   (result <> current, errs))+             (mempty, [])+             <$>)++{-|++Gathers configuration values from a list of files specified on the+@etc/filepaths@ entry of a Config Spec. This will return a Configuration Map+with values from all filepaths merged in, and a list of errors in case there was+an error reading one of the filepaths.++-}+resolveFiles+  :: Spec.ConfigSpec cmd -- ^ Config Spec+  -> IO (Config, Vector SomeException) -- ^ Configuration Map with all values from files filled in and a list of warnings+resolveFiles spec = do+  (config, exceptions) <- readConfigFromFiles (Spec.specConfigFilepaths spec)+  return (config, Vector.fromList exceptions)
+ src/System/Etc/Internal/Spec/JSON.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Spec.JSON where++import Protolude++import Control.Monad.Catch (MonadThrow (..))++import qualified Data.Aeson              as JSON+import qualified Data.Text               as Text+import qualified Data.Text.IO            as Text (readFile)+import qualified Data.Text.Lazy          as Text (fromStrict)+import qualified Data.Text.Lazy.Encoding as Text (encodeUtf8)++import System.Etc.Internal.Spec.Types++parseConfigSpec+  :: (MonadThrow m, JSON.FromJSON cmd)+    => Text+    -> m (ConfigSpec cmd)+parseConfigSpec input =+  case JSON.eitherDecode (Text.encodeUtf8 $ Text.fromStrict input) of+    Left err ->+      throwM $ InvalidConfiguration (Text.pack err)++    Right result ->+      return result++readConfigSpec :: JSON.FromJSON cmd => Text -> IO (ConfigSpec cmd)+readConfigSpec filepath = do+  contents <- Text.readFile (Text.unpack filepath)+  parseConfigSpec contents
+ src/System/Etc/Internal/Spec/Types.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE NoImplicitPrelude     #-}+{-# LANGUAGE OverloadedStrings     #-}+module System.Etc.Internal.Spec.Types where++import Prelude   (fail)+import Protolude++import Data.Aeson          ((.:), (.:?))+import Data.HashMap.Strict (HashMap)+import Data.Vector         (Vector)++import qualified Data.Aeson          as JSON+import qualified Data.Aeson.Types    as JSON (Parser, typeMismatch)+import qualified Data.HashMap.Strict as HashMap++--------------------------------------------------------------------------------+-- Error Types++data ConfigurationError+  = InvalidConfiguration Text+  | InvalidConfigKeyPath [Text]+  | ConfigurationFileNotFound Text+  deriving (Show)++instance Exception ConfigurationError++--------------------------------------------------------------------------------++data CliOptValueType+  = StringOpt+  | NumberOpt+  | SwitchOpt+  deriving (Show, Eq)++data CliArgValueType+  = StringArg+  | NumberArg+  deriving (Show, Eq)++data CliEntryMetadata+  = Opt {+    optLong      :: Maybe Text+  , optShort     :: Maybe Text+  , optMetavar   :: Maybe Text+  , optHelp      :: Maybe Text+  , optRequired  :: Bool+  , optValueType :: CliOptValueType+  }+  | Arg {+    argMetavar   :: Maybe Text+  , optRequired  :: Bool+  , argValueType :: CliArgValueType+  }+  deriving (Show, Eq)++data CliEntrySpec cmd+  = CmdEntry {+    cliEntryCmdValue :: Vector cmd+  , cliEntryMetadata :: CliEntryMetadata+  }+  | PlainEntry {+    cliEntryMetadata :: CliEntryMetadata+  }+  deriving (Show, Eq)++data CliCmdSpec+  = CliCmdSpec {+    cliCmdDesc   :: Text+  , cliCmdHeader :: Text+  }+  deriving (Show, Eq)++data ConfigSources cmd+  = ConfigSources {+    envVar   :: Maybe Text+  , cliEntry :: Maybe (CliEntrySpec cmd)+  }+  deriving (Show, Eq)++data ConfigValue cmd+  = ConfigValue {+    defaultValue  :: Maybe JSON.Value+  , configSources :: ConfigSources cmd+  }+  | SubConfig {+    subConfig :: HashMap Text (ConfigValue cmd)+  }+  deriving (Show, Eq)++data CliProgramSpec+  = CliProgramSpec {+    cliProgramDesc   :: Text+  , cliProgramHeader :: Text+  , cliCommands      :: Maybe (HashMap Text CliCmdSpec)+  }+  deriving (Show, Eq)++data ConfigSpec cmd+  = ConfigSpec {+    specConfigFilepaths :: [Text]+  , specCliProgramSpec  :: Maybe CliProgramSpec+  , specConfigValues    :: HashMap Text (ConfigValue cmd)+  }+  deriving (Show, Eq)++--------------------------------------------------------------------------------+-- JSON Parsers++instance JSON.FromJSON CliCmdSpec where+  parseJSON json =+    case json of+      JSON.Object object ->+        CliCmdSpec+        <$> object .: "desc"+        <*> object .: "header"+      _ ->+        JSON.typeMismatch "CliCmdSpec" json++instance JSON.FromJSON CliProgramSpec where+  parseJSON json =+    case json of+      JSON.Object object ->+        CliProgramSpec+        <$> object .: "desc"+        <*> object .: "header"+        <*> object .:? "commands"+      _ ->+        JSON.typeMismatch "CliProgramSpec" json++cliArgTypeParser+  :: JSON.Object+    -> JSON.Parser CliArgValueType+cliArgTypeParser object = do+  value <- object .: "type"+  case value of+    JSON.String typeName+      | typeName == "string" ->+        return StringArg+      | typeName == "number" ->+        return NumberArg+      | otherwise ->+        JSON.typeMismatch "CliArgValueType (string, number)" value+    _ ->+      JSON.typeMismatch "CliArgValueType (string, number)" value++cliArgParser+  :: JSON.Object+    -> JSON.Parser CliEntryMetadata+cliArgParser object =+  Arg+    <$> (object .:? "metavar")+    <*> (fromMaybe True <$> (object .:? "required"))+    <*> cliArgTypeParser object++cliOptTypeParser+  :: JSON.Object+    -> JSON.Parser CliOptValueType+cliOptTypeParser object = do+  mvalue <- object .:? "type"+  case mvalue of+    Just value@(JSON.String typeName)+      | typeName == "string" ->+        return StringOpt+      | typeName == "number" ->+        return NumberOpt+      | typeName == "switch" ->+        return SwitchOpt+      | otherwise ->+        JSON.typeMismatch "CliOptValueType (string, number, switch)" value++    Just value ->+      JSON.typeMismatch "CliOptValueType" value++    Nothing ->+      fail "CLI Option type is required"++cliOptParser+  :: JSON.Object+    -> JSON.Parser CliEntryMetadata+cliOptParser object = do+  long  <- object .:? "long"+  short <- object .:? "short"+  if isNothing long && isNothing short then+    fail "'option' field input requires either 'long' or 'short' settings"+  else+    Opt+      <$> pure long+      <*> pure short+      <*> (object .:? "metavar")+      <*> (object .:? "help")+      <*> (fromMaybe True <$> (object .:? "required"))+      <*> cliOptTypeParser object++cliArgKeys :: [Text]+cliArgKeys = ["input", "commands", "metavar", "required", "type"]++cliOptKeys :: [Text]+cliOptKeys = ["short", "long", "help"] ++ cliArgKeys++instance JSON.FromJSON cmd => JSON.FromJSON (CliEntrySpec cmd) where+  parseJSON json =+      case json of+        JSON.Object object -> do+          cmdValue   <- object .:? "commands"+          value <- object .: "input"++          let+            optParseEntryCtor =+              maybe PlainEntry CmdEntry cmdValue++          case value of+            JSON.String inputName+              | inputName == "option" -> do+                forM_ (HashMap.keys object) $ \key ->+                  when (not (key `elem` cliOptKeys))+                    (fail $ "cli option contains invalid key " ++ show key)++                optParseEntryCtor <$> cliOptParser object++              | inputName == "argument" -> do+                forM_ (HashMap.keys object) $ \key ->+                  when (not (key `elem` cliArgKeys))+                    (fail $ "cli option contains invalid key " ++ show key)++                optParseEntryCtor <$> cliArgParser object++              | otherwise ->+                JSON.typeMismatch "CliEntryMetadata (invalid input)" value+            _ ->+              JSON.typeMismatch "CliEntryMetadata (invalid input)" value+        _ ->+          JSON.typeMismatch "CliEntryMetadata" json++instance JSON.FromJSON cmd => JSON.FromJSON (ConfigValue cmd) where+  parseJSON json  =+    case json of+      JSON.Array _ ->+        fail "Entries cannot have arrays as values"+      JSON.Object object ->+        case HashMap.lookup "etc/spec" object of+          -- normal object+          Nothing -> do+            result <- foldM+                        (\result (key, value) -> do+                            innerValue <- JSON.parseJSON value+                            return $ HashMap.insert key innerValue result)+                        HashMap.empty+                        (HashMap.toList object)+            if HashMap.null result then+              fail "Entries cannot have empty maps as values"+            else+              return (SubConfig result)++          -- etc spec value object+          Just (JSON.Object spec) ->+            if HashMap.size object == 1 then+              ConfigValue+                <$> spec .:? "default"+                <*> (ConfigSources <$> (spec .:? "env")+                                   <*> (spec .:? "cli"))+            else+              fail "etc/spec object can only contain one key"++          -- any other JSON value+          Just _ ->+            fail "etc/spec value must be a JSON object"++      _ ->+        return $+          ConfigValue (Just json) (ConfigSources Nothing Nothing)++instance JSON.FromJSON cmd => JSON.FromJSON (ConfigSpec cmd) where+  parseJSON json  =+    case json of+      JSON.Object object ->+        ConfigSpec+        <$> (fromMaybe [] <$> (object .:?  "etc/filepaths"))+        <*> (object .:? "etc/cli")+        <*> (fromMaybe HashMap.empty <$> (object .:? "etc/entries"))+      _ ->+        JSON.typeMismatch "ConfigSpec" json
+ src/System/Etc/Internal/Spec/YAML.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module System.Etc.Internal.Spec.YAML where++import Protolude++import Control.Monad.Catch (MonadThrow (..))++import qualified Data.Aeson         as JSON+import qualified Data.Text          as Text+import qualified Data.Text.Encoding as Text (encodeUtf8)+import qualified Data.Text.IO       as Text (readFile)+import qualified Data.Yaml          as YAML++import System.Etc.Internal.Spec.Types++parseConfigSpec+  :: (MonadThrow m, JSON.FromJSON cmd)+    => Text+    -> m (ConfigSpec cmd)+parseConfigSpec input =+  case YAML.decodeEither (Text.encodeUtf8 input) of+    Left err ->+      throwM $ InvalidConfiguration (Text.pack err)++    Right result ->+      return result++readConfigSpec :: JSON.FromJSON cmd => Text -> IO (ConfigSpec cmd)+readConfigSpec filepath = do+  contents <- Text.readFile $ Text.unpack filepath+  parseConfigSpec contents
+ src/System/Etc/Internal/Types.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE RankNTypes                 #-}++module System.Etc.Internal.Types+  ( module System.Etc.Internal.Types+  , module System.Etc.Internal.Spec.Types+  ) where++import Protolude++import qualified Data.Aeson          as JSON+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HashMap+import           Data.Ord            (comparing)+import           Data.Set            (Set)+import qualified Data.Set            as Set++import System.Etc.Internal.Spec.Types (ConfigurationError (..))++--------------------+-- Configuration Types++data ConfigSource+  = File {+      configIndex :: Int+    , filepath    :: Text+    , value       :: JSON.Value+    }+  | Env {+      envVar :: Text+    , value  :: JSON.Value+    }+  | Cli {+      value :: JSON.Value+    }+  | Default {+      value :: JSON.Value+    }+  | None+  deriving (Show, Eq)++instance Ord ConfigSource where+  compare a b =+    if a == b then+      EQ+    else+      case (a, b) of+        (None, _) ->+          LT++        (_, None) ->+          GT++        (Default {}, _) ->+          LT++        (Cli {}, _) ->+          GT++        (_, Cli {}) ->+          LT++        (Env {}, _) ->+          GT++        (_, Env {}) ->+          LT++        (File {}, File {}) ->+          comparing configIndex a b++        (File {}, _) ->+          GT++data ConfigValue+  = ConfigValue {+      configSource :: Set ConfigSource+    }+  | SubConfig {+      configMap :: HashMap Text ConfigValue+    }+  deriving (Eq, Show)++deepMerge :: ConfigValue -> ConfigValue -> ConfigValue+deepMerge left right =+  case (left, right) of+    (SubConfig leftm, SubConfig rightm) ->+      SubConfig $+        HashMap.foldrWithKey+            (\key rightv result ->+                case HashMap.lookup key result of+                  Just leftv ->+                    HashMap.insert key (deepMerge leftv rightv) result+                  _ ->+                    HashMap.insert key rightv result)+            leftm+            rightm+    (ConfigValue leftSources, ConfigValue rightSources) ->+      ConfigValue $ Set.union leftSources rightSources+    _ ->+      right++instance Semigroup ConfigValue where+  (<>) = deepMerge++newtype Config+  = Config { fromConfig :: ConfigValue }+  deriving (Eq, Show, Semigroup)++instance Monoid Config where+  mempty = Config $ SubConfig HashMap.empty+  mappend (Config a) (Config b) = Config (a <> b)++isEmptySubConfig :: ConfigValue -> Bool+isEmptySubConfig val =+  case val of+    SubConfig hsh ->+      HashMap.null hsh+    ConfigValue {} ->+      False++emptySubConfig :: ConfigValue+emptySubConfig =+  SubConfig HashMap.empty++writeInSubConfig :: Text -> ConfigValue -> ConfigValue -> ConfigValue+writeInSubConfig key val subConfig =+  case subConfig of+    SubConfig hsh ->+      SubConfig+        $ HashMap.insert key val hsh+    _ ->+      subConfig++filterMaybe :: (a -> Bool) -> Maybe a -> Maybe a+filterMaybe pfn mvalue =+  case mvalue of+    Just a+      | pfn a ->+          Nothing+      | otherwise ->+          mvalue+    Nothing ->+      Nothing
+ src/System/Etc/Spec.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Spec (+    module Types+  , parseConfigSpec+  , readConfigSpec+  ) where++import Protolude hiding (catch)++import System.Etc.Internal.Spec.Types as Types+    (ConfigSpec, ConfigValue, ConfigurationError (..))++import Control.Monad.Catch (MonadCatch (..), MonadThrow (..))++import qualified Data.Aeson   as JSON+import qualified Data.Text    as Text+import qualified Data.Text.IO as Text (readFile)++import qualified System.Etc.Internal.Spec.JSON as JSON+#ifdef WITH_YAML+import qualified System.Etc.Internal.Spec.YAML as YAML+#endif++{-|++Parses a text input into a @ConfigSpec@, input can be JSON or YAML (if cabal+flag is set).++-}+parseConfigSpec+  :: (MonadCatch m, MonadThrow m, JSON.FromJSON cmd)+    => Text               -- ^ Text to be parsed+    -> m (ConfigSpec cmd) -- ^ returns ConfigSpec+#ifdef WITH_YAML+parseConfigSpec input =+   catch (JSON.parseConfigSpec input)+         (\(_ :: SomeException) ->  YAML.parseConfigSpec input)+#else+parseConfigSpec =+  JSON.parseConfigSpec+#endif++{-|++Reads contents of a file and parses into a @ConfigSpec@, file contents can be+either JSON or YAML (if cabal flag is set).++-}+readConfigSpec+  :: JSON.FromJSON cmd+  => Text -- ^ Filepath where contents are going to be read from and parsed+  -> IO (ConfigSpec cmd) -- ^ returns ConfigSpec+readConfigSpec filepath = do+  contents <- Text.readFile $ Text.unpack filepath+  parseConfigSpec contents
+ test/System/Etc/Resolver/Cli/CommandTest.hs view
@@ -0,0 +1,392 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.Cli.CommandTest where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)++import qualified Data.Set as Set++import System.Etc++with_command_option_tests :: TestTree+with_command_option_tests =+  testGroup "option input"+  [+    testCase "entry accepts short" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input+      (cmd, config) <- resolveCommandCliPure spec "program" ["test", "-g", "hello cli"]++      assertEqual "invalid command output" "test" cmd++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Cli "hello cli") set)++  , testCase "entry accepts long" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input++      (cmd, config) <- resolveCommandCliPure spec "program" ["test", "--greeting", "hello cli"]++      assertEqual "invalid command output" "test" cmd++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Cli "hello cli") set)++  , testCase "entry gets validated with a type" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"number\""+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input++      case resolveCommandCliPure spec "program" ["test", "--greeting", "hello cli"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting type validation to work on cli; got "+                             <> show err)+++        Right _ ->+          assertFailure "Expecting type validation to work on cli"++  , testCase "entry with required false does not barf" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"required\": false"+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input+      (cmd, config) <- resolveCommandCliPure spec "program" ["test"]++      assertEqual "invalid command output" "test" cmd++      case getConfigValue ["greeting"] config of+        Just set ->+          assertFailure ("expecting to have no entry for greeting; got\n"+                       <> show set)++        (_ :: Maybe ()) ->+          return ()++  , testCase "entry with required fails when option not given" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"required\": true"+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input+      case resolveCommandCliPure spec "program" ["test"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting required validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting required option to fail cli resolving"+  ]++with_command_argument_tests :: TestTree+with_command_argument_tests =+  testGroup "argument input"+  [+    testCase "entry gets validated with a type" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"number\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input++      case resolveCommandCliPure spec "program" ["test", "hello cli"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting type validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting type validation to work on cli"++  , testCase "entry with required false does not barf" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"string\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"required\": false"+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input+      (cmd, config) <- resolveCommandCliPure spec "program" ["test"]++      assertEqual "invalid command output" "test" cmd++      case getConfigValue ["greeting"] config of+        (Nothing :: Maybe ()) ->+          return ()++        Just set ->+          assertFailure ("expecting to have no entry for greeting; got\n"+                       <> show set)++  , testCase "entry with required fails when argument not given" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"string\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"required\": true"+            , "        , \"commands\": [\"test\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input+      case resolveCommandCliPure spec "program" ["test"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting required validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting required argument to fail cli resolving"++  , testCase "supports same cli input on multiple arguments" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/cli\": {"+            , "    \"desc\": \"\""+            , "  , \"header\": \"\""+            , "  , \"commands\": {"+            , "      \"test\": {\"header\": \"\", \"desc\": \"\"}"+            , "    , \"other\": {\"header\": \"\", \"desc\": \"\"}}}"+            , ", \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"type\": \"string\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"required\": false"+            , "        , \"commands\": [\"test\", \"other\"]"+            , "}}}}}"+            ]+      (spec :: ConfigSpec Text) <- parseConfigSpec input++      (cmd1, config1) <- resolveCommandCliPure spec "program" ["test", "-g", "hello"]+      (cmd2, config2) <- resolveCommandCliPure spec "program" ["other", "-g", "hello"]++      assertEqual "" "test" cmd1+      assertEqual "" "other" cmd2+      assertEqual "" config1 config2+  ]+++with_command :: TestTree+with_command =+  testGroup "when command given"+  [+    with_command_option_tests+  , with_command_argument_tests+  ]++without_command :: TestTree+without_command =+  testCase "fails when command not given" $ do+    let+      input =+        mconcat+          [+            "{ \"etc/cli\": {"+          , "    \"desc\": \"\""+          , "  , \"header\": \"\""+          , "  , \"commands\": {"+          , "      \"test\": {\"header\": \"\", \"desc\": \"\"}}}"+          , ", \"etc/entries\": {"+          , "    \"greeting\": {"+          , "      \"etc/spec\": {"+          , "        \"cli\": {"+          , "          \"input\": \"option\""+          , "        , \"short\": \"g\""+          , "        , \"type\": \"string\""+          , "        , \"metavar\": \"GREETING\""+          , "        , \"required\": true"+          , "        , \"commands\": [\"test\"]"+          , "}}}}}"+          ]+    (spec :: ConfigSpec Text) <- parseConfigSpec input+    case resolveCommandCliPure spec "program" [] of+      Left err ->+        case fromException err of+          Just CliEvalExited {} ->+            return ()++          _ ->+            assertFailure ("Expecting sub-command to be required; got "+                           <> show err)+      Right _ ->+        assertFailure "Expecting sub-command to be required; it wasn't"++++tests :: TestTree+tests =+  testGroup "command"+  [+    with_command+  , without_command+  ]
+ test/System/Etc/Resolver/Cli/PlainTest.hs view
@@ -0,0 +1,258 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.Cli.PlainTest where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase)++import qualified Data.Set as Set++import System.Etc++option_tests :: TestTree+option_tests =+  testGroup "option input"+  [+    testCase "entry accepts short" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      config <- resolvePlainCliPure spec "program" ["-g", "hello cli"]++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Cli "hello cli") set)++  , testCase "entry accepts long" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      config <- resolvePlainCliPure spec "program" ["--greeting", "hello cli"]++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Cli "hello cli") set)++  , testCase "entry gets validated with a type" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"number\""+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      case resolvePlainCliPure spec "program" ["--greeting", "hello cli"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting type validation to work on cli; got "+                             <> show err)+++        Right _ ->+          assertFailure "Expecting type validation to work on cli"++  , testCase "entry with required false does not barf" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"required\": false"+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      config <- resolvePlainCliPure spec "program" []++      case getConfigValue ["greeting"] config of+        Just set ->+          assertFailure ("expecting to have no entry for greeting; got\n"+                       <> show set)++        (_ :: Maybe ()) ->+          return ()++  , testCase "entry with required fails when option not given" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"option\""+            , "        , \"short\": \"g\""+            , "        , \"long\": \"greeting\""+            , "        , \"type\": \"string\""+            , "        , \"required\": true"+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      case resolvePlainCliPure spec "program" [] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting required validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting required option to fail cli resolving"++  ]++argument_tests :: TestTree+argument_tests =+  testGroup "argument input"+  [+    testCase "entry gets validated with a type" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"number\""+            , "        , \"metavar\": \"GREETING\""+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      case resolvePlainCliPure spec "program" ["hello cli"] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting type validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting type validation to work on cli"++  , testCase "entry with required false does not barf" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"string\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"required\": false"+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      config <- resolvePlainCliPure spec "program" []++      case getConfigValue ["greeting"] config of+        (Nothing :: Maybe ()) ->+          return ()++        Just set ->+          assertFailure ("expecting to have no entry for greeting; got\n"+                       <> show set)++  , testCase "entry with required fails when argument not given" $ do+      let+        input =+          mconcat+            [+              "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"cli\": {"+            , "          \"input\": \"argument\""+            , "        , \"type\": \"string\""+            , "        , \"metavar\": \"GREETING\""+            , "        , \"required\": true"+            , "}}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      case resolvePlainCliPure spec "program" [] of+        Left err ->+          case fromException err of+            Just CliEvalExited {} ->+              return ()++            _ ->+              assertFailure ("Expecting required validation to work on cli; got "+                             <> show err)++        Right _ ->+          assertFailure "Expecting required argument to fail cli resolving"+++  ]++tests :: TestTree+tests =+  testGroup "plain"+  [+    option_tests+  , argument_tests+  ]
+ test/System/Etc/Resolver/CliTest.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.CliTest where++import Test.Tasty (TestTree, testGroup)++import qualified System.Etc.Resolver.Cli.CommandTest+import qualified System.Etc.Resolver.Cli.PlainTest+++tests :: TestTree+tests =+  testGroup "cli"+  [+    System.Etc.Resolver.Cli.CommandTest.tests+  , System.Etc.Resolver.Cli.PlainTest.tests+  ]
+ test/System/Etc/Resolver/DefaultTest.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.DefaultTest (tests) where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertFailure, testCase)+++import qualified Data.Set as Set++import System.Etc++tests :: TestTree+tests =+  testGroup "default"+  [+    testCase "default is used when defined on spec" $ do+      let+        input =+          mconcat+            [+              "{\"etc/entries\": {"+            , " \"greeting\": { \"etc/spec\": { \"default\": \"hello default\" }}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      let+        config =+            resolveDefault spec++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Default "hello default") set)++  , testCase "default can be raw JSON value on entries spec" $ do+      let+        input =+          mconcat+            [+              "{\"etc/entries\": {"+            , " \"greeting\": \"hello default\"}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      let+        config =+            resolveDefault spec++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Default "hello default") set)++  ]
+ test/System/Etc/Resolver/EnvTest.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.EnvTest where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)+++import qualified Data.Set  as Set+import qualified Data.Text as Text++import Paths_etc (getDataFileName)++import System.Etc+++tests :: TestTree+tests =+  testGroup "env"+  [+    testCase "env entry is present when env var is defined" $ do+      let+        input =+          mconcat+            [+              "{\"etc/entries\": {"+            , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      let+        config =+            resolveEnvPure spec [("GREETING", "hello env")]++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting (check fixtures)\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from env; got " <> show set)+                   (Set.member (Env "GREETING" "hello env") set)++  , testCase "has precedence over default and file values" $ do+      jsonFilepath <- getDataFileName "test/fixtures/config.json"+      let+        input =+          mconcat+            [+              "{\"etc/filepaths\": ["+            , "\"" <> Text.pack jsonFilepath <> "\""+            , "],"+            , " \"etc/entries\": {"+            , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input+      (configFile, _) <- resolveFiles spec++      let+        configEnv =+          resolveEnvPure spec [("GREETING", "hello env")]++        config =+            configEnv <> configFile++      case getConfigValue ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting (check fixtures)\n"+                         <> show config)+        Just result ->+          assertEqual ("expecting to see entry from env " <> show result)+                    ("hello env" :: Text)+                    result++  , testCase "does not add entries to config if env var is not present" $ do+      let+        input =+          mconcat+            [+              "{\"etc/entries\": {"+            , " \"nested\": {\"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}}"+            ]+      (spec :: ConfigSpec ()) <- parseConfigSpec input++      let+        config =+          resolveEnvPure spec []++      assertEqual "expecting to not have an entry for key"+                  (Nothing :: Maybe Text)+                  (getConfigValue ["nested"] config)++      assertEqual "expecting to not have an entry for key"+                  (Nothing :: Maybe Text)+                  (getConfigValue ["nested", "greeting"] config)+  ]
+ test/System/Etc/Resolver/FileTest.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.Resolver.FileTest (tests) where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)++import qualified Data.Set    as Set+import qualified Data.Text   as Text+import qualified Data.Vector as Vector++import Paths_etc (getDataFileName)++import System.Etc+++tests :: TestTree+tests =+  testGroup "file"+  [+    testCase "supports json, yaml and yml extensions" $ do+      jsonFilepath <- getDataFileName "test/fixtures/config.json"+#ifdef WITH_YAML+      yamlFilepath <- getDataFileName "test/fixtures/config.yaml"+      ymlFilepath  <- getDataFileName "test/fixtures/config.yml"+#endif++      let+        input =+          mconcat+            [+              "{\"etc/filepaths\": ["+            , "\"" <> Text.pack jsonFilepath <> "\""+#ifdef WITH_YAML+            , ", \"" <> Text.pack yamlFilepath <> "\""+            , ", \"" <> Text.pack ymlFilepath <> "\""+#endif+            , "]}"+            ]++      (spec :: ConfigSpec ()) <- parseConfigSpec input+      (config, _) <- resolveFiles spec++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting (check fixtures)\n"+                         <> show config)+        Just set -> do+          assertBool ("expecting to see entry from json config file " <> show set)+                     (Set.member (File 1 (Text.pack jsonFilepath) "hello json") set)++#ifdef WITH_YAML+          assertBool ("expecting to see entry from yaml config file " <> show set)+                     (Set.member (File 2 (Text.pack jsonFilepath) "hello yaml") set)++          assertBool ("expecting to see entry from yml config file " <> show set)+                     (Set.member (File 3 (Text.pack jsonFilepath) "hello yml") set)+#endif++  , testCase "does not support any other file extension" $ do+      fooFilepath <- getDataFileName "test/fixtures/config.foo"+      let+        input =+          mconcat+            [+              "{\"etc/filepaths\": ["+            , "\"" <> Text.pack fooFilepath <> "\""+            , "]}"+            ]++      (spec :: ConfigSpec ()) <- parseConfigSpec input+      (config, errs) <- resolveFiles spec++      assertEqual "config should be empty" mempty config++      if Vector.null errs then+        assertFailure "expecting one error, got none"+      else+        let+          err = Vector.head errs+        in+          case fromException err of+            Just (InvalidConfiguration _) ->+              return ()+            _ ->+              assertFailure ("Expecting InvalidConfigurationError; got instead "+                             <> show err)+++  , testCase "does not fail if file doesn't exist" $ do+      jsonFilepath <- getDataFileName "test/fixtures/config.json"+      let+        input =+          mconcat+            [+              "{\"etc/filepaths\": ["+            , "\"" <> Text.pack jsonFilepath <> "\""+            , ", \"unknown_file.json\""+            , "]}"+            ]++      (spec :: ConfigSpec ()) <- parseConfigSpec input+      (config, errs) <- resolveFiles spec++      case getAllConfigSources ["greeting"] config of+        Nothing ->+          assertFailure ("expecting to get entries for greeting (check fixtures)\n"+                         <> show config)+        Just set ->+          assertBool ("expecting to see entry from json config file " <> show set)+                   (Set.member (File 1 (Text.pack jsonFilepath) "hello json") set)++      if Vector.null errs then+        assertFailure "expecting one error, got none"+      else+        let+          err =+            Vector.head errs+        in+          case fromException err of+            Just (ConfigurationFileNotFound _) ->+              return ()+            _ ->+              assertFailure ("Expecting ConfigurationFileNotFound; got instead "+                             <> show err)+  ]
+ test/System/Etc/SpecTest.hs view
@@ -0,0 +1,330 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+module System.Etc.SpecTest (tests) where++import Protolude++import Test.Tasty       (TestTree, testGroup)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)++import Data.HashMap.Strict (HashMap)++import qualified Data.Aeson          as JSON+import qualified Data.HashMap.Strict as HashMap++import System.Etc.Internal.Spec.Types+import System.Etc.Spec++#ifdef WITH_YAML+import qualified Data.Yaml as YAML+import           Paths_etc (getDataFileName)+#endif+++getConfigValue :: [Text] -> HashMap Text (ConfigValue cmd) -> Maybe (ConfigValue cmd)+getConfigValue keys hsh =+  case keys of+    [] ->+      Nothing+    (k:ks) -> do+      cv <- HashMap.lookup k hsh+      case cv of+        SubConfig hsh1 ->+          getConfigValue ks hsh1+        value ->+          if null ks then+            Just value+          else+            Nothing+++general_tests :: TestTree+general_tests =+  testGroup "general"+  [+    testCase "does not fail when etc/entries is not defined" $ do+      let+        input = "{}"++      case parseConfigSpec input of+        Left _ ->+          assertFailure "should not fail if no etc/entries key is present"+        Right (_ :: ConfigSpec ()) ->+          assertBool "" True++  , testCase "entries cannot finish in an empty map" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "entries should not accept empty maps as values " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "entries cannot finish in an array" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":[]}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "entries should not accept arrays as values " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "entries that finish with raw values sets them as default value" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":123}}"+        keys = ["greeting"]++      config <- parseConfigSpec input++      case getConfigValue keys (specConfigValues config) of+        Nothing ->+          assertFailure (show keys ++ " should map to a config value, got sub config map instead")+        Just (value :: ConfigValue ()) ->+          assertEqual "should contain default value"+                      (Just (JSON.Number 123))+                      (defaultValue value)++  , testCase "entries can have many levels of nesting" $ do+      let+        input = "{\"etc/entries\":{\"english\":{\"greeting\":\"hello\"}}}"+        keys = ["english", "greeting"]++      config <- parseConfigSpec input++      case getConfigValue keys (specConfigValues config) of+        Nothing ->+          assertFailure (show keys ++ " should map to a config value, got sub config map instead")+        Just (value :: ConfigValue ()) ->+          assertEqual "should contain default value"+                      (Just (JSON.String "hello"))+                      (defaultValue value)++  , testCase "spec map cannot be empty object" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not be an empty object " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "spec map cannot be a JSON array" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":[]}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not be an array " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "spec map cannot be a JSON bool" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":true}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not be a boolean " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "spec map cannot be a JSON string" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":\"hello\"}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not be a string " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "spec map cannot be a JSON number" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":123}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not be a number " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "spec map cannot have any other key that is not etc/spec" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":\"hello\"},\"foobar\":123}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "etc/spec map should not contain more than one key " ++ show result+        Left _ ->+          assertBool "" True+  ]++cli_tests :: TestTree+cli_tests =+  testGroup "cli"+  [+    testCase "cli entry settings requires an input" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{}}}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "cli entry should require a type " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "cli option entry requires either short or long" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\"}}}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "cli entry should require a type " ++ show result+        Left _ ->+          assertBool "" True++  , testCase "cli option entry works when setting short and type" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"short\":\"g\",\"type\":\"string\"}}}}}"+        keys  = ["greeting"]++      (config :: ConfigSpec ()) <- parseConfigSpec input++      let+        result = do+          value    <- getConfigValue keys (specConfigValues config)+          PlainEntry metadata <- cliEntry (configSources value)+          short <- optShort metadata+          valueType <- pure $ optValueType metadata+          return (short, valueType)++      case result of+        Nothing ->+          assertFailure (show keys ++ " should map to a config value, got sub config map instead")+        Just (short, valueType) -> do+          assertEqual "should contain short" "g" short+          assertEqual "should contain option type" StringOpt valueType++  , testCase "cli option entry works when setting long and type" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\"}}}}}"+        keys  = ["greeting"]++      (config :: ConfigSpec ()) <- parseConfigSpec input++      let+        result = do+          value    <- getConfigValue keys (specConfigValues config)+          PlainEntry metadata <- cliEntry (configSources value)+          long <- optLong metadata+          valueType <- pure $ optValueType metadata+          return (long, valueType)++      case result of+        Nothing ->+          assertFailure (show keys ++ " should map to a config value, got sub config map instead")+        Just (long, valueType) -> do+          assertEqual "should contain long" "greeting" long+          assertEqual "should contain option type" StringOpt valueType++  , testCase "cli entry accepts command" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\",\"commands\":[\"foo\"]}}}}}"+        keys  = ["greeting"]++      (config :: ConfigSpec Text) <- parseConfigSpec input++      let+        result = do+          value <- getConfigValue keys (specConfigValues config)+          CmdEntry cmd metadata <- cliEntry (configSources value)+          long <- optLong metadata+          valueType <- pure $ optValueType metadata+          return (cmd, long, valueType)++      case result of+        Nothing ->+          assertFailure (show config)+        Just (cmd, long, valueType) -> do+          assertEqual "should contain cmd" ["foo"] cmd+          assertEqual "should contain long" "greeting" long+          assertEqual "should contain option type" StringOpt valueType++  , testCase "cli entry does not accept unrecognized keys" $ do+      let+        -- error is a typo on key command (instead of command_s_)+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\",\"command\":[\"foo\"]}}}}}"++      case parseConfigSpec input of+        Right (result :: ConfigSpec ()) ->+          assertFailure $ "cli entry should fail on invalid entry " ++ show result+        Left _ ->+          assertBool "" True++  ]++envvar_tests :: TestTree+envvar_tests =+  testGroup "env"+  [+    testCase "env key creates an ENV source" $ do+      let+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"env\":\"GREETING\"}}}}"+        keys  = ["greeting"]++      (config :: ConfigSpec ()) <- parseConfigSpec input++      case getConfigValue keys (specConfigValues config) of+        Nothing ->+          assertFailure (show keys ++ " should map to a config value, got sub config map instead")+        Just value ->+          assertEqual "should contain EnvVar value"+                      (ConfigSources (Just "GREETING") Nothing)+                      (configSources value)+  ]++#ifdef WITH_YAML+yaml_tests :: TestTree+yaml_tests =+  testGroup "yaml parser"+  [+    testCase "should work with Aeson instances" $ do+      let+        keys  = ["greeting"]+      path   <- getDataFileName "test/fixtures/config.spec.yaml"+      mconfig <- YAML.decodeFile path++      case mconfig of+        Nothing ->+          assertFailure "yaml file did not have a configuration spec"++        Just (config :: ConfigSpec ()) ->+          case getConfigValue keys (specConfigValues config) of+            Nothing ->+              assertFailure (show keys ++ " should map to a config value, got sub config map instead")++            Just value ->+              assertEqual "should contain EnvVar value"+                          (ConfigSources (Just "GREETING") Nothing)+                          (configSources value)+  ]+#endif++tests :: TestTree+tests =+  testGroup "spec"+  [+    general_tests+#ifdef WITH_YAML+  , yaml_tests+#endif+  , envvar_tests+  , cli_tests+  ]
+ test/TestSuite.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Protolude++import Test.Tasty                   (defaultMainWithIngredients, testGroup)+import Test.Tasty.Ingredients.Rerun (rerunningTests)+import Test.Tasty.Runners           (consoleTestReporter, listingTests)++import qualified System.Etc.Resolver.DefaultTest+import qualified System.Etc.Resolver.EnvTest+import qualified System.Etc.Resolver.FileTest+import qualified System.Etc.SpecTest++#ifdef WITH_CLI+import qualified System.Etc.Resolver.CliTest+#endif++main :: IO ()+main =+  defaultMainWithIngredients+    [ rerunningTests [listingTests, consoleTestReporter] ]+    (testGroup "etc" [ System.Etc.SpecTest.tests+                     , System.Etc.Resolver.DefaultTest.tests+                     , System.Etc.Resolver.FileTest.tests+                     , System.Etc.Resolver.EnvTest.tests+#ifdef WITH_CLI+                     , System.Etc.Resolver.CliTest.tests+#endif+                     ])
+ test/fixtures/config.foo view
@@ -0,0 +1,1 @@+{ "greeting": "hello foo" }
+ test/fixtures/config.json view
@@ -0,0 +1,3 @@+{+    "greeting": "hello json"+}
+ test/fixtures/config.spec.yaml view
@@ -0,0 +1,4 @@+etc/entries:+  greeting:+    etc/spec:+      env: "GREETING"
+ test/fixtures/config.yaml view
@@ -0,0 +1,1 @@+greeting: "hello yaml"
+ test/fixtures/config.yml view
@@ -0,0 +1,1 @@+greeting: "hello yml"