etc 0.4.0.0 → 0.4.0.1
raw patch · 6 files changed
+139/−75 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +5/−0
- etc.cabal +54/−54
- src/System/Etc/Internal/Extra/Printer.hs +74/−15
- src/System/Etc/Internal/Spec/Types.hs +3/−3
- test/System/Etc/Resolver/Cli/PlainTest.hs +1/−1
- test/System/Etc/SpecTest.hs +2/−2
CHANGELOG.md view
@@ -1,3 +1,8 @@+0.4.0.1+----++* Improve pretty printer for configuration values (closes #32)+ 0.4.0.0 ---- **BREAKING CHANGES**
etc.cabal view
@@ -1,11 +1,12 @@-name: etc-version: 0.4.0.0 cabal-version: >=1.10-build-type: Simple+name: etc+version: 0.4.0.1 license: MIT license-file: LICENSE copyright: 2017, 2018 Roman Gonzalez maintainer: open-source@roman-gonzalez.info+author: Roman Gonzalez+tested-with: ghc ==8.0.1 ghc ==8.0.2 ghc ==8.2.2 ghc ==8.4.2 homepage: https://github.com/roman/Haskell-etc synopsis: Declarative configuration spec for Haskell projects description:@@ -13,8 +14,7 @@ environment variables, files) using a declarative spec file that defines where these values are to be found and located in a configuration map. category: Configuration, System-author: Roman Gonzalez-tested-with: GHC ==8.0.1 GHC ==8.0.2 GHC ==8.2.2 GHC ==8.4.2+build-type: Simple data-files: test/fixtures/config.foo test/fixtures/config.json@@ -47,15 +47,38 @@ default: False library+ 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+ hs-source-dirs: src+ other-modules:+ Paths_etc+ default-language: Haskell2010+ ghc-options: -Wall+ build-depends:+ base >=4.7 && <5,+ aeson >=0.11,+ hashable >=1.2,+ rio >=0.0.1.0,+ text >=0.0.1.0,+ typed-process >=0.1.1,+ unliftio >=0.1.1.0 if flag(extra) exposed-modules: System.Etc.Internal.Extra.Printer System.Etc.Internal.Extra.EnvMisspell+ cpp-options: -DWITH_EXTRA build-depends: ansi-wl-pprint >=0.6, edit-distance >=0.2- cpp-options: -DWITH_EXTRA if flag(cli) exposed-modules:@@ -63,78 +86,55 @@ System.Etc.Internal.Resolver.Cli.Common System.Etc.Internal.Resolver.Cli.Plain System.Etc.Internal.Resolver.Cli.Command+ cpp-options: -DWITH_CLI build-depends: optparse-applicative >=0.12- cpp-options: -DWITH_CLI if flag(yaml) exposed-modules: System.Etc.Internal.Spec.YAML+ cpp-options: -DWITH_YAML build-depends: yaml >=0.8- cpp-options: -DWITH_YAML- 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- build-depends:- base >=4.7 && <5,- aeson >=0.11,- hashable >=1.2,- rio >=0.0.1.0,- text >=0.0.1.0,- typed-process >=0.1.1,- unliftio >=0.1.1.0- default-language: Haskell2010- hs-source-dirs: src++test-suite etc-testsuite+ type: exitcode-stdio-1.0+ main-is: TestSuite.hs+ hs-source-dirs: test other-modules: Paths_etc+ System.Etc.Resolver.DefaultTest+ System.Etc.Resolver.EnvTest+ System.Etc.Resolver.FileTest+ System.Etc.SpecTest+ System.Etc.ConfigTest+ default-language: Haskell2010 ghc-options: -Wall--test-suite etc-testsuite+ build-depends:+ base >=4.7,+ aeson >=0.11,+ rio >=0.0.1.0,+ tasty >=0.11,+ tasty-hunit >=0.9,+ etc -any if flag(cli)- build-depends:- optparse-applicative >=0.12 cpp-options: -DWITH_CLI other-modules: System.Etc.Resolver.CliTest System.Etc.Resolver.Cli.PlainTest System.Etc.Resolver.Cli.CommandTest+ build-depends:+ optparse-applicative >=0.12 if flag(yaml)+ cpp-options: -DWITH_YAML build-depends: yaml >=0.8- cpp-options: -DWITH_YAML if flag(extra)- build-depends:- edit-distance >=0.2 cpp-options: -DWITH_EXTRA other-modules: System.Etc.Extra.EnvMisspellTest- type: exitcode-stdio-1.0- main-is: TestSuite.hs- build-depends:- base >=4.7,- aeson >=0.11,- rio >=0.0.1.0,- tasty >=0.11,- tasty-hunit >=0.9,- etc -any- default-language: Haskell2010- hs-source-dirs: test- other-modules:- Paths_etc- System.Etc.Resolver.DefaultTest- System.Etc.Resolver.EnvTest- System.Etc.Resolver.FileTest- System.Etc.SpecTest- System.Etc.ConfigTest- ghc-options: -Wall+ build-depends:+ edit-distance >=0.2
src/System/Etc/Internal/Extra/Printer.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-} module System.Etc.Internal.Extra.Printer ( renderConfig , renderConfigColor@@ -9,12 +10,13 @@ , hPrintPrettyConfig ) where -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 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 RIO.Vector.Unsafe as Vector (unsafeHead) import qualified Data.Aeson as JSON @@ -30,16 +32,73 @@ 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+ 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.Array (Vector.null -> True) -> return $ text "[]"+ JSON.Array arr -> do+ -- unsafeHead is not unsafe here because of previous check; also we are+ -- assuming all values in the array are of the same type+ let h = Vector.unsafeHead arr+ case h of+ -- When rendering Objects within Arrays; output:+ --+ -- - hello: world+ -- hola: mundo+ -- - foo: bar+ -- baz: wat+ --+ JSON.Object{} -> do+ values <- forM arr $ \v -> do+ v1 <- renderConfigValueJSON v+ return $ hang 2 ("-" <+> v1)++ return $ align (vsep $ Vector.toList values)++ -- When rendering primitive values:+ --+ -- - hello+ -- - world+ --+ _ -> do+ values <- forM arr $ \v -> do+ v1 <- renderConfigValueJSON v+ return $ "-" <+> v1++ return $ align (vsep $ Vector.toList values)++ JSON.Object obj -> do+ values <- forM (HashMap.toList obj) $ \(k, v) -> case v of+ -- When rendering Objects within Objects; output:+ --+ -- attr1:+ -- attr2: hello+ --+ JSON.Object{} -> do+ v1 <- renderConfigValueJSON v+ return $ nest 2 (text (Text.unpack k) <> ":" <> hardline <> v1)++ -- When rendering Arrays within Objects; output:+ --+ -- attr1:+ -- - hello+ --+ JSON.Array{} -> do+ v1 <- renderConfigValueJSON v+ return $ text (Text.unpack k) <> ":" <> hardline <> v1++ -- When rendering primitive values+ --+ -- hello: world+ --+ --+ _ -> do+ v1 <- renderConfigValueJSON v+ return $ text (Text.unpack k) <> ":" <+> v1+ return $ align (vsep values)- _ -> Left $ "Trying to render Unsupported JSON value " `mappend` (tshow value)+ renderConfigValue :: (JSON.Value -> Either Text Doc) -> Value JSON.Value -> Either Text [Doc]
src/System/Etc/Internal/Spec/Types.hs view
@@ -244,7 +244,7 @@ inferErrorMsg = "could not infer type from given default value" parseBytesToConfigValueJSON :: ConfigValueType -> Text -> Maybe JSON.Value-parseBytesToConfigValueJSON cvType content = do+parseBytesToConfigValueJSON cvType content = case JSON.eitherDecodeStrict' (Text.encodeUtf8 content) of Right value | matchesConfigValueType value cvType -> return value | otherwise -> Nothing@@ -260,7 +260,7 @@ JSON.Array arr | null arr -> Left inferErrorMsg | otherwise -> case jsonToConfigValueType (Vector.head arr) of- Right (CVTArray{} ) -> Left "nested arrays values are not supported"+ Right CVTArray{} -> Left "nested arrays values are not supported" Right (CVTSingle ty) -> Right $ CVTArray ty Left err -> Left err _ -> Left inferErrorMsg@@ -319,7 +319,7 @@ if HashMap.size object == 1 then do -- 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+ let mDefaultValue = maybe Nothing Just $ HashMap.lookup "default" fieldSpec mSensitive <- fieldSpec .:? "sensitive" mCvType <- fieldSpec .:? "type" let sensitive = fromMaybe False mSensitive
test/System/Etc/Resolver/Cli/PlainTest.hs view
@@ -31,7 +31,7 @@ eConfig <- try $ SUT.resolvePlainCliPure spec "program" ["-g", "hello world"] case eConfig of- Left (SUT.CliEvalExited{}) -> assertBool "" True+ Left SUT.CliEvalExited{} -> assertBool "" True _ -> assertFailure $ "Expecting CliEvalExited error; got this instead " <> show eConfig ]
test/System/Etc/SpecTest.hs view
@@ -52,7 +52,7 @@ case parseConfigSpec input of Left err -> case fromException err of- Just (InvalidConfiguration{}) -> assertBool "" True+ Just InvalidConfiguration{} -> assertBool "" True _ -> assertFailure@@ -103,7 +103,7 @@ let input = "{\"etc/entries\":{\"greeting\": []}}" case parseConfigSpec input of Left err -> case fromException err of- Just (InvalidConfiguration{}) -> assertBool "" True+ Just InvalidConfiguration{} -> assertBool "" True _ -> assertFailure $ "expecting InvalidConfiguration error; got instead " <> show err