etc 0.3.2.0 → 0.4.0.0

raw patch · 22 files changed

+713/−356 lines, 22 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +13/−0
• etc.cabal +1/−1
• src/System/Etc.hs +0/−6
• src/System/Etc/Internal/Config.hs +2/−2
• src/System/Etc/Internal/Extra/EnvMisspell.hs +3/−2
• src/System/Etc/Internal/Extra/Printer.hs +119/−91
• src/System/Etc/Internal/Resolver/Cli/Command.hs +10/−7
• src/System/Etc/Internal/Resolver/Cli/Common.hs +21/−22
• src/System/Etc/Internal/Resolver/Cli/Plain.hs +12/−8
• src/System/Etc/Internal/Resolver/Default.hs +4/−4
• src/System/Etc/Internal/Resolver/Env.hs +38/−28
• src/System/Etc/Internal/Resolver/File.hs +43/−25
• src/System/Etc/Internal/Spec/Types.hs +139/−55
• src/System/Etc/Internal/Types.hs +2/−2
• test/System/Etc/Extra/EnvMisspellTest.hs +5/−4
• test/System/Etc/Resolver/Cli/CommandTest.hs +25/−27
• test/System/Etc/Resolver/Cli/PlainTest.hs +88/−43
• test/System/Etc/Resolver/DefaultTest.hs +5/−2
• test/System/Etc/Resolver/EnvTest.hs +67/−6
• test/System/Etc/Resolver/FileTest.hs +28/−7
• test/System/Etc/SpecTest.hs +87/−14
• test/fixtures/config.spec.yaml +1/−0

@@ -1,3 +1,16 @@+0.4.0.0+----+**BREAKING CHANGES**++* Add new `type` field to `etc/spec` with support for `string`, `number`,+  `bool`, `[string]`, `[number]` and `[bool]`, `[object]`+* Remove `type` field in `cli` spec in favor of `type` on `etc/spec`+* Allow ENV vars to accept supported types (only strings were allowed) (closes #30)+* Allow CLI options to accept supported types (only strings and numbers were allowed)+* Allow spec file to have array as default values+* Return a warning and an empty config whenever configuration files contain+  entries not defined in the spec (closes #26)+ 0.3.2.0 ---- 

@@ -1,5 +1,5 @@ name: etc-version: 0.3.2.0+version: 0.4.0.0 cabal-version: >=1.10 build-type: Simple license: MIT

@@ -1,11 +1,5 @@ {-# LANGUAGE CPP               #-} {-# LANGUAGE NoImplicitPrelude #-}---{-|---}- module System.Etc (   -- * Config   -- $config

@@ -46,7 +46,7 @@         Just (source, _) -> case JSON.iparse parser (fromValue $ value source) of            JSON.IError path err ->-            let key = keys0 & reverse & Text.intercalate "."+            let key = keys0 & Text.intercalate "."             in  JSON.formatError path err                 & Text.pack                 & InvalidConfiguration (Just key)@@ -57,7 +57,7 @@       ([], innerConfigValue) ->         case JSON.iparse parser (configValueToJsonObject innerConfigValue) of           JSON.IError path err ->-            let key = keys0 & reverse & Text.intercalate "."+            let key = keys0 & Text.intercalate "."             in  JSON.formatError path err                 & Text.pack                 & InvalidConfiguration (Just key)

@@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module System.Etc.Internal.Extra.EnvMisspell (@@ -33,8 +34,8 @@ lookupSpecEnvKeys :: ConfigSpec a -> Vector Text lookupSpecEnvKeys spec =   let foldEnvSettings val acc = case val of-        ConfigValue _defVal _sensitive sources ->-          maybe acc (`Vector.cons` acc) (envVar sources)+        ConfigValue { configSources } ->+          maybe acc (`Vector.cons` acc) (envVar configSources)         SubConfig hsh -> HashMap.foldr foldEnvSettings acc hsh   in  foldEnvSettings (SubConfig $ specConfigValues spec) Vector.empty 

@@ -9,128 +9,156 @@   , hPrintPrettyConfig   ) where -import           RIO              hiding ((<>))-import qualified RIO.HashMap      as HashMap-import           RIO.List         (intersperse)-import           RIO.List.Partial (maximum)-import qualified RIO.Set          as Set-import qualified RIO.Text         as Text+import           RIO         hiding ((<>))+import qualified RIO.HashMap as HashMap+import           RIO.List    (intersperse)+import qualified RIO.Set     as Set+import qualified RIO.Text    as Text+import qualified RIO.Vector  as Vector  import qualified Data.Aeson as JSON -import Text.PrettyPrint.ANSI.Leijen+import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))  import System.Etc.Internal.Types -renderJsonValue :: Text -> Value JSON.Value -> (Doc, Int)-renderJsonValue key value' = case value' of-  Plain JSON.Null         -> (text "null", 4)--  Plain (JSON.String str) -> (text $ Text.unpack str, Text.length str)--  Plain (JSON.Number scientific) ->-    let number = show scientific in (text number, length number)-  Plain     (JSON.Bool bool') -> if bool' then (text "true", 5) else (text "false", 5)-  Sensitive _                 -> (text "<<sensitive>>", 13)-  _ ->-    value'-      & tshow-      & ("Invalid configuration value creation " `mappend`)-      & InvalidConfiguration (Just key)-      & show-      & error- data ColorFn   = ColorFn {     greenColor :: !(Doc -> Doc)   , blueColor  :: !(Doc -> Doc)   } -renderConfig' :: ColorFn -> Config -> Doc-renderConfig' ColorFn { greenColor, blueColor } (Config configValue0) =-  let-    brackets' = enclose (lbracket <> space) (space <> rbracket)+renderConfigValueJSON :: JSON.Value -> Either Text Doc+renderConfigValueJSON value = case value of+  JSON.Null              -> Right $ text "null"+  JSON.String str        -> Right $ text $ Text.unpack str+  JSON.Number scientific -> Right $ text $ show scientific+  JSON.Bool   b          -> Right $ if b then text "true" else text "false"+  JSON.Object obj        -> do+    values <- forM (HashMap.toList obj) $ \(k, v) -> do+      v1 <- renderConfigValueJSON v+      return $ text (Text.unpack k) <> ":" <+> v1+    return $ align (vsep values)+  _ -> Left $ "Trying to render Unsupported JSON value " `mappend` (tshow value) -    renderSource :: Text -> ConfigSource -> ((Doc, Int), Doc)-    renderSource key source' = case source' of-      Default value' -> (renderJsonValue key value', brackets' (fill 10 (text "Default")))+renderConfigValue+  :: (JSON.Value -> Either Text Doc) -> Value JSON.Value -> Either Text [Doc]+renderConfigValue f value = case value of+  Plain (JSON.Array jsonArray) -> fmap Vector.toList <$> forM jsonArray $ \jsonValue -> do+    valueDoc <- f jsonValue+    return $ text "-" <+> valueDoc+  Plain jsonValue -> fmap return (f jsonValue)+  Sensitive{}     -> Right $ return $ text "<<sensitive>>" -      File _index fileSource value' -> case fileSource of-        FilePathSource filepath' ->-          ( renderJsonValue key value'-          , brackets' (fill 10 (text "File:" <+> text (Text.unpack filepath')))-          )-        EnvVarFileSource envVar filepath' ->-          ( renderJsonValue key value'-          , brackets'-            (fill-              10-              (text "File:" <+> text (Text.unpack envVar) <> "=" <> text-                (Text.unpack filepath')-              )-            )-          )+renderConfigSource+  :: (JSON.Value -> Either Text Doc) -> ConfigSource -> Either Text ([Doc], Doc)+renderConfigSource f configSource = case configSource of+  Default value -> do+    let sourceDoc = text "Default"+    valueDoc <- renderConfigValue f value+    return (valueDoc, sourceDoc) -      Env varname value' ->-        ( renderJsonValue key value'-        , brackets' (fill 10 (text "Env:" <+> text (Text.unpack varname)))-        )+  File _index fileSource value ->+    let sourceDoc = case fileSource of+          FilePathSource filepath -> text "File:" <+> text (Text.unpack filepath)+          EnvVarFileSource envVar filepath ->+            text "File:" <+> text (Text.unpack envVar) <> "=" <> text (Text.unpack filepath)+    in  do+          valueDoc <- renderConfigValue f value+          return (valueDoc, sourceDoc) -      Cli value' -> (renderJsonValue key value', brackets' (fill 10 (text "Cli")))+  Env varname value -> do+    let sourceDoc = text "Env:" <+> text (Text.unpack varname)+    valueDoc <- renderConfigValue f value+    return (valueDoc, sourceDoc) -      None       -> ((mempty, 0), mempty)+  Cli value -> do+    let sourceDoc = text "Cli"+    valueDoc <- renderConfigValue f value+    return (valueDoc, sourceDoc) -    renderSources :: Text -> [ConfigSource] -> Doc-    renderSources keys sources0 =-      let-        -- NOTE: I've already checked for the list to not be empty,-        -- so is safe to do this destructuring here-        sources@(((selValueDoc, _), selSourceDoc) : others) =-          map (renderSource keys) sources0+  None -> return (mempty, mempty) -        -- NOTE: I've already checked for the list to not be empty,-        -- so is safe to use partial function maximum here-        fillingWidth  = sources & map (snd . fst) & maximum & max 10+renderConfig_ :: MonadThrow m => ColorFn -> Config -> m Doc+renderConfig_ ColorFn { blueColor } (Config configMap) =+  let+    renderSources :: MonadThrow m => Text -> [ConfigSource] -> m Doc+    renderSources keyPath sources =+      let eSourceDocs = mapM (renderConfigSource renderConfigValueJSON) sources -        selectedValue = [greenColor $ fill fillingWidth selValueDoc <+> selSourceDoc]+          brackets'   = enclose (lbracket <> space) (space <> rbracket) -        otherValues   = map-          (\((valueDoc, _), sourceDoc) -> fill fillingWidth valueDoc <+> sourceDoc)-          others-      in-        selectedValue & flip mappend otherValues & vcat & indent 2+          layoutSourceValueDoc valueDocs sourceDoc = case valueDocs of+            [] -> throwM $ InvalidConfiguration+              (Just keyPath)+              "Trying to render config entry with no values" -    configEntryRenderer :: [Text] -> [Doc] -> Text -> ConfigValue -> [Doc]-    configEntryRenderer keys resultDoc configKey configValue =-      resultDoc `mappend` loop (configKey : keys) configValue+            [singleValueDoc] ->+              -- [Default]+              --   Value 1+              --+              return $ sourceDoc <$$> indent 2 singleValueDoc +            multipleValues ->+              -- [Default]+              --   - Value 1+              --   - Value 2+              --   - Value 3+              --+              return $ sourceDoc <$$> (indent 2 $ align (vsep multipleValues))+      in  case eSourceDocs of+            Left  err -> throwM $ InvalidConfiguration (Just keyPath) err++            Right []  -> throwM $ InvalidConfiguration+              (Just keyPath)+              "Trying to render config entry with no values"++            -- [ (*) CLI ]+            --   - Value 1+            -- [ Default ]+            --   - Value+            Right ((selectedValueDoc, selectedSourceDoc) : otherSourceDocs) -> do+              selectedDoc <- layoutSourceValueDoc selectedValueDoc+                $ brackets' (parens (text "*") <+> selectedSourceDoc)++              othersDoc <- forM otherSourceDocs+                $ \(value, source) -> layoutSourceValueDoc value $ brackets' source++              return $ indent 2 $ vsep $ selectedDoc : othersDoc++    renderConfigEntry :: MonadThrow m => [Text] -> [Doc] -> Text -> ConfigValue -> m [Doc]+    renderConfigEntry keyPath accDoc configKey configValue = do+      currentDoc <- loop (configKey : keyPath) configValue+      return $ accDoc `mappend` currentDoc++    loop :: MonadThrow m => [Text] -> ConfigValue -> m [Doc]     loop keys configValue = case configValue of-      SubConfig subConfigm ->-        HashMap.foldlWithKey' (configEntryRenderer keys) mempty subConfigm+      SubConfig subConfigm -> foldM (\acc (k, v) -> renderConfigEntry keys acc k v)+                                    mempty+                                    (HashMap.toList subConfigm)        ConfigValue sources0 ->-        let-          configKey = keys & reverse & Text.intercalate "."--          sources   = Set.toDescList sources0-        in-          if null sources-          then-            []-          else-            [blueColor (text (Text.unpack configKey)) <$$> renderSources configKey sources]+        let keyPathText = Text.intercalate "." $ reverse keys+            sources     = Set.toDescList sources0+        in  if null sources+              then return []+              else do+                configSources <- renderSources keyPathText sources+                return [blueColor (text $ Text.unpack keyPathText) <$$> configSources]   in-    loop [] configValue0 & intersperse (linebreak <> linebreak) & hcat & (<> linebreak)+    do+      result <- loop [] configMap+      return $ (hcat $ intersperse (linebreak <> linebreak) $ result) <> linebreak  -renderConfigColor :: Config -> Doc-renderConfigColor = renderConfig' ColorFn {greenColor = green, blueColor = blue}+renderConfigColor :: MonadThrow m => Config -> m Doc+renderConfigColor = renderConfig_ ColorFn {greenColor = green, blueColor = blue} -renderConfig :: Config -> Doc-renderConfig = renderConfig' ColorFn {greenColor = id, blueColor = id}+renderConfig :: MonadThrow m => Config -> m Doc+renderConfig = renderConfig_ ColorFn {greenColor = id, blueColor = id}  printPrettyConfig :: Config -> IO ()-printPrettyConfig = putDoc . renderConfig+printPrettyConfig = putDoc <=< renderConfigColor  hPrintPrettyConfig :: Handle -> Config -> IO ()-hPrintPrettyConfig handle' = hPutDoc handle' . renderConfig+hPrintPrettyConfig someHandle = hPutDoc someHandle <=< renderConfigColor

@@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module System.Etc.Internal.Resolver.Cli.Command (resolveCommandCli, resolveCommandCliPure) where@@ -22,12 +23,13 @@  entrySpecToJsonCli   :: (MonadThrow m)-  => Bool+  => Spec.ConfigValueType+  -> Bool   -> Spec.CliEntrySpec cmd   -> m (Vector cmd, Opt.Parser (Maybe (Value JSON.Value)))-entrySpecToJsonCli sensitive entrySpec = case entrySpec of+entrySpecToJsonCli cvType isSensitive entrySpec = case entrySpec of   Spec.CmdEntry commandJsonValue specSettings ->-    return (commandJsonValue, settingsToJsonCli sensitive specSettings)+    return (commandJsonValue, settingsToJsonCli cvType isSensitive specSettings)    Spec.PlainEntry{} -> throwM CommandKeyMissing @@ -35,10 +37,11 @@   :: (MonadThrow m, Eq cmd, Hashable cmd)   => HashMap cmd (Opt.Parser ConfigValue)   -> Text+  -> Spec.ConfigValueType   -> Bool   -> Spec.ConfigSources cmd   -> m (HashMap cmd (Opt.Parser ConfigValue))-configValueSpecToCli acc0 specEntryKey sensitive sources =+configValueSpecToCli acc0 specEntryKey cvType isSensitive sources =   let updateAccConfigOptParser configValueParser accOptParser =         (\configValue accSubConfig -> case accSubConfig of             ConfigValue{} -> accSubConfig@@ -52,7 +55,7 @@         Nothing        -> return acc0          Just entrySpec -> do-          (commands, jsonOptParser) <- entrySpecToJsonCli sensitive entrySpec+          (commands, jsonOptParser) <- entrySpecToJsonCli cvType isSensitive entrySpec            let configValueParser = jsonToConfigValue <$> jsonOptParser @@ -111,8 +114,8 @@   -> (Text, Spec.ConfigValue cmd)   -> m (HashMap cmd (Opt.Parser ConfigValue)) specToConfigValueCli acc (specEntryKey, specConfigValue) = case specConfigValue of-  Spec.ConfigValue _ sensitive sources ->-    configValueSpecToCli acc specEntryKey sensitive sources+  Spec.ConfigValue { Spec.configValueType, Spec.isSensitive, Spec.configSources } ->+    configValueSpecToCli acc specEntryKey configValueType isSensitive configSources    Spec.SubConfig subConfigSpec -> subConfigSpecToCli specEntryKey subConfigSpec acc 

@@ -70,7 +70,6 @@ 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]@@ -84,31 +83,31 @@       & InvalidCliCommandKey       & throwM -settingsToJsonCli :: Bool -> Spec.CliEntryMetadata -> Opt.Parser (Maybe (Value JSON.Value))-settingsToJsonCli sensitive specSettings =+jsonOptReader :: Spec.ConfigValueType -> Bool -> String -> Either String (Value JSON.Value)+jsonOptReader cvType isSensitive content =+  let contentText = Text.pack content+      jsonValue   = fromMaybe (JSON.String contentText)+                              (JSON.decodeStrict' $ Text.encodeUtf8 contentText)+  in  if Spec.matchesConfigValueType jsonValue cvType+        then Right $ markAsSensitive isSensitive jsonValue+        else Left "input is not valid"++settingsToJsonCli+  :: Spec.ConfigValueType+  -> Bool+  -> Spec.CliEntryMetadata+  -> Opt.Parser (Maybe (Value JSON.Value))+settingsToJsonCli cvType isSensitive 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 -> boolToValue sensitive . JSON.String . Text.pack <$> Opt.strOption-          (specToCliVarFieldMod specSettings)--        Spec.NumberOpt -> boolToValue sensitive . JSON.Number . fromInteger <$> Opt.option-          Opt.auto-          (specToCliVarFieldMod specSettings)+  in  requiredCombinator $ case specSettings of+        Spec.Opt{} -> Opt.option (Opt.eitherReader $ jsonOptReader cvType isSensitive)+                                 (specToCliVarFieldMod specSettings) -        Spec.SwitchOpt -> boolToValue sensitive . JSON.Bool <$> Opt.switch-          (specToCliSwitchFieldMod specSettings)+        Spec.Arg{} -> Opt.argument+          (Opt.eitherReader $ jsonOptReader cvType isSensitive)+          (specSettings & Spec.argMetavar & maybe Opt.idm (Opt.metavar . Text.unpack)) -      Spec.Arg{} -> case Spec.argValueType specSettings of-        Spec.StringArg ->-          boolToValue sensitive . JSON.String . Text.pack <$> Opt.strArgument-            (specSettings & Spec.argMetavar & maybe Opt.idm (Opt.metavar . Text.unpack))-        Spec.NumberArg ->-          boolToValue sensitive . 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

@@ -1,3 +1,4 @@+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE NoImplicitPrelude #-}  module System.Etc.Internal.Resolver.Cli.Plain (PlainConfigSpec, resolvePlainCli, resolvePlainCliPure) where@@ -23,23 +24,26 @@  entrySpecToConfigValueCli   :: (MonadThrow m)-  => Bool+  => Spec.ConfigValueType+  -> Bool   -> Spec.CliEntrySpec ()   -> m (Opt.Parser (Maybe (Value JSON.Value)))-entrySpecToConfigValueCli sensitive entrySpec = case entrySpec of-  Spec.CmdEntry{}              -> throwM CommandKeyOnPlainCli+entrySpecToConfigValueCli cvType isSensitive entrySpec = case entrySpec of+  Spec.CmdEntry{} -> throwM CommandKeyOnPlainCli -  Spec.PlainEntry specSettings -> return (settingsToJsonCli sensitive specSettings)+  Spec.PlainEntry specSettings ->+    return (settingsToJsonCli cvType isSensitive specSettings)   configValueSpecToCli   :: (MonadThrow m)   => Text+  -> Spec.ConfigValueType   -> Bool   -> Spec.ConfigSources ()   -> Opt.Parser ConfigValue   -> m (Opt.Parser ConfigValue)-configValueSpecToCli specEntryKey sensitive sources acc =+configValueSpecToCli specEntryKey cvType isSensitive sources acc =   let updateAccConfigOptParser configValueParser accOptParser =         (\configValue accSubConfig -> case accSubConfig of             ConfigValue{} -> accSubConfig@@ -53,7 +57,7 @@         Nothing        -> return acc          Just entrySpec -> do-          jsonOptParser <- entrySpecToConfigValueCli sensitive entrySpec+          jsonOptParser <- entrySpecToConfigValueCli cvType isSensitive entrySpec            let configValueParser = jsonToConfigValue <$> jsonOptParser @@ -88,8 +92,8 @@   -> (Text, Spec.ConfigValue ())   -> m (Opt.Parser ConfigValue) specToConfigValueCli acc (specEntryKey, specConfigValue) = case specConfigValue of-  Spec.ConfigValue _ sensitive sources ->-    configValueSpecToCli specEntryKey sensitive sources acc+  Spec.ConfigValue { Spec.configValueType, Spec.isSensitive, Spec.configSources } ->+    configValueSpecToCli specEntryKey configValueType isSensitive configSources acc    Spec.SubConfig subConfigSpec -> subConfigSpecToCli specEntryKey subConfigSpec acc 

@@ -1,5 +1,5 @@+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE NoImplicitPrelude #-}- module System.Etc.Internal.Resolver.Default (resolveDefault) where  import           RIO@@ -13,15 +13,15 @@  toDefaultConfigValue :: Bool -> JSON.Value -> ConfigValue toDefaultConfigValue sensitive =-  ConfigValue . Set.singleton . Default . boolToValue sensitive+  ConfigValue . Set.singleton . Default . markAsSensitive sensitive  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 sensitive _ ->-          let mConfigSource = toDefaultConfigValue sensitive <$> def+        Spec.ConfigValue { Spec.defaultValue, Spec.isSensitive } ->+          let mConfigSource = toDefaultConfigValue isSensitive <$> defaultValue                updateConfig  = writeInSubConfig specKey <$> mConfigSource <*> mConfig           in  updateConfig <|> mConfig

@@ -1,5 +1,5 @@+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE NoImplicitPrelude #-}- module System.Etc.Internal.Resolver.Env (resolveEnv, resolveEnvPure) where  import           RIO@@ -8,44 +8,54 @@ import qualified RIO.Text           as Text import           System.Environment (getEnvironment) -import           Control.Arrow ((***))-import qualified Data.Aeson    as JSON+import Control.Arrow ((***))  import qualified System.Etc.Internal.Spec.Types as Spec import           System.Etc.Internal.Types  resolveEnvVarSource-  :: (Text -> Maybe Text) -> Bool -> Spec.ConfigSources cmd -> Maybe ConfigSource-resolveEnvVarSource lookupEnv sensitive specSources =-  let toEnvSource varname envValue =-        envValue & JSON.String & boolToValue sensitive & Env varname+  :: (Text -> Maybe Text)+  -> Spec.ConfigValueType+  -> Bool+  -> Spec.ConfigSources cmd+  -> Maybe ConfigSource+resolveEnvVarSource lookupEnv configValueType isSensitive specSources =+  let envTextToJSON envValue = Spec.parseBytesToConfigValueJSON configValueType envValue++      toEnvSource varname envValue =+        Env varname . markAsSensitive isSensitive <$> envTextToJSON envValue   in  do         varname <- Spec.envVar specSources-        toEnvSource varname <$> lookupEnv varname+        envText <- lookupEnv varname+        toEnvSource varname envText  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 _ sensitive sources ->-          let updateConfig = do-                envSource <- resolveEnvVarSource lookupEnv sensitive sources-                writeInSubConfig specKey (ConfigValue $ Set.singleton envSource)-                  <$> mConfig-          in  updateConfig <|> mConfig+  let+    resolverReducer+      :: Text -> Spec.ConfigValue cmd -> Maybe ConfigValue -> Maybe ConfigValue+    resolverReducer specKey specValue mConfig = case specValue of+      Spec.ConfigValue { Spec.isSensitive, Spec.configValueType, Spec.configSources } ->+        let updateConfig = do+              envSource <- resolveEnvVarSource lookupEnv+                                               configValueType+                                               isSensitive+                                               configSources+              writeInSubConfig specKey (ConfigValue $ Set.singleton envSource) <$> mConfig+        in  updateConfig <|> mConfig -        Spec.SubConfig specConfigMap ->-          let mSubConfig =-                specConfigMap-                  & HashMap.foldrWithKey resolverReducer (Just emptySubConfig)-                  & filterMaybe isEmptySubConfig+      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+            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@@@ -67,7 +77,7 @@ {-|  Gathers all OS Environment Variable values (@env@ entries) from the @etc/spec@-entries inside a @ConfigSpec@.+entries inside a @ConfigSpec@  -} resolveEnv

@@ -35,39 +35,57 @@  parseConfigValue   :: Monad m-  => Maybe (Spec.ConfigValue cmd)+  => [Text]+  -> Maybe (Spec.ConfigValue cmd)   -> Int   -> FileSource   -> JSON.Value   -> m ConfigValue-parseConfigValue mSpec fileIndex fileSource json = case json of-  JSON.Object object -> SubConfig <$> foldM-    (\acc (key, subConfigValue) -> do-      let msubConfigSpec = do-            spec <- mSpec-            case spec of-              Spec.SubConfig hsh -> HashMap.lookup key hsh-              _ ->-                -- TODO: This should be an error given the config doesn't match spec-                fail "configuration spec and configuration value are different"+parseConfigValue keys mSpec fileIndex fileSource json = -      value1 <- parseConfigValue msubConfigSpec fileIndex fileSource subConfigValue-      return $ HashMap.insert key value1 acc-    )-    HashMap.empty-    (HashMap.toList object)+  let currentKey = Text.intercalate "." $ reverse keys+  in+    case json of+      JSON.Object object -> SubConfig <$> foldM+        (\acc (key, subConfigValue) -> do+          let msubConfigSpec = do+                spec <- mSpec+                case spec of+                  Spec.SubConfig hsh -> HashMap.lookup key hsh+                  _ ->+                    -- TODO: This should be an error given the config doesn't match spec+                    fail "configuration spec and configuration value are different" -  _ ->-    let mToValue = do-          spec <- mSpec-          case spec of-            Spec.ConfigValue{} -> return $ boolToValue (Spec.isSensitive spec)-            _ -> fail "configuration spec and configuration value are different"+          value1 <- parseConfigValue (key : keys)+                                     msubConfigSpec+                                     fileIndex+                                     fileSource+                                     subConfigValue+          return $ HashMap.insert key value1 acc+        )+        HashMap.empty+        (HashMap.toList object) -        toValue = fromMaybe Plain mToValue-    in  return $ ConfigValue (Set.singleton $ File fileIndex fileSource (toValue json))+      _ -> case mSpec of+        Just Spec.ConfigValue { Spec.isSensitive, Spec.configValueType } -> do+          Spec.assertMatchingConfigValueType json configValueType+          return $ ConfigValue+            (Set.singleton $ File fileIndex fileSource $ markAsSensitive isSensitive json)+        Just _ ->+          fail+            $  Text.unpack+            $  "Configuration entry `"+            <> currentKey+            <> "` does not follow spec" +        Nothing ->+          fail+            $  Text.unpack+            $  "Configuration entry `"+            <> currentKey+            <> "` is not present on spec" + eitherDecode :: ConfigFile -> Either String JSON.Value #ifdef WITH_YAML eitherDecode contents0 =@@ -89,7 +107,7 @@   Left err -> throwM $ InvalidConfiguration Nothing (Text.pack err)    Right json ->-    case JSON.iparse (parseConfigValue (Just spec) fileIndex fileSource) json of+    case JSON.iparse (parseConfigValue [] (Just spec) fileIndex fileSource) json of       JSON.IError _ err    -> throwM $ InvalidConfiguration Nothing (Text.pack err)       JSON.ISuccess result -> return (Config result) 

@@ -1,10 +1,14 @@+{-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module System.Etc.Internal.Spec.Types where -import           Prelude     (fail)+import Prelude (fail)+ import           RIO-import qualified RIO.HashMap as HashMap+import qualified RIO.HashMap        as HashMap+import qualified RIO.Text           as Text+import qualified RIO.Vector.Partial as Vector (head)  import Data.Aeson ((.:), (.:?)) @@ -18,7 +22,7 @@   = InvalidConfiguration !(Maybe Text) !Text   | InvalidConfigKeyPath ![Text]   | ConfigurationFileNotFound !Text-  deriving (Show)+  deriving (Generic, Show)  instance Exception ConfigurationError @@ -28,28 +32,26 @@   = StringOpt   | NumberOpt   | SwitchOpt-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data CliArgValueType   = StringArg   | NumberArg-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data CliEntryMetadata   = Opt {-    optLong      :: !(Maybe Text)-  , optShort     :: !(Maybe Text)-  , optMetavar   :: !(Maybe Text)-  , optHelp      :: !(Maybe Text)-  , optRequired  :: !Bool-  , optValueType :: !CliOptValueType+    optLong     :: !(Maybe Text)+  , optShort    :: !(Maybe Text)+  , optMetavar  :: !(Maybe Text)+  , optHelp     :: !(Maybe Text)+  , optRequired :: !Bool   }   | Arg {-    argMetavar   :: !(Maybe Text)-  , optRequired  :: !Bool-  , argValueType :: !CliArgValueType+    argMetavar  :: !(Maybe Text)+  , optRequired :: !Bool   }-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data CliEntrySpec cmd   = CmdEntry {@@ -59,32 +61,59 @@   | PlainEntry {     cliEntryMetadata :: !CliEntryMetadata   }-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data CliCmdSpec   = CliCmdSpec {     cliCmdDesc   :: !Text   , cliCmdHeader :: !Text   }-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data ConfigSources cmd   = ConfigSources {     envVar   :: !(Maybe Text)   , cliEntry :: !(Maybe (CliEntrySpec cmd))   }-  deriving (Show, Eq)+  deriving (Generic, Show, Eq) +data SingleConfigValueType+  = CVTString+  | CVTNumber+  | CVTBool+  | CVTObject+  deriving (Generic, Show, Eq)++instance Display SingleConfigValueType where+  display value =+    case value of+      CVTString -> "string"+      CVTNumber -> "number"+      CVTBool   -> "bool"+      CVTObject -> "object"++data ConfigValueType+  = CVTSingle !SingleConfigValueType+  | CVTArray  !SingleConfigValueType+  deriving (Generic, Show, Eq)++instance Display ConfigValueType where+  display value =+    case value of+      CVTSingle singleVal -> display singleVal+      CVTArray  singleVal -> display $ "[" <> display singleVal <> "]"+ data ConfigValue cmd   = ConfigValue {-    defaultValue  :: !(Maybe JSON.Value)-  , isSensitive   :: !Bool-  , configSources :: !(ConfigSources cmd)+    defaultValue    :: !(Maybe JSON.Value)+  , configValueType :: !ConfigValueType+  , isSensitive     :: !Bool+  , configSources   :: !(ConfigSources cmd)   }   | SubConfig {     subConfig :: !(HashMap Text (ConfigValue cmd))   }-  deriving (Show, Eq)+  deriving (Generic, Show, Eq)  data CliProgramSpec   = CliProgramSpec {@@ -143,24 +172,7 @@  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"+  Arg <$> (object .:? "metavar") <*> (fromMaybe True <$> (object .:? "required"))  cliOptParser :: JSON.Object -> JSON.Parser CliEntryMetadata cliOptParser object = do@@ -175,10 +187,9 @@       <*> (object .:? "metavar")       <*> (object .:? "help")       <*> (fromMaybe True <$> (object .:? "required"))-      <*> cliOptTypeParser object  cliArgKeys :: [Text]-cliArgKeys = ["input", "commands", "metavar", "required", "type"]+cliArgKeys = ["input", "commands", "metavar", "required"]  cliOptKeys :: [Text] cliOptKeys = ["short", "long", "help"] ++ cliArgKeys@@ -217,33 +228,104 @@         _ ->           JSON.typeMismatch "CliEntryMetadata" json +instance JSON.FromJSON ConfigValueType where+  parseJSON = JSON.withText "ConfigValueType (string, number, bool)" $ \tyText ->+    case Text.toLower tyText of+      "string"   -> pure $ CVTSingle CVTString+      "number"   -> pure $ CVTSingle CVTNumber+      "bool"     -> pure $ CVTSingle CVTBool+      "[string]" -> pure $ CVTArray CVTString+      "[number]" -> pure $ CVTArray CVTNumber+      "[bool]"   -> pure $ CVTArray CVTBool+      "[object]" -> pure $ CVTArray CVTObject+      _  -> JSON.typeMismatch "ConfigValueType (string, number, bool)" (JSON.String tyText)++inferErrorMsg :: String+inferErrorMsg = "could not infer type from given default value"++parseBytesToConfigValueJSON :: ConfigValueType -> Text -> Maybe JSON.Value+parseBytesToConfigValueJSON cvType content = do+  case JSON.eitherDecodeStrict' (Text.encodeUtf8 content) of+    Right value | matchesConfigValueType value cvType -> return value+                | otherwise                           -> Nothing+    Left _err+      | matchesConfigValueType (JSON.String content) cvType -> return (JSON.String content)+      | otherwise -> Nothing++jsonToConfigValueType :: JSON.Value -> Either String ConfigValueType+jsonToConfigValueType json = case json of+  JSON.String{} -> Right $ CVTSingle CVTString+  JSON.Number{} -> Right $ CVTSingle CVTNumber+  JSON.Bool{}   -> Right $ CVTSingle CVTBool+  JSON.Array arr+    | null arr -> Left inferErrorMsg+    | otherwise -> case jsonToConfigValueType (Vector.head arr) of+      Right (CVTArray{}  ) -> Left "nested arrays values are not supported"+      Right (CVTSingle ty) -> Right $ CVTArray ty+      Left  err            -> Left err+  _ -> Left inferErrorMsg++matchesConfigValueType :: JSON.Value -> ConfigValueType -> Bool+matchesConfigValueType json cvType = case (json, cvType) of+  (JSON.Null    , CVTSingle _        ) -> True+  (JSON.String{}, CVTSingle CVTString) -> True+  (JSON.Number{}, CVTSingle CVTNumber) -> True+  (JSON.Bool{}  , CVTSingle CVTBool  ) -> True+  (JSON.Object{}, CVTSingle CVTObject) -> True+  (JSON.Array arr, CVTArray inner) ->+    if null arr then True else all (flip matchesConfigValueType (CVTSingle inner)) arr+  _ -> False++assertMatchingConfigValueType :: Monad m => JSON.Value -> ConfigValueType -> m ()+assertMatchingConfigValueType json cvType+  | matchesConfigValueType json cvType = return ()+  | otherwise = fail $ "JSON value type does not match specified type " <> show cvType++getConfigValueType+  :: Maybe JSON.Value -> Maybe ConfigValueType -> JSON.Parser ConfigValueType+getConfigValueType mdefValue mCvType = case (mdefValue, mCvType) of+  (Just JSON.Null, Just cvType) -> pure cvType++  (Just defValue , Just cvType) -> do+    assertMatchingConfigValueType defValue cvType+    return cvType++  (Nothing      , Just cvType) -> pure cvType++  (Just defValue, Nothing    ) -> either fail pure $ jsonToConfigValueType defValue++  (Nothing      , Nothing    ) -> fail inferErrorMsg+ 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+            subConfigMap <- foldM+                        (\subConfigMap (key, value) -> do                             innerValue <- JSON.parseJSON value-                            return $ HashMap.insert key innerValue result)+                            return $ HashMap.insert key innerValue subConfigMap)                         HashMap.empty                         (HashMap.toList object)-            if HashMap.null result then+            if HashMap.null subConfigMap then               fail "Entries cannot have empty maps as values"             else-              return (SubConfig result)+              return (SubConfig subConfigMap)            -- etc spec value object           Just (JSON.Object fieldSpec) ->             if HashMap.size object == 1 then do-              mSensitive <- fieldSpec .:? "sensitive"+              -- NOTE: not using .:? here as it casts JSON.Null to Nothing, we+              -- want (Just JSON.Null) returned+              mDefaultValue <- pure $ maybe Nothing Just $ HashMap.lookup "default" fieldSpec+              mSensitive    <- fieldSpec .:? "sensitive"+              mCvType       <- fieldSpec .:? "type"               let sensitive = fromMaybe False mSensitive               ConfigValue-                <$> fieldSpec .:? "default"+                <$> pure mDefaultValue+                <*> getConfigValueType mDefaultValue mCvType                 <*> pure sensitive                 <*> (ConfigSources <$> fieldSpec .:? "env"                                    <*> fieldSpec .:? "cli")@@ -254,13 +336,15 @@           Just _ ->             fail "etc/spec value must be a JSON object" -      _ ->+      _ -> do+        cvType <- either fail pure $ jsonToConfigValueType json         return           ConfigValue           {-            defaultValue = Just json-          , isSensitive = False-          , configSources = ConfigSources Nothing Nothing+            defaultValue    = Just json+          , configValueType = cvType+          , isSensitive     = False+          , configSources   = ConfigSources Nothing Nothing           }  

@@ -50,8 +50,8 @@ instance IsString a => IsString (Value a) where   fromString = Plain . fromString -boolToValue :: Bool -> (a -> Value a)-boolToValue = bool Plain Sensitive+markAsSensitive :: Bool -> (a -> Value a)+markAsSensitive = bool Plain Sensitive  data FileSource   = FilePathSource { fileSourcePath :: !Text }

@@ -16,10 +16,11 @@ tests = testGroup   "env misspells"   [ testCase "it warns when misspell is present" $ do-      let input = mconcat-            [ "{\"etc/entries\": {"-            , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}"-            ]+      let+        input = mconcat+          [ "{\"etc/entries\": {"+          , " \"greeting\": { \"etc/spec\":{\"type\":\"string\",\"env\": \"GREETING\"}}}}"+          ]        (spec :: ConfigSpec ()) <- parseConfigSpec input 

@@ -25,11 +25,11 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"option\""           , "        , \"short\": \"g\""           , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""           , "        , \"commands\": [\"test\"]"           , "}}}}}"           ]@@ -52,11 +52,11 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"option\""           , "        , \"short\": \"g\""           , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""           , "        , \"commands\": [\"test\"]"           , "}}}}}"           ]@@ -82,11 +82,11 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"number\""+          , "      , \"cli\": {"           , "          \"input\": \"option\""           , "        , \"short\": \"g\""           , "        , \"long\": \"greeting\""-          , "        , \"type\": \"number\""           , "        , \"commands\": [\"test\"]"           , "}}}}}"           ]@@ -110,11 +110,11 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"option\""           , "        , \"short\": \"g\""           , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""           , "        , \"required\": false"           , "        , \"commands\": [\"test1\"]"           , "}}}}}"@@ -139,13 +139,13 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""-          , "        , \"required\": true"-          , "        , \"commands\": [\"test\"]"+          , "          \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""+          , "          , \"required\": true"+          , "          , \"commands\": [\"test\"]"           , "}}}}}"           ]     (spec :: ConfigSpec Text) <- parseConfigSpec input@@ -172,9 +172,9 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"number\""+          , "      , \"cli\": {"           , "          \"input\": \"argument\""-          , "        , \"type\": \"number\""           , "        , \"metavar\": \"GREETING\""           , "        , \"commands\": [\"test\"]"           , "}}}}}"@@ -198,9 +198,9 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"argument\""-          , "        , \"type\": \"string\""           , "        , \"metavar\": \"GREETING\""           , "        , \"required\": false"           , "        , \"commands\": [\"test\"]"@@ -226,9 +226,9 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"argument\""-          , "        , \"type\": \"string\""           , "        , \"metavar\": \"GREETING\""           , "        , \"required\": true"           , "        , \"commands\": [\"test\"]"@@ -254,10 +254,10 @@           , ", \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"+          , "        \"type\": \"string\""+          , "      , \"cli\": {"           , "          \"input\": \"option\""           , "        , \"short\": \"g\""-          , "        , \"type\": \"string\""           , "        , \"metavar\": \"GREETING\""           , "        , \"required\": false"           , "        , \"commands\": [\"test\", \"other\"]"@@ -289,10 +289,10 @@         , ", \"etc/entries\": {"         , "    \"greeting\": {"         , "      \"etc/spec\": {"-        , "        \"cli\": {"+        , "        \"type\": \"string\""+        , "      , \"cli\": {"         , "          \"input\": \"option\""         , "        , \"short\": \"g\""-        , "        , \"type\": \"string\""         , "        , \"metavar\": \"GREETING\""         , "        , \"required\": true"         , "        , \"commands\": [\"test\"]"@@ -305,8 +305,6 @@        _ -> 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]

@@ -7,10 +7,35 @@ import qualified RIO.Set as Set  import Test.Tasty       (TestTree, testGroup)-import Test.Tasty.HUnit (assertBool, assertFailure, testCase)+import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)  import qualified System.Etc as SUT +resolver_tests :: TestTree+resolver_tests = testGroup+  "resolver"+  [ testCase "throws an error when input type does not match with spec type" $ do+      let input = mconcat+            [ "{ \"etc/entries\": {"+            , "    \"greeting\": {"+            , "      \"etc/spec\": {"+            , "        \"type\": \"[number]\""+            , "        , \"cli\": {"+            , "            \"input\": \"option\""+            , "          , \"short\": \"g\""+            , "          , \"long\": \"greeting\""+            , "          , \"required\": true"+            , "}}}}}"+            ]+      (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input+      eConfig <- try $ SUT.resolvePlainCliPure spec "program" ["-g", "hello world"]++      case eConfig of+        Left (SUT.CliEvalExited{}) -> assertBool "" True+        _ ->+          assertFailure $ "Expecting CliEvalExited error; got this instead " <> show eConfig+  ]+ option_tests :: TestTree option_tests = testGroup   "option input"@@ -19,11 +44,11 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -38,11 +63,11 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -57,11 +82,11 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"number\""+          , "        \"type\": \"number\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -79,12 +104,12 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""-          , "        , \"required\": false"+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""+          , "          , \"required\": false"           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -100,12 +125,12 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"option\""-          , "        , \"short\": \"g\""-          , "        , \"long\": \"greeting\""-          , "        , \"type\": \"string\""-          , "        , \"required\": true"+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""+          , "          , \"required\": true"           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -117,6 +142,26 @@           assertFailure ("Expecting required validation to work on cli; got " <> show err)        Right _ -> assertFailure "Expecting required option to fail cli resolving"+  , testCase "does parse array of numbers correctly" $ do+    let input = mconcat+          [ "{ \"etc/entries\": {"+          , "    \"greeting\": {"+          , "      \"etc/spec\": {"+          , "        \"type\": \"[number]\""+          , "        , \"cli\": {"+          , "            \"input\": \"option\""+          , "          , \"short\": \"g\""+          , "          , \"long\": \"greeting\""+          , "          , \"required\": true"+          , "}}}}}"+          ]+    (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input+    config                      <- SUT.resolvePlainCliPure spec "program" ["-g", "[1,2,3]"]++    case SUT.getConfigValue ["greeting"] config of+      Right arr  -> assertEqual "did not parse an array" ([1, 2, 3] :: [Int]) arr++      (Left err) -> assertFailure ("expecting to parse an array, but didn't " <> show err)   ]  argument_tests :: TestTree@@ -127,10 +172,10 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"argument\""-          , "        , \"type\": \"number\""-          , "        , \"metavar\": \"GREETING\""+          , "        \"type\": \"number\""+          , "        , \"cli\": {"+          , "            \"input\": \"argument\""+          , "          , \"metavar\": \"GREETING\""           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -147,11 +192,11 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"argument\""-          , "        , \"type\": \"string\""-          , "        , \"metavar\": \"GREETING\""-          , "        , \"required\": false"+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"argument\""+          , "          , \"metavar\": \"GREETING\""+          , "          , \"required\": false"           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -167,11 +212,11 @@           [ "{ \"etc/entries\": {"           , "    \"greeting\": {"           , "      \"etc/spec\": {"-          , "        \"cli\": {"-          , "          \"input\": \"argument\""-          , "        , \"type\": \"string\""-          , "        , \"metavar\": \"GREETING\""-          , "        , \"required\": true"+          , "        \"type\": \"string\""+          , "        , \"cli\": {"+          , "            \"input\": \"argument\""+          , "          , \"metavar\": \"GREETING\""+          , "          , \"required\": true"           , "}}}}}"           ]     (spec :: SUT.ConfigSpec ()) <- SUT.parseConfigSpec input@@ -186,4 +231,4 @@   ]  tests :: TestTree-tests = testGroup "plain" [option_tests, argument_tests]+tests = testGroup "plain" [resolver_tests, option_tests, argument_tests]

@@ -31,13 +31,16 @@     let config = resolveDefault spec     assertDefaultValue config ["greeting"] "hello default 1"   , testCase "default can be raw JSON value on entries spec" $ do-    let input = mconcat ["{\"etc/entries\": {", " \"greeting\": \"hello default 2\"}}"]+    let input = mconcat ["{\"etc/entries\": {\"greeting\": \"hello default 2\"}}"]     (spec :: ConfigSpec ()) <- parseConfigSpec input      let config = resolveDefault spec     assertDefaultValue config ["greeting"] "hello default 2"   , testCase "default can be a null JSON value" $ do-    let input = mconcat ["{\"etc/entries\": {", " \"greeting\": null}}"]+    let+      input = mconcat+        [ "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\":\"number\",\"default\":null}}}}"+        ]     (spec :: ConfigSpec ()) <- parseConfigSpec input      let config = resolveDefault spec

@@ -22,7 +22,7 @@   [ testCase "env entry is present when env var is defined" $ do     let input = mconcat           [ "{\"etc/entries\": {"-          , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}"+          , " \"greeting\":{\"etc/spec\":{\"type\":\"string\",\"env\":\"GREETING\"}}}}"           ]     (spec :: ConfigSpec ()) <- parseConfigSpec input @@ -40,7 +40,7 @@           , "\"" <> Text.pack jsonFilepath <> "\""           , "],"           , " \"etc/entries\": {"-          , " \"greeting\": { \"etc/spec\": { \"env\": \"GREETING\" }}}}"+          , " \"greeting\":{\"etc/spec\":{\"type\":\"string\",\"env\": \"GREETING\"}}}}"           ]     (spec :: ConfigSpec ()) <- parseConfigSpec input     (configFile, _)         <- resolveFiles spec@@ -56,10 +56,11 @@                                  ("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\" }}}}}"-          ]+    let+      input = mconcat+        [ "{\"etc/entries\": {"+        , " \"nested\":{\"greeting\":{ \"etc/spec\":{\"type\":\"string\",\"env\": \"GREETING\" }}}}}"+        ]     (spec :: ConfigSpec ()) <- parseConfigSpec input      let config = resolveEnvPure spec []@@ -71,4 +72,64 @@     assertEqual "expecting to not have an entry for key"                 (Nothing :: Maybe Text)                 (getConfigValue ["nested", "greeting"] config)+  , testCase "does parse numbers correctly" $ do+    let+      input = mconcat+        [ "{\"etc/entries\": {\"greeting\":{ \"etc/spec\":{\"type\":\"number\",\"env\": \"GREETING\"}}}}"+        ]+    (spec :: ConfigSpec ()) <- parseConfigSpec input++    let config = resolveEnvPure spec [("GREETING", "123")]++    assertEqual "expecting to not have an entry for key"+                (Just 123 :: Maybe Int)+                (getConfigValue ["greeting"] config)+  , testCase "does parse array of numbers correctly" $ do+    let+      input = mconcat+        [ "{\"etc/entries\": {\"greeting\":{ \"etc/spec\":{\"type\":\"[number]\",\"env\": \"GREETING\"}}}}"+        ]+    (spec :: ConfigSpec ()) <- parseConfigSpec input++    let config = resolveEnvPure spec [("GREETING", "[123, 456]")]++    assertEqual "expecting to not have an entry for key"+                (Just [123, 456] :: Maybe [Int])+                (getConfigValue ["greeting"] config)+  , testCase "does parse array of strings correctly" $ do+    let+      input = mconcat+        [ "{\"etc/entries\": {\"greeting\":{ \"etc/spec\":{\"type\":\"[string]\",\"env\": \"GREETING\"}}}}"+        ]+    (spec :: ConfigSpec ()) <- parseConfigSpec input++    let config = resolveEnvPure spec [("GREETING", "[\"hello\", \"world\"]")]++    assertEqual "expecting to not have an entry for key"+                (Just ["hello", "world"] :: Maybe [Text])+                (getConfigValue ["greeting"] config)+  , testCase "does parse array of bools correctly" $ do+    let+      input = mconcat+        [ "{\"etc/entries\": {\"greeting\":{ \"etc/spec\":{\"type\":\"[bool]\",\"env\": \"GREETING\"}}}}"+        ]+    (spec :: ConfigSpec ()) <- parseConfigSpec input++    let config = resolveEnvPure spec [("GREETING", "[false, true]")]++    assertEqual "expecting to not have an entry for key"+                (Just [False, True] :: Maybe [Bool])+                (getConfigValue ["greeting"] config)+  , testCase "does not add entries to config if env var value has invalid type" $ do+    let+      input = mconcat+        [ "{\"etc/entries\": {\"greeting\":{ \"etc/spec\":{\"type\":\"number\",\"env\": \"GREETING\"}}}}"+        ]+    (spec :: ConfigSpec ()) <- parseConfigSpec input++    let config = resolveEnvPure spec []++    assertEqual "expecting to not have an entry for key"+                (Nothing :: Maybe Int)+                (getConfigValue ["greeting"] config)   ]

@@ -6,9 +6,10 @@ module System.Etc.Resolver.FileTest (tests) where  import           RIO-import qualified RIO.Set    as Set-import qualified RIO.Text   as Text-import qualified RIO.Vector as Vector+import qualified RIO.Set            as Set+import qualified RIO.Text           as Text+import qualified RIO.Vector         as Vector+import qualified RIO.Vector.Partial as Vector (head)  import Test.Tasty       (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)@@ -32,6 +33,22 @@       Left (InvalidConfiguration _ _) -> return ()       _ ->         assertFailure ("Expecting InvalidConfigurationError; got instead " <> show espec)+  , testCase "fails when file has key not defined in spec" $ do+    jsonFilepath <- getDataFileName "test/fixtures/config.json"+    let input = "{\"etc/filepaths\": [\"" <> Text.pack jsonFilepath <> "\"]}"+    (spec :: ConfigSpec ()) <- parseConfigSpec input+    (_config, warnings)     <- resolveFiles spec+    assertBool "There should be warnings" (not $ null warnings)+    case fromException (Vector.head warnings) of+      Just (InvalidConfiguration _ errMsg) -> assertEqual+        "Expecting key not present in spec error"+        "Configuration entry `greeting` is not present on spec"+        errMsg++      err ->+        assertFailure+          $  "Expecting InvalidConfigurationError; got other error instead: "+          <> show err   , filePathsTests   , filesTest   ]@@ -54,7 +71,8 @@             , ", \"" <> Text.pack yamlFilepath <> "\""             , ", \"" <> Text.pack ymlFilepath <> "\"" #endif-          , "]}"+          , "]"+          , ", \"etc/entries\": {\"greeting\": \"hello default\"}}"           ]      (spec :: ConfigSpec ()) <- parseConfigSpec input@@ -101,7 +119,9 @@           [ "{\"etc/filepaths\": ["           , "\"" <> Text.pack jsonFilepath <> "\""           , ", \"unknown_file.json\""-          , "]}"+          , "]"+          , ", \"etc/entries\":{\"greeting\":\"hello default\"}"+          , "}"           ]      (spec :: ConfigSpec ()) <- parseConfigSpec input@@ -176,10 +196,11 @@     jsonFilepath <- getDataFileName "test/fixtures/config.json"     envFilePath  <- getDataFileName "test/fixtures/config.env.json"     let input = mconcat-          [ "{\"etc/files\": {"+          [ "{\"etc/files\":{"           , "  \"env\": \"ENV_FILE_TEST\","           , "  \"paths\": [\"" <> Text.pack jsonFilepath <> "\"]"-          , "}}"+          , "},"+          , "\"etc/entries\":{\"greeting\":\"hello default\"}}"           ]          envFileTest = "ENV_FILE_TEST"

@@ -7,6 +7,7 @@  import           RIO import qualified RIO.HashMap as HashMap+import qualified RIO.Vector  as Vector  import Test.Tasty       (TestTree, testGroup) import Test.Tasty.HUnit (assertBool, assertEqual, assertFailure, testCase)@@ -44,6 +45,22 @@     case parseConfigSpec input of       Nothing -> assertFailure "should not fail if no etc/entries key is present"       Just (_ :: ConfigSpec ()) -> assertBool "" True+  , testCase "fails when default JSON value doesn't correspond to type entry" $ do+    let+      input+        = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":[123],\"type\":\"[string]\"}}}}"++    case parseConfigSpec input of+      Left err -> case fromException err of+        Just (InvalidConfiguration{}) -> assertBool "" True++        _ ->+          assertFailure+            $  "expecting to get an InvalidConfiguration error; but got "+            <> show err++      Right (_ :: ConfigSpec ()) ->+        assertFailure "Expecting config spec parsing to fail, but didn't"   , testCase "entries cannot finish in an empty map" $ do     let input = "{\"etc/entries\":{\"greeting\":{}}}" @@ -63,13 +80,67 @@         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 that finish with arrays 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.Array (Vector.fromList [JSON.Number 123])))+        (defaultValue value)+  , testCase "entries with empty arrays as values fail because type cannot be infered" $ do+    let input = "{\"etc/entries\":{\"greeting\": []}}"+    case parseConfigSpec input of+      Left err -> case fromException err of+        Just (InvalidConfiguration{}) -> assertBool "" True+        _ ->+          assertFailure $ "expecting InvalidConfiguration error; got instead " <> show err++      Right (_configSpec :: ConfigSpec ()) ->+        assertFailure "expecting config spec parse to fail, but didn't"+  , testCase "entries with empty arrays as default values and a type do not fail" $ do+    let+      input+        = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":[],\"type\":\"[string]\"}}}}"+      keys = ["greeting"]++    config <- parseConfigSpec input+    case getConfigValue keys (specConfigValues config) of+      Nothing -> assertFailure+        (show keys ++ " should map to an array config value, got sub config map instead")++      Just (value :: ConfigValue ()) -> assertEqual+        "should contain default array value"+        (Just (JSON.Array (Vector.fromList [])))+        (defaultValue value)+  , testCase "entries with array of objects do not fail" $ do+    let+      input+        = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"default\":[{\"hello\":\"world\"}],\"type\":\"[object]\"}}}}"+      keys = ["greeting"]++    config <- parseConfigSpec input+    case getConfigValue keys (specConfigValues config) of+      Nothing -> assertFailure+        (show keys ++ " should map to an array config value, got sub config map instead")++      Just (value :: ConfigValue ()) -> assertEqual+        "should contain default array value"+        (Just+          (JSON.Array (Vector.fromList [JSON.object ["hello" JSON..= ("world" :: Text)]]))+        )+        (defaultValue value)   , testCase "entries can have many levels of nesting" $ do     let input = "{\"etc/entries\":{\"english\":{\"greeting\":\"hello\"}}}"         keys  = ["english", "greeting"]@@ -145,7 +216,7 @@    , testCase "cli option entry requires either short or long" $ do       let-        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\"}}}}}"+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\": \"string\", \"cli\":{\"input\":\"option\"}}}}}"        case parseConfigSpec input of         Just (result :: ConfigSpec ()) ->@@ -155,7 +226,7 @@    , 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\"}}}}}"+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\":\"string\",\"cli\":{\"input\":\"option\",\"short\":\"g\"}}}}}"         keys  = ["greeting"]        (config :: ConfigSpec ()) <- parseConfigSpec input@@ -163,9 +234,9 @@       let         result = do           value    <- getConfigValue keys (specConfigValues config)+          let valueType = configValueType value           PlainEntry metadata <- cliEntry (configSources value)           short <- optShort metadata-          valueType <- pure $ optValueType metadata           return (short, valueType)        case result of@@ -173,21 +244,21 @@           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+          assertEqual "should contain option type" (CVTSingle CVTString) 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\"}}}}}"+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\": \"string\",\"cli\":{\"input\":\"option\",\"long\":\"greeting\"}}}}}"         keys  = ["greeting"]        (config :: ConfigSpec ()) <- parseConfigSpec input        let         result = do-          value    <- getConfigValue keys (specConfigValues config)+          value  <- getConfigValue keys (specConfigValues config)+          let valueType = configValueType value           PlainEntry metadata <- cliEntry (configSources value)           long <- optLong metadata-          valueType <- pure $ optValueType metadata           return (long, valueType)        case result of@@ -195,11 +266,11 @@           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+          assertEqual "should contain option type" (CVTSingle CVTString) valueType    , testCase "cli entry accepts command" $ do       let-        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"type\":\"string\",\"commands\":[\"foo\"]}}}}}"+        input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\": \"string\",\"cli\":{\"input\":\"option\",\"long\":\"greeting\",\"commands\":[\"foo\"]}}}}}"         keys  = ["greeting"]        (config :: ConfigSpec Text) <- parseConfigSpec input@@ -207,9 +278,9 @@       let         result = do           value <- getConfigValue keys (specConfigValues config)+          let valueType = configValueType value           CmdEntry cmd metadata <- cliEntry (configSources value)           long <- optLong metadata-          valueType <- pure $ optValueType metadata           return (cmd, long, valueType)        case result of@@ -218,7 +289,7 @@         Just (cmd, long, valueType) -> do           assertEqual "should contain cmd" ["foo"] cmd           assertEqual "should contain long" "greeting" long-          assertEqual "should contain option type" StringOpt valueType+          assertEqual "should contain option type" (CVTSingle CVTString) valueType    , testCase "cli entry does not accept unrecognized keys" $ do       let@@ -238,8 +309,10 @@ envvar_tests = testGroup   "env"   [ testCase "env key creates an ENV source" $ do-      let input = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"env\":\"GREETING\"}}}}"-          keys  = ["greeting"]+      let+        input+          = "{\"etc/entries\":{\"greeting\":{\"etc/spec\":{\"type\": \"string\",\"env\":\"GREETING\"}}}}"+        keys = ["greeting"]        (config :: ConfigSpec ()) <- parseConfigSpec input 

@@ -1,4 +1,5 @@ etc/entries:   greeting:     etc/spec:+      type: string       env: "GREETING"