conferer 0.3.0.0 → 1.1.0.0
raw patch · 61 files changed
Files
- CHANGELOG.md +49/−0
- LICENSE +369/−17
- README.md +11/−11
- conferer.cabal +54/−29
- src/Conferer.hs +77/−102
- src/Conferer/Config.hs +37/−0
- src/Conferer/Config/Internal.hs +256/−0
- src/Conferer/Config/Internal/Types.hs +38/−0
- src/Conferer/Core.hs +0/−116
- src/Conferer/FromConfig.hs +43/−0
- src/Conferer/FromConfig/Basics.hs +0/−206
- src/Conferer/FromConfig/Internal.hs +486/−0
- src/Conferer/Key.hs +25/−0
- src/Conferer/Key/Internal.hs +103/−0
- src/Conferer/Provider/CLIArgs.hs +0/−43
- src/Conferer/Provider/Env.hs +0/−67
- src/Conferer/Provider/Files.hs +0/−21
- src/Conferer/Provider/Mapping.hs +0/−34
- src/Conferer/Provider/Namespaced.hs +0/−23
- src/Conferer/Provider/Null.hs +0/−18
- src/Conferer/Provider/PropertiesFile.hs +0/−54
- src/Conferer/Provider/Simple.hs +0/−34
- src/Conferer/Source.hs +18/−0
- src/Conferer/Source/CLIArgs.hs +76/−0
- src/Conferer/Source/Env.hs +84/−0
- src/Conferer/Source/Files.hs +25/−0
- src/Conferer/Source/InMemory.hs +44/−0
- src/Conferer/Source/Internal.hs +35/−0
- src/Conferer/Source/Namespaced.hs +43/−0
- src/Conferer/Source/Null.hs +32/−0
- src/Conferer/Source/PropertiesFile.hs +84/−0
- src/Conferer/Test.hs +24/−0
- src/Conferer/Types.hs +0/−118
- test/Conferer/ConfigSpec.hs +211/−0
- test/Conferer/FromConfig/BasicsSpec.hs +0/−88
- test/Conferer/FromConfig/BoolSpec.hs +26/−0
- test/Conferer/FromConfig/Extended.hs +148/−0
- test/Conferer/FromConfig/FileSpec.hs +81/−0
- test/Conferer/FromConfig/ListSpec.hs +171/−0
- test/Conferer/FromConfig/MaybeSpec.hs +33/−0
- test/Conferer/FromConfig/NumbersSpec.hs +29/−0
- test/Conferer/FromConfig/StringLikeSpec.hs +28/−0
- test/Conferer/FromConfigSpec.hs +14/−0
- test/Conferer/GenericsSpec.hs +55/−63
- test/Conferer/KeySpec.hs +39/−0
- test/Conferer/Provider/ArgsSpec.hs +0/−38
- test/Conferer/Provider/EnvSpec.hs +0/−41
- test/Conferer/Provider/MappingSpec.hs +0/−43
- test/Conferer/Provider/NamespacedSpec.hs +0/−21
- test/Conferer/Provider/NullSpec.hs +0/−13
- test/Conferer/Provider/PropertiesFileSpec.hs +0/−39
- test/Conferer/Provider/SimpleSpec.hs +0/−22
- test/Conferer/Source/CLIArgsSpec.hs +42/−0
- test/Conferer/Source/EnvSpec.hs +58/−0
- test/Conferer/Source/InMemorySpec.hs +32/−0
- test/Conferer/Source/NamespacedSpec.hs +25/−0
- test/Conferer/Source/NullSpec.hs +12/−0
- test/Conferer/Source/PropertiesFileSpec.hs +32/−0
- test/ConfererSpec.hs +37/−23
- test/ConfererSpecMain.hs +7/−0
- test/Spec.hs +1/−1
+ CHANGELOG.md view
@@ -0,0 +1,49 @@+# Changelog+All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),+and this project adheres to [PVP](https://pvp.haskell.org/).++## [Unreleased]++Nothing++## [v1.1.0.0] - 2021-03-01++### Changed++* Rename `fromFilePath` to `fromFilePath'`.+* Define a new `fromFilePath` whose type is `FilePath -> SourceCreator` instaed of `FilePath -> IO Source`.+* (Internal) Remove the mismatched type exception since it's not actionable by the user+* (Internal) Use a list for default values so that many different defaults are available,+ possible point of extension in the future.+* Constraint valid key names to lowercase ascii and numbers (previously some non ascii characters were allowed)++### Added++* `isValidKeyFragment` and `isKeyCharacter` to validate `Key`s+* Added an overriding method based on type and key (details in the docs)++## [v1.0.0.1] - 2021-01-17++### Fixed++* In the `File`'s `FromConfig` instance, if the default is present and it's type+is `File`, it throws, which doesn't follow the rest of the library.++### Added++* Add `mkConfig'` which allows creating a config by passing a list of defaults and+a list of source creators.+* Add `addSources`, which allows to add several sources to a config.+* Define the type `Defaults`, which is a list of associations from `Key` to+`Dynamic`.++## [v1.0.0.0] - 2020-12-29++First release++[Unreleased]: https://github.com/ludat/conferer/compare/conferer_v1.1.0.0...HEAD+[v1.1.0.0]: https://github.com/ludat/conferer/releases/tag/conferer_v1.0.0.1...conferer_v1.1.0.0+[v1.0.0.1]: https://github.com/ludat/conferer/releases/tag/conferer_v1.0.0.0...conferer_v1.0.0.1+[v1.0.0.0]: https://github.com/ludat/conferer/releases/tag/v0.0.0.0...conferer_v1.0.0.0
LICENSE view
@@ -1,21 +1,373 @@-MIT License+Mozilla Public License Version 2.0+================================== -Copyright (c) 2019 Lucas David Traverso+1. Definitions+-------------- -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:+1.1. "Contributor"+ means each individual or legal entity that creates, contributes to+ the creation of, or owns Covered Software. -The above copyright notice and this permission notice shall be included in all-copies or substantial portions of the Software.+1.2. "Contributor Version"+ means the combination of the Contributions of others (if any) used+ by a Contributor and that particular Contributor's Contribution. -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.+1.3. "Contribution"+ means Covered Software of a particular Contributor.++1.4. "Covered Software"+ means Source Code Form to which the initial Contributor has attached+ the notice in Exhibit A, the Executable Form of such Source Code+ Form, and Modifications of such Source Code Form, in each case+ including portions thereof.++1.5. "Incompatible With Secondary Licenses"+ means++ (a) that the initial Contributor has attached the notice described+ in Exhibit B to the Covered Software; or++ (b) that the Covered Software was made available under the terms of+ version 1.1 or earlier of the License, but not also under the+ terms of a Secondary License.++1.6. "Executable Form"+ means any form of the work other than Source Code Form.++1.7. "Larger Work"+ means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software.++1.8. "License"+ means this document.++1.9. "Licensable"+ means having the right to grant, to the maximum extent possible,+ whether at the time of the initial grant or subsequently, any and+ all of the rights conveyed by this License.++1.10. "Modifications"+ means any of the following:++ (a) any file in Source Code Form that results from an addition to,+ deletion from, or modification of the contents of Covered+ Software; or++ (b) any new file in Source Code Form that contains any Covered+ Software.++1.11. "Patent Claims" of a Contributor+ means any patent claim(s), including without limitation, method,+ process, and apparatus claims, in any patent Licensable by such+ Contributor that would be infringed, but for the grant of the+ License, by the making, using, selling, offering for sale, having+ made, import, or transfer of either its Contributions or its+ Contributor Version.++1.12. "Secondary License"+ means either the GNU General Public License, Version 2.0, the GNU+ Lesser General Public License, Version 2.1, the GNU Affero General+ Public License, Version 3.0, or any later versions of those+ licenses.++1.13. "Source Code Form"+ means the form of the work preferred for making modifications.++1.14. "You" (or "Your")+ means an individual or a legal entity exercising rights under this+ License. For legal entities, "You" includes any entity that+ controls, is controlled by, or is under common control with You. For+ purposes of this definition, "control" means (a) the power, direct+ or indirect, to cause the direction or management of such entity,+ whether by contract or otherwise, or (b) ownership of more than+ fifty percent (50%) of the outstanding shares or beneficial+ ownership of such entity.++2. License Grants and Conditions+--------------------------------++2.1. Grants++Each Contributor hereby grants You a world-wide, royalty-free,+non-exclusive license:++(a) under intellectual property rights (other than patent or trademark)+ Licensable by such Contributor to use, reproduce, make available,+ modify, display, perform, distribute, and otherwise exploit its+ Contributions, either on an unmodified basis, with Modifications, or+ as part of a Larger Work; and++(b) under Patent Claims of such Contributor to make, use, sell, offer+ for sale, have made, import, and otherwise transfer either its+ Contributions or its Contributor Version.++2.2. Effective Date++The licenses granted in Section 2.1 with respect to any Contribution+become effective for each Contribution on the date the Contributor first+distributes such Contribution.++2.3. Limitations on Grant Scope++The licenses granted in this Section 2 are the only rights granted under+this License. No additional rights or licenses will be implied from the+distribution or licensing of Covered Software under this License.+Notwithstanding Section 2.1(b) above, no patent license is granted by a+Contributor:++(a) for any code that a Contributor has removed from Covered Software;+ or++(b) for infringements caused by: (i) Your and any other third party's+ modifications of Covered Software, or (ii) the combination of its+ Contributions with other software (except as part of its Contributor+ Version); or++(c) under Patent Claims infringed by Covered Software in the absence of+ its Contributions.++This License does not grant any rights in the trademarks, service marks,+or logos of any Contributor (except as may be necessary to comply with+the notice requirements in Section 3.4).++2.4. Subsequent Licenses++No Contributor makes additional grants as a result of Your choice to+distribute the Covered Software under a subsequent version of this+License (see Section 10.2) or under the terms of a Secondary License (if+permitted under the terms of Section 3.3).++2.5. Representation++Each Contributor represents that the Contributor believes its+Contributions are its original creation(s) or it has sufficient rights+to grant the rights to its Contributions conveyed by this License.++2.6. Fair Use++This License is not intended to limit any rights You have under+applicable copyright doctrines of fair use, fair dealing, or other+equivalents.++2.7. Conditions++Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted+in Section 2.1.++3. Responsibilities+-------------------++3.1. Distribution of Source Form++All distribution of Covered Software in Source Code Form, including any+Modifications that You create or to which You contribute, must be under+the terms of this License. You must inform recipients that the Source+Code Form of the Covered Software is governed by the terms of this+License, and how they can obtain a copy of this License. You may not+attempt to alter or restrict the recipients' rights in the Source Code+Form.++3.2. Distribution of Executable Form++If You distribute Covered Software in Executable Form then:++(a) such Covered Software must also be made available in Source Code+ Form, as described in Section 3.1, and You must inform recipients of+ the Executable Form how they can obtain a copy of such Source Code+ Form by reasonable means in a timely manner, at a charge no more+ than the cost of distribution to the recipient; and++(b) You may distribute such Executable Form under the terms of this+ License, or sublicense it under different terms, provided that the+ license for the Executable Form does not attempt to limit or alter+ the recipients' rights in the Source Code Form under this License.++3.3. Distribution of a Larger Work++You may create and distribute a Larger Work under terms of Your choice,+provided that You also comply with the requirements of this License for+the Covered Software. If the Larger Work is a combination of Covered+Software with a work governed by one or more Secondary Licenses, and the+Covered Software is not Incompatible With Secondary Licenses, this+License permits You to additionally distribute such Covered Software+under the terms of such Secondary License(s), so that the recipient of+the Larger Work may, at their option, further distribute the Covered+Software under the terms of either this License or such Secondary+License(s).++3.4. Notices++You may not remove or alter the substance of any license notices+(including copyright notices, patent notices, disclaimers of warranty,+or limitations of liability) contained within the Source Code Form of+the Covered Software, except that You may alter any license notices to+the extent required to remedy known factual inaccuracies.++3.5. Application of Additional Terms++You may choose to offer, and to charge a fee for, warranty, support,+indemnity or liability obligations to one or more recipients of Covered+Software. However, You may do so only on Your own behalf, and not on+behalf of any Contributor. You must make it absolutely clear that any+such warranty, support, indemnity, or liability obligation is offered by+You alone, and You hereby agree to indemnify every Contributor for any+liability incurred by such Contributor as a result of warranty, support,+indemnity or liability terms You offer. You may include additional+disclaimers of warranty and limitations of liability specific to any+jurisdiction.++4. Inability to Comply Due to Statute or Regulation+---------------------------------------------------++If it is impossible for You to comply with any of the terms of this+License with respect to some or all of the Covered Software due to+statute, judicial order, or regulation then You must: (a) comply with+the terms of this License to the maximum extent possible; and (b)+describe the limitations and the code they affect. Such description must+be placed in a text file included with all distributions of the Covered+Software under this License. Except to the extent prohibited by statute+or regulation, such description must be sufficiently detailed for a+recipient of ordinary skill to be able to understand it.++5. Termination+--------------++5.1. The rights granted under this License will terminate automatically+if You fail to comply with any of its terms. However, if You become+compliant, then the rights granted under this License from a particular+Contributor are reinstated (a) provisionally, unless and until such+Contributor explicitly and finally terminates Your grants, and (b) on an+ongoing basis, if such Contributor fails to notify You of the+non-compliance by some reasonable means prior to 60 days after You have+come back into compliance. Moreover, Your grants from a particular+Contributor are reinstated on an ongoing basis if such Contributor+notifies You of the non-compliance by some reasonable means, this is the+first time You have received notice of non-compliance with this License+from such Contributor, and You become compliant prior to 30 days after+Your receipt of the notice.++5.2. If You initiate litigation against any entity by asserting a patent+infringement claim (excluding declaratory judgment actions,+counter-claims, and cross-claims) alleging that a Contributor Version+directly or indirectly infringes any patent, then the rights granted to+You by any and all Contributors for the Covered Software under Section+2.1 of this License shall terminate.++5.3. In the event of termination under Sections 5.1 or 5.2 above, all+end user license agreements (excluding distributors and resellers) which+have been validly granted by You or Your distributors under this License+prior to termination shall survive termination.++************************************************************************+* *+* 6. Disclaimer of Warranty *+* ------------------------- *+* *+* Covered Software is provided under this License on an "as is" *+* basis, without warranty of any kind, either expressed, implied, or *+* statutory, including, without limitation, warranties that the *+* Covered Software is free of defects, merchantable, fit for a *+* particular purpose or non-infringing. The entire risk as to the *+* quality and performance of the Covered Software is with You. *+* Should any Covered Software prove defective in any respect, You *+* (not any Contributor) assume the cost of any necessary servicing, *+* repair, or correction. This disclaimer of warranty constitutes an *+* essential part of this License. No use of any Covered Software is *+* authorized under this License except under this disclaimer. *+* *+************************************************************************++************************************************************************+* *+* 7. Limitation of Liability *+* -------------------------- *+* *+* Under no circumstances and under no legal theory, whether tort *+* (including negligence), contract, or otherwise, shall any *+* Contributor, or anyone who distributes Covered Software as *+* permitted above, be liable to You for any direct, indirect, *+* special, incidental, or consequential damages of any character *+* including, without limitation, damages for lost profits, loss of *+* goodwill, work stoppage, computer failure or malfunction, or any *+* and all other commercial damages or losses, even if such party *+* shall have been informed of the possibility of such damages. This *+* limitation of liability shall not apply to liability for death or *+* personal injury resulting from such party's negligence to the *+* extent applicable law prohibits such limitation. Some *+* jurisdictions do not allow the exclusion or limitation of *+* incidental or consequential damages, so this exclusion and *+* limitation may not apply to You. *+* *+************************************************************************++8. Litigation+-------------++Any litigation relating to this License may be brought only in the+courts of a jurisdiction where the defendant maintains its principal+place of business and such litigation shall be governed by laws of that+jurisdiction, without reference to its conflict-of-law provisions.+Nothing in this Section shall prevent a party's ability to bring+cross-claims or counter-claims.++9. Miscellaneous+----------------++This License represents the complete agreement concerning the subject+matter hereof. If any provision of this License is held to be+unenforceable, such provision shall be reformed only to the extent+necessary to make it enforceable. Any law or regulation which provides+that the language of a contract shall be construed against the drafter+shall not be used to construe this License against a Contributor.++10. Versions of the License+---------------------------++10.1. New Versions++Mozilla Foundation is the license steward. Except as provided in Section+10.3, no one other than the license steward has the right to modify or+publish new versions of this License. Each version will be given a+distinguishing version number.++10.2. Effect of New Versions++You may distribute the Covered Software under the terms of the version+of the License under which You originally received the Covered Software,+or under the terms of any subsequent version published by the license+steward.++10.3. Modified Versions++If you create software not governed by this License, and you want to+create a new license for such software, you may create and use a+modified version of this License if you rename the license and remove+any references to the name of the license steward (except to note that+such modified license differs from this License).++10.4. Distributing Source Code Form that is Incompatible With Secondary+Licenses++If You choose to distribute Source Code Form that is Incompatible With+Secondary Licenses under the terms of this version of the License, the+notice described in Exhibit B of this License must be attached.++Exhibit A - Source Code Form License Notice+-------------------------------------------++ This Source Code Form is subject to the terms of the Mozilla Public+ License, v. 2.0. If a copy of the MPL was not distributed with this+ file, You can obtain one at http://mozilla.org/MPL/2.0/.++If it is not possible or desirable to put the notice in a particular+file, then You may include the notice in a location (such as a LICENSE+file in a relevant directory) where a recipient would be likely to look+for such a notice.++You may add additional accurate notices of copyright ownership.++Exhibit B - "Incompatible With Secondary Licenses" Notice+---------------------------------------------------------++ This Source Code Form is "Incompatible With Secondary Licenses", as+ defined by the Mozilla Public License, v. 2.0.
README.md view
@@ -46,7 +46,7 @@ * Setting an environment variable called `AWESOMEAPP_SERVER_PORT=5555` * In a `config/dev.properties` file, you can have `server.port=5555` -And you may also get that value from different configuration providers like+And you may also get that value from different configuration sources like redis, json file, dhall file or whichever you may need. ## Example 2: many different values with defaults@@ -110,14 +110,14 @@ * `--hedis.host=redis.example.com`: set hedis' connection host to `redis.example.com` -## Existing providers+## Existing sources -Providers usually incur in many dependencies so they are split into different+Sources usually incur in many dependencies so they are split into different packages -* *[Json](https://hackage.haskell.org/package/conferer-provider-json)* (depends on `aeson`)-* *[Dhall](https://hackage.haskell.org/package/conferer-provider-dhall)* (depends on `dhall`)-* *[Yaml](https://hackage.haskell.org/package/conferer-provider-yaml)* (depends on `yaml`) +* *[Json](https://hackage.haskell.org/package/conferer-source-json)* (depends on `aeson`)+* *[Dhall](https://hackage.haskell.org/package/conferer-source-dhall)* (depends on `dhall`)+* *[Yaml](https://hackage.haskell.org/package/conferer-source-yaml)* (depends on `yaml`) ## Existing FromConfig instances @@ -131,17 +131,17 @@ ## Utilities -There are as well some utilities to change providers:+There are as well some utilities to change sources: -* `Conferer.Provider.Namespace`: All keys must be namespaced and the namespace+* `Conferer.Source.Namespace`: All keys must be namespaced and the namespace is striped for lookup-* `Conferer.Provider.Mapped`: Using a map key to maybe key you can change the+* `Conferer.Source.Mapped`: Using a map key to maybe key you can change the name of a key or even hiding some key-* `Conferer.Provider.Simple`: Get keys from a hardcoded map key to string+* `Conferer.Source.Simple`: Get keys from a hardcoded map key to string ## Future maybe things * Interpolate keys with other keys: `{a: "db", b: "${a}_thing"}`, getting `b` will give `"db_thing"` (maybe) even in different levels of configuration-* A LOT of providers+* A LOT of sources * A LOT of `FromConfig` implementations
conferer.cabal view
@@ -1,80 +1,105 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: e9e6edef27397421e3ed20cd7b4269e086ded2fc7fd679dac79be16cf923d188+-- hash: 80fdd520360a49e55b6dfe3ff9e148c716a7af0b6cf3d0326f8ed3d4a8f67611 name: conferer-version: 0.3.0.0+version: 1.1.0.0 synopsis: Configuration management library description: Library to abstract the parsing of many haskell config values from different config sources category: Configuration-homepage: https://github.com/ludat/conferer#readme+homepage: https://conferer.ludat.io author: Lucas David Traverso maintainer: lucas6246@gmail.com-copyright: MIT-license: BSD3+copyright: (c) 2020 Lucas David Traverso+license: MPL-2.0 license-file: LICENSE build-type: Simple extra-doc-files: README.md+ CHANGELOG.md LICENSE library exposed-modules: Conferer- Conferer.Core- Conferer.FromConfig.Basics- Conferer.Provider.CLIArgs- Conferer.Provider.Env- Conferer.Provider.Files- Conferer.Provider.Mapping- Conferer.Provider.Namespaced- Conferer.Provider.Null- Conferer.Provider.PropertiesFile- Conferer.Provider.Simple- Conferer.Types+ Conferer.Config+ Conferer.Config.Internal+ Conferer.Config.Internal.Types+ Conferer.FromConfig+ Conferer.FromConfig.Internal+ Conferer.Key+ Conferer.Key.Internal+ Conferer.Source+ Conferer.Source.CLIArgs+ Conferer.Source.Env+ Conferer.Source.Files+ Conferer.Source.InMemory+ Conferer.Source.Internal+ Conferer.Source.Namespaced+ Conferer.Source.Null+ Conferer.Source.PropertiesFile+ Conferer.Test other-modules: Paths_conferer hs-source-dirs: src- default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+ default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData+ ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns build-depends: base >=4.3 && <5 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.7 , directory >=1.2 && <2.0+ , filepath >=1.0 && <2.0 , text >=1.1 && <1.3+ if impl(ghc >= 8.4.1)+ ghc-options: -Wpartial-fields default-language: Haskell2010 test-suite specs type: exitcode-stdio-1.0- main-is: Spec.hs+ main-is: ConfererSpecMain.hs other-modules:- Conferer.FromConfig.BasicsSpec+ Conferer.ConfigSpec+ Conferer.FromConfig.BoolSpec+ Conferer.FromConfig.Extended+ Conferer.FromConfig.FileSpec+ Conferer.FromConfig.ListSpec+ Conferer.FromConfig.MaybeSpec+ Conferer.FromConfig.NumbersSpec+ Conferer.FromConfig.StringLikeSpec+ Conferer.FromConfigSpec Conferer.GenericsSpec- Conferer.Provider.ArgsSpec- Conferer.Provider.EnvSpec- Conferer.Provider.MappingSpec- Conferer.Provider.NamespacedSpec- Conferer.Provider.NullSpec- Conferer.Provider.PropertiesFileSpec- Conferer.Provider.SimpleSpec+ Conferer.KeySpec+ Conferer.Source.CLIArgsSpec+ Conferer.Source.EnvSpec+ Conferer.Source.InMemorySpec+ Conferer.Source.NamespacedSpec+ Conferer.Source.NullSpec+ Conferer.Source.PropertiesFileSpec ConfererSpec+ Spec Paths_conferer hs-source-dirs: test- default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables+ default-extensions: OverloadedStrings LambdaCase QuasiQuotes ScopedTypeVariables RecordWildCards StrictData+ ghc-options: -Wall -Wredundant-constraints -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -main-is ConfererSpecMain build-depends:- base >=4.3 && <5+ QuickCheck+ , base >=4.3 && <5 , bytestring >=0.10 && <0.11 , conferer , containers >=0.5 && <0.7 , deepseq , directory >=1.2 && <2.0+ , filepath >=1.0 && <2.0 , hspec , text >=1.1 && <1.3+ if impl(ghc >= 8.4.1)+ ghc-options: -Wpartial-fields default-language: Haskell2010
src/Conferer.hs view
@@ -1,117 +1,92 @@-{-# LANGUAGE DeriveGeneric #-} -- |--- Module: Conferer--- Copyright: (c) 2019 Lucas David Traverso--- License: MIT--- Maintainer: Lucas David Traverso <lucas6246@gmail.com>--- Stability: experimental+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable -- Portability: portable ----- Types and functions for managing configuration effectively+-- Public and stable API for the most basic usage of this library module Conferer ( - -- * How to use this library- -- | This is the most basic example: which uses the default configuration- -- to get a configuration for warp, which can be overriden via env vars,- -- command line arguments of @.properties@ files- --- -- @- -- import Conferer- -- import Conferer.FromConfig.Warp () -- from package conferer-warp- --- -- main = do- -- config <- 'defaultConfig' \"awesomeapp\"- -- warpSettings <- 'getFromConfig' \"warp\" config- -- runSettings warpSettings application- -- @- --- -- In the above example we see that we are getting a configuration value for- -- warp under the key warp, so for example to override it's default value- -- provided by warp the config keys for warp will always look like- -- @warp.something@, for example to override the port for warp (3000 by- -- default) we could call our program as @./my_program --warp.port=8000@.- --- -- There are two sides to conferer: Getting configuration for other libraries- -- like warp, hspec, snap, etc. and the way we choose to provide values like- -- json files, properties files, env vars, etc.+ -- * How to use this doc+ -- | This doc is mostly for reference, so you probably won't learn how to+ -- use conferer by reading it. For more detailed and guided documentation+ -- the best place is the webpage: <https://conferer.ludat.io/docs> - -- ** Getting configuration for existing libraries- -- | There is a typeclass 'FromConfig' that defines how to get a type- -- from a config, they are implemented in different packages since the- -- weight of the dependencies would be too high, the package is usually- -- named as @conferer-DEPENDENCY@ where DEPENDENCY is the name of the dependency (- -- for example: conferer-snap, conferer-warp, conferer-hspec), if you find- -- a library without a conferer port for its config you can create an issue- -- or maybe even create the library yourself!+ -- * Creating a Config+ mkConfig+ , mkConfig'+ -- * Getting values from a config+ -- | These functions allow you to get any type that implements 'FromConfig'+ , fetch+ , fetch'+ , fetchKey+ , fetchFromConfig+ , safeFetchKey+ , unsafeFetchKey+ , DefaultConfig(..)+ , FromConfig+ -- * Some useful types+ , Config+ , Key+ ) where - -- ** Providing key value pairs for configuration- -- | There is one important type in conferer: 'Config' from which, given a key- -- (eg: @warp@) you can get anything that implements 'FromConfig' (like- -- 'Warp.Settings')- --- -- Internally a 'Config' is made of many 'Provider's which have a simpler- -- interface:- --- -- @- -- 'getKeyInProvider' :: Provider -> Key -> IO (Maybe Text)- -- @- --- -- Most configuration providers can be abstracted away as Map String String,- -- and they can use whatever logic they want to turn conferer keys (a list of- -- strings) into a place to look for a string, (for example the env provider- -- requires a string to namespace the env vars that can affect the- -- configuration)- --- -- Once you have your 'Provider' you can add it to a 'Config' using the- -- 'addProvider' function. One final note: each provider has a different- -- priority, which depends on when is was added to the config ('Provider's- -- added later have lower priority) so the config searches keys in providers- -- in the same order they were added.+import Data.Text (Text)+import Data.Typeable (Typeable) - module Conferer.Types- , module Conferer.Core- , defaultConfig- , defaultConfigWithDefaults- , Key(..)+import Conferer.Config.Internal+import Conferer.Config.Internal.Types+import Conferer.FromConfig.Internal+import Conferer.Key+import qualified Conferer.Source.Env as Env+import qualified Conferer.Source.CLIArgs as Cli+import qualified Conferer.Source.PropertiesFile as PropertiesFile+import Conferer.Config (Defaults) - -- * Providers- , module Conferer.Provider.Env- , module Conferer.Provider.Simple- , module Conferer.Provider.Namespaced- , module Conferer.Provider.Mapping- , module Conferer.Provider.CLIArgs- , module Conferer.Provider.Null- , module Conferer.Provider.PropertiesFile- -- * Re-Exports- , (&)- ) where+-- | Use the 'FromConfig' instance to get a value of type @a@ from the config+-- using some default fallback. The most common use for this is creating a custom+-- record and using this function to fetch it at initialization time.+--+-- This function throws only parsing exceptions when the values are present+-- but malformed somehow (@"abc"@ as an Int) but that depends on the 'FromConfig'+-- implementation for the type.+fetch :: forall a. (FromConfig a, Typeable a, DefaultConfig a) => Config -> IO a+fetch c = fetchFromRootConfigWithDefault c configDef -import Data.Text (Text)-import Data.Function ((&))+-- | Same as 'fetch' but it accepts the default as a parameter instead of using+-- the default from 'configDef'+fetch' :: forall a. (FromConfig a, Typeable a) => Config -> a -> IO a+fetch' = fetchFromRootConfigWithDefault -import Conferer.Core (emptyConfig, addProvider, getFromConfig, getFromRootConfig, getFromConfigWithDefault, safeGetFromConfig, safeGetFromConfigWithDefault, getKey, unsafeGetKey, (/.), withDefaults)-import Conferer.Types (Config, Key(..), ProviderCreator, Provider(..), DefaultConfig(..), FromConfig(..))-import Conferer.Provider.Env-import Conferer.Provider.Simple-import Conferer.Provider.Namespaced-import Conferer.Provider.Mapping-import Conferer.Provider.CLIArgs-import Conferer.Provider.Null-import Conferer.Provider.PropertiesFile+-- | Same as 'fetch'' but you can specify a 'Key' instead of the root key which allows+-- you to fetch smaller values when you need them instead of a big one at+-- initialization time.+fetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> a -> IO a+fetchKey = fetchFromConfigWithDefault --- | Default config which reads from command line arguments, env vars and--- property files-defaultConfig :: Text -> IO Config-defaultConfig appName =- defaultConfigWithDefaults appName []+-- | Same as 'fetchKey' but it returns a 'Nothing' when the value isn't present+safeFetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> IO (Maybe a)+safeFetchKey c k = fetchFromConfig k c --- | Default config which reads from command line arguments, env vars,--- property files and some default key/values-defaultConfigWithDefaults :: Text -> [(Key, Text)] -> IO Config-defaultConfigWithDefaults appName configMap =- pure (emptyConfig & withDefaults configMap)- >>= addProvider (mkCLIArgsProvider)- >>= addProvider (mkEnvProvider appName)- >>= addProvider (mkPropertiesFileProvider)+-- | Same as 'fetchKey' but it throws when the value isn't present.+unsafeFetchKey :: forall a. (FromConfig a, Typeable a) => Config -> Key -> IO a+unsafeFetchKey c k = fetchFromConfig k c ++-- | Create a 'Config' which reads from command line arguments, env vars and+-- property files that depend on the environment (@config/development.properties@)+-- by default+mkConfig :: Text -> IO Config+mkConfig appName =+ pure emptyConfig+ >>= addSource (Cli.fromConfig)+ >>= addSource (Env.fromConfig appName)+ >>= addSource (PropertiesFile.fromConfig "config.file")++-- | Create a 'Config' with the given defaults and source creators.+-- The sources will take precedence by the order they have in the list (earlier in+-- the list means it's tried first).+-- If the requested key is not found in any source it'll be looked up in the defaults.+mkConfig' :: Defaults -> [SourceCreator] -> IO Config+mkConfig' defaults sources = addSources sources . addDefaults defaults $ emptyConfig
+ src/Conferer/Config.hs view
@@ -0,0 +1,37 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API providing Config functionality+module Conferer.Config+ (+ -- * Data+ Config+ -- * Querying a config+ , getKey+ , KeyLookupResult(..)+ , listSubkeys+ -- * Config creation and initialization+ , emptyConfig+ , addSource+ , addSources+ , addDefault+ , addDefaults+ , addKeyMappings+ , removeDefault+ , Defaults+ -- * Re-Exports+ , module Conferer.Key+ , (&)+ ) where++import Conferer.Config.Internal+import Conferer.Config.Internal.Types+import Conferer.Key+import Data.Function+import Data.Dynamic (Dynamic)++type Defaults = [(Key, Dynamic)]
+ src/Conferer/Config/Internal.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE TypeApplications #-}+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module providing Config functionality+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+module Conferer.Config.Internal where++import Control.Monad (foldM, forM, msum)+import Data.Dynamic+import Data.List (sort, nub, union)+import Data.Text (Text)+import Data.Maybe (isJust)+import qualified Data.Map as Map++import Conferer.Key+import Conferer.Source.Internal+import Conferer.Config.Internal.Types++-- | This function runs lookups on the 'Config', first in 'Source's in order and+-- then on the 'Dynamic' based defaults.+getKey :: Key -> Config -> IO KeyLookupResult+getKey key config = do+ let possibleKeys = getKeysFromMappings (configKeyMappings config) key+ untilJust (fmap (\MappedKey{..} -> getRawKeyInSources mappedKey config) possibleKeys)+ >>= \case+ Just (k, textResult) ->+ return $ FoundInSources k textResult+ Nothing ->+ case msum $ fmap (\MappedKey{..} -> fmap (mappedKey,) $ (getKeyFromDefaults mappedKey config)) possibleKeys of+ Just (k, dynResult) -> return $ FoundInDefaults k dynResult+ Nothing -> return $ MissingKey [key]++-- | Alias for a mapping from one key to another used for transforming keys+type KeyMapping = (Key, Key)++-- | A key that has been transformed using one or many 'KeyMapping's, so that+-- that process can be reversed.+data MappedKey = MappedKey+ { mappingsChain :: [KeyMapping]+ , mappedKey :: Key+ } deriving (Show, Eq)+++-- | This function lists all available keys under some key, that could be fetched+-- successfully.+listSubkeys :: Key -> Config -> IO [Key]+listSubkeys originalKey Config{..} = do+ let mappedKeys = getKeysFromMappings configKeyMappings originalKey+ subkeysFromSources <- forM mappedKeys $ \MappedKey{..} -> do+ subkeysFromSources <- listRawSubkeysInSources mappedKey configSources+ let subkeysFromDefaults =+ filter (mappedKey `isKeyPrefixOf`) $ Map.keys configDefaults+ return $ fmap (MappedKey mappingsChain) $ subkeysFromSources ++ subkeysFromDefaults+ let subkeys = mconcat subkeysFromSources+ return $ sort $ nub $ fmap undoMappings subkeys++-- | This function lists subkeys in some 'Source's and combines the results+listRawSubkeysInSources :: Key -> [Source] -> IO [Key]+listRawSubkeysInSources mappedKey configSources = go mappedKey [] configSources+ where+ go :: Key -> [Key] -> [Source] -> IO [Key]+ go _ result [] = return result+ go k result (source:otherSources) = do+ subkeys <- getSubkeysInSource source k+ go k (result `union` subkeys) otherSources++-- | This function reverses the mappings in a 'MappedKey' to retrieve the+-- original key.+--+-- Assumes that mappings were really used, otherwise it ignores bad values+undoMappings :: MappedKey -> Key+undoMappings MappedKey{..} =+ go (reverse mappingsChain) mappedKey+ where+ go [] key = key+ go ((src, dest):others) key =+ case stripKeyPrefix dest key of+ Just k -> go others (src /. k)+ Nothing -> go others key++-- | This utility function run a list of IO actions and returns the+-- first that return a 'Just', if no one does, returns 'Nothing'+untilJust :: [IO (Maybe a)] -> IO (Maybe a)+untilJust actions = go actions+ where+ go [] = return Nothing+ go (action:rest) = do+ action+ >>= \case+ Just res -> return $ Just res+ Nothing -> go rest++-- | This function tries to apply a list of mappings to a key meaning+-- replace the prefix with the new value from the mapping, if the mapping+-- isn't a prefix that mapping is ignored+--+-- This function always terminates even in presence of recursive mappings,+-- since it removes the mapping after it was first used, and that causes that+-- eventually the function will run out of keymappings and terminate.+getKeysFromMappings :: [KeyMapping] -> Key -> [MappedKey]+getKeysFromMappings originalKeyMappings originalKey =+ go (MappedKey [] originalKey) originalKeyMappings+ where+ go :: MappedKey -> [KeyMapping] -> [MappedKey]+ go k [] = [k]+ go currKey keyMappings =+ nub $+ currKey :+ mconcat (+ fmap generateDerivedKeys $+ findAndSplitList tryMappingKey+ keyMappings)+ where+ tryMappingKey :: (Key, Key) -> Maybe MappedKey+ tryMappingKey (source, dest) =+ case stripKeyPrefix source (mappedKey currKey) of+ Just aKey ->+ Just $ MappedKey (mappingsChain currKey ++ [(source, dest)]) (dest /. aKey)+ Nothing -> Nothing+ generateDerivedKeys :: ([KeyMapping], MappedKey, [KeyMapping]) -> [MappedKey]+ generateDerivedKeys (prevMappings, aKey, nextMappings) =+ go aKey $ prevMappings ++ nextMappings++-- | This utility function splits a list based on a @cond@ function and returns a tuple+-- of previous value, next values and the mapped found value.+findAndSplitList :: forall a b. (a -> Maybe b) -> [a] -> [([a], b, [a])]+findAndSplitList cond list = go [] list+ where+ go :: [a] -> [a] -> [([a], b, [a])]+ go _ [] = []+ go prevElems (curElem:nextElems) =+ case cond curElem of+ Just res ->+ (prevElems, res, nextElems) : go (curElem:prevElems) nextElems+ Nothing ->+ go (curElem:prevElems) nextElems++-- | This function gets a value from 'Source's but ignores mappings and defaults+getRawKeyInSources :: Key -> Config -> IO (Maybe (Key, Text))+getRawKeyInSources k Config{..} =+ go configSources+ where+ go [] = return Nothing+ go (source:otherSources) = do+ res <- getKeyInSource source k+ case res of+ Just t -> return $ Just (k, t)+ Nothing -> go otherSources++-- | This function gets values from the defaults+getKeyFromDefaults :: Key -> Config -> Maybe [Dynamic]+getKeyFromDefaults key Config{..} =+ let+ possibleKeys = fmap mappedKey $ getKeysFromMappings configKeyMappings key+ in msum $ fmap (\k -> Map.lookup k configDefaults) possibleKeys++-- | The empty configuration, this 'Config' is used as the base for+-- most config creating functions.+emptyConfig :: Config+emptyConfig = Config+ { configSources = []+ , configDefaults = Map.empty+ , configKeyMappings = []+ }++-- | This function adds some key mappings to a 'Config'+addKeyMappings :: [KeyMapping] -> Config -> Config+addKeyMappings keyMappings config =+ config+ { configKeyMappings = configKeyMappings config ++ keyMappings+ }++-- | This function adds defaults to a 'Config'+addDefaults :: [(Key, Dynamic)] -> Config -> Config+addDefaults configMap config =+ let+ constructedMap =+ Map.fromListWith (++)+ . fmap (\(k,v) -> (k, [v]))+ $ configMap+ in config+ { configDefaults =+ Map.unionWith (++) constructedMap+ $ configDefaults config+ }++-- | This function removes a default from a 'Config', this is the+-- oposite of 'addDefault', it deletes the first element of+-- matching type in a certain 'Key'.+removeDefault :: forall t. Typeable t => Key -> Config -> Config+removeDefault key config =+ config+ { configDefaults =+ Map.update removeFirstDynamic key $ configDefaults config+ }+ where+ removeFirst :: (a -> Bool) -> [a] -> [a]+ removeFirst _ [] = []+ removeFirst condition (x:xs) =+ if condition x+ then xs+ else x : removeFirst condition xs++ removeFirstDynamic :: [Dynamic] -> Maybe [Dynamic]+ removeFirstDynamic dynamics =+ let result = removeFirst (isJust . fromDynamic @t) dynamics+ in if null result+ then Nothing + else Just result++-- | This function adds one default of a custom type to a 'Config'+--+-- Note that unlike 'addDefaults' this function does the toDyn so+-- no need to do it on the user's side+addDefault :: (Typeable a) => Key -> a -> Config -> Config+addDefault key value config =+ config+ { configDefaults = Map.insertWith (++) key [toDyn value] $ configDefaults config+ }++-- | Instantiate a 'Source' using an 'SourceCreator' and a 'Config' and add+-- to the config+addSource :: SourceCreator -> Config -> IO Config+addSource mkSource config = do+ newSource <- mkSource config+ return $+ config+ { configSources = configSources config ++ [ newSource ]+ }++-- | Instantiate several 'Source's using a 'SourceCreator's and a 'Config' and add+-- them to the config in the order defined by the list+addSources :: [SourceCreator] -> Config -> IO Config+addSources sources config = foldM (flip addSource) config sources++-- orElse :: IO KeyLookupResult -> IO KeyLookupResult -> IO KeyLookupResult+-- orElse getKey1 getKey2 = do+-- result1 <- getKey1+-- case result1 of+-- MissingKey _ -> getKey2+-- FoundInSources _ _ -> return result1+-- FoundInDefaults _ _ -> do+-- result2 <- getKey2+-- case result2 of+-- MissingKey _ -> return result1+-- FoundInSources _ _ -> return result2+-- FoundInDefaults _ _ -> return result1
+ src/Conferer/Config/Internal/Types.hs view
@@ -0,0 +1,38 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Core types for Config (here because of depedency cycles)+module Conferer.Config.Internal.Types where++import Data.Map (Map)+import Conferer.Key (Key)+import Data.Dynamic ( Dynamic )+import Conferer.Source.Internal (Source)+import Data.Text (Text)++-- | This type acts as the entry point for most of the library, it's main purpouse+-- is to expose a uniform interface into multiple configuration sources (such as+-- env vars, cli args, and many others including use defined ones using the+-- 'Source' interface)+data Config =+ Config+ { configSources :: [Source]+ , configDefaults :: Map Key [Dynamic]+ , configKeyMappings :: [(Key, Key)]+ } deriving (Show)++-- | Result of a key lookup in a 'Config'+data KeyLookupResult+ = MissingKey [Key]+ | FoundInSources Key Text+ | FoundInDefaults Key [Dynamic]+ deriving (Show)++-- | The type for creating a source given a 'Config', some sources require a+-- certain configuration to be initialized (for example: the redis source+-- needs connection info to connect to the server)+type SourceCreator = Config -> IO Source
− src/Conferer/Core.hs
@@ -1,116 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleContexts #-}-module Conferer.Core where--import Data.Text (Text)-import qualified Data.Text as Text-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Maybe (fromMaybe)-import Data.Typeable (Typeable, Proxy(..), typeRep)-import Control.Exception (try, throw, throwIO, evaluate)--import Conferer.Provider.Simple-import Conferer.Types---- | Most Basic function to interact directly with a 'Config'. It always returns--- 'Text' in the case of success and implements the logic to traverse--- providers inside the 'Config'.-getKey :: Key -> Config -> IO (Maybe Text)-getKey k config =- go $ providers config ++ [mkPureMapProvider (defaults config)]- where- go [] = return Nothing- go (provider:providers) = do- res <- getKeyInProvider provider k- case res of- Just t -> return $ Just t- Nothing -> go providers----- | Fetch a value from a config under some specific key that's parsed using the 'FromConfig'--- instance, and as a default it uses the value from 'DefaultConfig'.------ Notes:--- - This function may throw an exception if parsing fails for any subkey-getFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO a-getFromConfig key config =- getFromConfigWithDefault key config configDef---- | Same as 'getFromConfig' using the root key------ Notes:--- - This function may throw an exception if parsing fails for any subkey-getFromRootConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Config -> IO a-getFromRootConfig config =- getFromConfig "" config----- | Same as 'getFromConfig' but with a user defined default (instead of 'DefaultConfig' instance)------ Useful for fetching primitive types-getFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO a-getFromConfigWithDefault key config configDefault =- safeGetFromConfigWithDefault key config configDefault- >>= \case- Just value -> do- evaluate value- Nothing ->- throwIO $ FailedToFetchError key (typeRep (Proxy :: Proxy a))---- | Fetch a value from a config key that's parsed using the FromConfig instance.------ Note: This function does not use default so the value must be fully defined by the config only,--- meaning using this function for many records will always result in 'Nothing' (if the record contains--- a value that can never be retrieved like a function)-safeGetFromConfig :: forall a. (Typeable a, FromConfig a, DefaultConfig a) => Key -> Config -> IO (Maybe a)-safeGetFromConfig key config =- safeGetFromConfigWithDefault key config configDef---- | Same as 'safeGetFromConfig' but with a user defined default-safeGetFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Key -> Config -> a -> IO (Maybe a)-safeGetFromConfigWithDefault key config configDefault = do- totalValue <- evaluate =<< fetchFromConfig key config- case totalValue of- Just value -> do- Just <$> evaluate value- Nothing -> do- result :: Either FailedToFetchError a <- try . (evaluate =<<) . updateFromConfig key config $ configDefault- case result of- Right a -> Just <$> evaluate a- Left e -> return Nothing---- | Create a new 'Key' by concatenating two existing keys.-(/.) :: Key -> Key -> Key-parent /. child = Path (unKey parent ++ unKey child)---- | The empty configuration, this 'Config' is used as the base for--- most config creating functions.-emptyConfig :: Config-emptyConfig = Config [] Map.empty--withDefaults :: [(Key, Text)] -> Config -> Config-withDefaults configMap config =- config { defaults = Map.fromList configMap }---- | Instantiate a 'ProviderCreator' using the 'emptyConfig'-mkStandaloneProvider :: ProviderCreator -> IO Provider-mkStandaloneProvider mkProvider =- mkProvider emptyConfig----- | Instantiate a 'Provider' using an 'ProviderCretor' and a 'Config' and add--- to the config-addProvider :: ProviderCreator -> Config -> IO Config-addProvider mkProvider config = do- newProvider <- mkProvider config- return $- config- { providers = providers config ++ [ newProvider ]- }---- | Same as 'getKey' but it throws if the 'Key' isn't found-unsafeGetKey :: Key -> Config -> IO Text-unsafeGetKey key config =- fromMaybe (throw $ FailedToFetchError key (typeRep (Proxy :: Proxy Text)))- <$> getKey key config
+ src/Conferer/FromConfig.hs view
@@ -0,0 +1,43 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module providing FromConfig functionality+module Conferer.FromConfig + ( FromConfig(fromConfig)+ , fetchFromConfig+ , DefaultConfig(configDef)+ , fetchFromConfigWithDefault+ , fetchFromRootConfig+ , fetchFromRootConfigWithDefault++ , fetchFromConfigByIsString+ , fetchFromConfigByRead+ , fetchFromConfigWith+ , addDefaultsAfterDeconstructingToDefaults++ , MissingRequiredKey+ , throwMissingRequiredKey+ , missingRequiredKey++ , ConfigParsingError+ , throwConfigParsingError+ , configParsingError++ , Key+ , (/.)+ , File(..)+ , KeyLookupResult(..)+ , OverrideFromConfig(..)+ , overrideFetch++ , fetchFromDefaults+ , fetchRequiredFromDefaults+ ) where++import Conferer.FromConfig.Internal+import Conferer.Config.Internal.Types+import Conferer.Key
− src/Conferer/FromConfig/Basics.hs
@@ -1,206 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Conferer.FromConfig.Basics where--import Control.Monad (join)-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text-import Data.ByteString (ByteString)-import Data.Maybe (fromMaybe)-import Control.Exception-import Data.Char (toLower)-import Data.Typeable (Typeable, typeRep, Proxy(..))-import Data.String (IsString, fromString)-import Text.Read (readMaybe)-import GHC.Generics--import Conferer.Types-import Conferer.Core (getKey, (/.), getFromConfig)--updateAllAtOnceUsingFetch :: forall a. (FromConfig a, Typeable a) => Key -> Config -> a -> IO a-updateAllAtOnceUsingFetch key config old = do- fetchFromConfig key config- >>= \case- Just new -> do- evaluate new- Nothing -> do- evaluate old--instance FromConfig Int where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigByRead--instance FromConfig Integer where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigByRead--instance FromConfig Float where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigByRead--instance FromConfig ByteString where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)--instance DefaultConfig (Maybe a) where- configDef = Nothing-instance (FromConfig a) => FromConfig (Maybe a) where- updateFromConfig k config (Just a) = do- res <- updateFromConfig k config a- Just <$> evaluate res- updateFromConfig k config Nothing = do- fetchFromConfig k config- fetchFromConfig k config = do- fetchFromConfig @a k config- >>= \case- Just res -> Just <$> Just <$> evaluate res- Nothing -> return $ Just Nothing---instance FromConfig String where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigWith (Just . Text.unpack)--instance FromConfig Text where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigWith Just---instance FromConfig Bool where- updateFromConfig = updateAllAtOnceUsingFetch- fetchFromConfig = fetchFromConfigWith parseBool--parseBool text =- case Text.toLower text of- "false" -> Just False- "true" -> Just True- _ -> Nothing--updateFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> a -> IO (a)-updateFromConfigByRead = updateFromConfigWith (readMaybe . Text.unpack)--updateFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> a -> IO (a)-updateFromConfigByIsString = updateFromConfigWith (Just . fromString . Text.unpack)--fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO (Maybe a)-fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)--fetchFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> IO (Maybe a)-fetchFromConfigByIsString = fetchFromConfigWith (Just . fromString . Text.unpack)--fromValueWith :: (Text -> Maybe a) -> Text -> Maybe a-fromValueWith parseValue valueAsText = parseValue valueAsText--fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO (Maybe a)-fetchFromConfigWith parseValue key config = do- getKey key config >>=- \case- Just value ->- return $ Just $- fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $- fromValueWith parseValue value- Nothing ->- return Nothing--updateFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> a -> IO a-updateFromConfigWith parseValue key config a = do- getKey key config >>=- \case- Just value ->- return $- fromMaybe (throw $ ConfigParsingError key value (typeRep (Proxy :: Proxy a))) $- fromValueWith parseValue value- Nothing -> return a---- | Concatenate many transformations to the config based on keys and functions-findKeyAndApplyConfig ::- forall newvalue config.- FromConfig newvalue- => Config -- ^ Complete config- -> Key -- ^ Key that indicates the part of the config that we care about- -> Key -- ^ Key that we use to find the config (usually concatenating with the- -- other key)- -> (config -> newvalue) -- ^ Function that knows how to use the- -- value to update the config- -> (newvalue -> config -> config) -- ^ Function that knows how to use the- -- value to update the config- -> config -- ^ Result of the last config updating- -> IO config -- ^ Updated config-findKeyAndApplyConfig config k relativeKey get set customConfig = do- newValue <- updateFromConfig @newvalue (k /. relativeKey) config (get customConfig)- return $ set newValue customConfig--instance FromConfigG inner =>- FromConfigG (D1 metadata inner) where- updateFromConfigG key config (M1 inner) =- M1 <$> updateFromConfigG key config inner- fetchFromConfigG key config =- fmap M1 <$> fetchFromConfigG key config--instance (FromConfigWithConNameG inner, Constructor constructor) =>- FromConfigG (C1 constructor inner) where- updateFromConfigG key config (M1 inner) =- M1 <$> updateFromConfigWithConNameG @inner (conName @constructor undefined) key config inner- fetchFromConfigG key config =- fmap M1 <$> fetchFromConfigWithConNameG @inner (conName @constructor undefined) key config--class FromConfigWithConNameG f where- updateFromConfigWithConNameG :: String -> Key -> Config -> f a -> IO (f a)- fetchFromConfigWithConNameG :: String -> Key -> Config -> IO (Maybe (f a))--instance (FromConfigWithConNameG left, FromConfigWithConNameG right) =>- FromConfigWithConNameG (left :*: right) where- updateFromConfigWithConNameG s key config (left :*: right) = do- leftValue <- updateFromConfigWithConNameG @left s key config left- rightValue <- updateFromConfigWithConNameG @right s key config right- return (leftValue :*: rightValue)-- fetchFromConfigWithConNameG s key config = do- leftValue <- fetchFromConfigWithConNameG @left s key config- rightValue <- fetchFromConfigWithConNameG @right s key config- case (leftValue, rightValue) of- (Just l, Just r) -> return $ Just (l :*: r)- _ -> return Nothing--instance (FromConfigG inner, Selector selector) =>- FromConfigWithConNameG (S1 selector inner) where- updateFromConfigWithConNameG s key config (M1 inner) =- let- applyFirst :: (Char -> Char) -> Text -> Text- applyFirst f t = case Text.uncons t of- Just (c, ts) -> Text.cons (f c) ts- Nothing -> t-- fieldName = Text.pack $ selName @selector undefined- prefix = applyFirst toLower $ Text.pack s- scopedKey =- case Text.stripPrefix prefix fieldName of- Just stripped -> applyFirst toLower stripped- Nothing -> fieldName- in M1 <$> updateFromConfigG @inner (key /. Path [scopedKey]) config inner-- fetchFromConfigWithConNameG s key config =- let- applyFirst :: (Char -> Char) -> Text -> Text- applyFirst f t = case Text.uncons t of- Just (c, ts) -> Text.cons (f c) ts- Nothing -> t-- fieldName = Text.pack $ selName @selector undefined- prefix = applyFirst toLower $ Text.pack s- scopedKey =- case Text.stripPrefix prefix fieldName of- Just stripped -> applyFirst toLower stripped- Nothing -> fieldName- in fmap M1 <$> fetchFromConfigG @inner (key /. Path [scopedKey]) config---- | Purely 'Generics' machinery, ignore...-instance (FromConfig inner) => FromConfigG (Rec0 inner) where- updateFromConfigG key config (K1 inner) = do- K1 <$> updateFromConfig @inner key config inner- fetchFromConfigG key config = do- fmap K1 <$> fetchFromConfig @inner key config
+ src/Conferer/FromConfig/Internal.hs view
@@ -0,0 +1,486 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module providing FromConfig functionality+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE AllowAmbiguousTypes #-}++module Conferer.FromConfig.Internal where++import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import Control.Exception+import Data.Typeable+import Text.Read (readMaybe)+import Data.Dynamic+import GHC.Generics+import Data.Function ((&))++import Conferer.Key+import Conferer.Config.Internal.Types+import Conferer.Config.Internal+import qualified Data.Char as Char+import Control.Monad (forM)+import Data.Maybe (fromMaybe, mapMaybe)+import qualified System.FilePath as FilePath+import Data.List (nub, foldl', sort)+import Data.String (IsString(..))+import Data.Foldable (msum)++-- | The typeclass for defining the way to get values from a 'Config', hiding the+-- 'Text' based nature of the 'Conferer.Source.Source's and parse whatever value+-- as the types sees fit+--+-- Some of these instances are provided in different packages to avoid the heavy+-- dependencies.+--+-- It provides a reasonable default using 'Generic's so most of the time user need+-- not to implement this typeclass.+class FromConfig a where+ -- | This function uses a 'Config' and a scoping 'Key' to get a value.+ --+ -- Some conventions:+ --+ -- * When some 'Key' is missing this function should throw 'MissingRequiredKey'+ --+ -- * For any t it should hold that @fetchFromConfig k (config & addDefault k t) == t@+ -- meaning that a default on the same key with the right type should be used as a+ -- default and with no configuration that value should be returned+ --+ -- * Try desconstructing the value in as many keys as possible since is allows easier+ -- partial overriding.+ fromConfig :: Key -> Config -> IO a+ default fromConfig :: (Typeable a, Generic a, IntoDefaultsG (Rep a), FromConfigG (Rep a)) => Key -> Config -> IO a+ fromConfig key config = do+ let configWithDefaults = case fetchFromDefaults @a key config of+ Just d -> config & addDefaults (intoDefaultsG key $ from d)+ Nothing -> config+ to <$> fromConfigG key configWithDefaults++fetchFromConfig :: forall a. (FromConfig a, Typeable a) => Key -> Config -> IO a+fetchFromConfig key config =+ case fetchFromDefaults @(OverrideFromConfig a) key config of+ Just (OverrideFromConfig fetch) ->+ fetch key $ removeDefault @(OverrideFromConfig a) key config+ Nothing ->+ fromConfig key config++-- | Utility only typeclass to smooth the naming differences between default values for+-- external library settings+--+-- This typeclass is not used internally it's only here for convinience for users+class DefaultConfig a where+ configDef :: a++instance {-# OVERLAPPABLE #-} Typeable a => FromConfig a where+ fromConfig = fetchRequiredFromDefaults++instance FromConfig () where+ fromConfig _key _config = return ()++instance FromConfig String where+ fromConfig = fetchFromConfigWith (Just . Text.unpack)++instance {-# OVERLAPPABLE #-} (Typeable a, FromConfig a) =>+ FromConfig [a] where+ fromConfig key config = do+ keysForItems <- getSubkeysForItems+ case keysForItems of+ Nothing -> do+ fetchRequiredFromDefaults @[a] key config+ Just subkeys -> do+ let configWithDefaults :: Config =+ case fetchFromDefaults @[a] key config of+ Just defaults ->+ foldl' (\c (index, value) ->+ c & addDefault (key /. "defaults" /. mkKey (show index)) value) config+ $ zip [0 :: Integer ..] defaults+ Nothing -> config+ forM subkeys $ \k -> do+ fetchFromConfig @a (key /. k)+ (if isKeyPrefixOf (key /. "defaults") (key /. k)+ then+ configWithDefaults+ else+ configWithDefaults & addKeyMappings [(key /. k, key /. "prototype")])+ where+ getSubkeysForItems :: IO (Maybe [Key])+ getSubkeysForItems = do+ fetchFromConfig @(Maybe Text) (key /. "keys") config+ >>= \case+ Just rawKeys -> do+ return $+ Just $+ nub $+ filter (/= "") $+ mkKey .+ Text.unpack <$>+ Text.split (== ',') rawKeys+ Nothing -> do+ subelements <-+ sort+ . nub+ . filter (not . (`elem` ["prototype", "keys", "defaults"]))+ . mapMaybe (\k -> case rawKeyComponents <$> stripKeyPrefix key k of+ Just (subkey:_) -> Just $ fromText subkey+ _ -> Nothing)+ <$> listSubkeys key config+ return $ if null subelements then Nothing else Just subelements++instance FromConfig Int where+ fromConfig = fetchFromConfigByRead++instance FromConfig Integer where+ fromConfig = fetchFromConfigByRead++instance FromConfig Float where+ fromConfig = fetchFromConfigByRead++instance FromConfig BS.ByteString where+ fromConfig = fetchFromConfigWith (Just . Text.encodeUtf8)++instance FromConfig LBS.ByteString where+ fromConfig = fetchFromConfigWith (Just . LBS.fromStrict . Text.encodeUtf8)++instance forall a. (Typeable a, FromConfig a) => FromConfig (Maybe a) where+ fromConfig key config = do+ let+ configWithUnwrappedDefault =+ case fetchFromDefaults @(Maybe a) key config of+ Just (Just defaultThing) -> do+ config & addDefault key defaultThing+ _ -> do+ config+ (Just <$> fetchFromConfig @a key configWithUnwrappedDefault)+ `catch` (\(_e :: MissingRequiredKey) -> return Nothing)++instance FromConfig Text where+ fromConfig = fetchFromConfigWith Just++instance FromConfig Bool where+ fromConfig = fetchFromConfigWith parseBool++-- | A newtype wrapper for a 'FilePath' to allow implementing 'FromConfig'+-- with something better than just a 'String'+newtype File =+ File FilePath+ deriving (Show, Eq, Ord, Read)++unFile :: File -> FilePath+unFile (File f) = f++instance IsString File where+ fromString s = File s++instance FromConfig File where+ fromConfig key config = do+ let defaultPath = fetchFromDefaults @File key config++ filepath <- fetchFromConfig @(Maybe String) key config++ extension <- fetchFromConfig @(Maybe String) (key /. "extension") config+ dirname <- fetchFromConfig @(Maybe String) (key /. "dirname") config+ basename <- fetchFromConfig @(Maybe String) (key /. "basename") config+ filename <- fetchFromConfig @(Maybe String) (key /. "filename") config++ let+ constructedFilePath =+ applyIfPresent FilePath.replaceDirectory dirname+ $ applyIfPresent FilePath.replaceBaseName basename+ $ applyIfPresent FilePath.replaceExtension extension+ $ applyIfPresent FilePath.replaceFileName filename+ $ fromMaybe (unFile $ fromMaybe "" defaultPath) filepath+ if FilePath.isValid constructedFilePath+ then return $ File constructedFilePath+ else throwMissingRequiredKeys @String+ [ key+ , key /. "extension"+ , key /. "dirname"+ , key /. "basename"+ , key /. "filename"+ ]+ where+ applyIfPresent f maybeComponent =+ (\fp -> maybe fp (f fp) maybeComponent)++-- | Helper function to parse a 'Bool' from 'Text'+parseBool :: Text -> Maybe Bool+parseBool text =+ case Text.toLower text of+ "false" -> Just False+ "true" -> Just True+ _ -> Nothing++data OverrideFromConfig a =+ OverrideFromConfig (Key -> Config -> IO a)++-- | Allow the programmer to override this 'FromConfig' instance by providing+-- a special 'OverrideFromConfig' value.+--+-- To avoid infinite recursion we remove the Override before calling the value++-- | Helper function to implement fetchFromConfig using the 'Read' instance+fetchFromConfigByRead :: (Typeable a, Read a) => Key -> Config -> IO a+fetchFromConfigByRead = fetchFromConfigWith (readMaybe . Text.unpack)++-- | Helper function to implement fetchFromConfig using the 'IsString' instance+fetchFromConfigByIsString :: (Typeable a, IsString a) => Key -> Config -> IO a+fetchFromConfigByIsString = fetchFromConfigWith (Just . fromString . Text.unpack)++-- | Helper function to implement fetchFromConfig using some parsing function+fetchFromConfigWith :: forall a. Typeable a => (Text -> Maybe a) -> Key -> Config -> IO a+fetchFromConfigWith parseValue key config = do+ getKey key config >>=+ \case+ MissingKey k -> do+ throwMissingRequiredKeys @a k++ FoundInSources k value ->+ case parseValue value of+ Just a -> do+ return a+ Nothing -> do+ throwConfigParsingError @a k value++ FoundInDefaults k dynamics ->+ case fromDynamics dynamics of+ Just a -> do+ return a+ Nothing -> do+ throwMissingRequiredKeys @a [k]++fromDynamics :: forall a. Typeable a => [Dynamic] -> Maybe a+fromDynamics =+ msum . fmap (fromDynamic @a)++-- | Helper function does the plumbing of desconstructing a default into smaller+-- defaults, which is usefull for nested 'fetchFromConfig'.+addDefaultsAfterDeconstructingToDefaults+ :: forall a.+ Typeable a =>+ -- | Function to deconstruct the value+ (a -> [(Key, Dynamic)]) ->+ -- | Key where to look for the value+ Key ->+ -- | The config+ Config ->+ IO Config+addDefaultsAfterDeconstructingToDefaults destructureValue key config = do+ case fetchFromDefaults @a key config of+ Just value -> do+ let newDefaults =+ ((\(k, d) -> (key /. k, d)) <$> destructureValue value)+ return $+ addDefaults newDefaults config+ Nothing -> do+ return config++-- | Helper function to override the fetching function for a certain key.+--+-- This function creates a 'Dynamic' that when added to the defaults allows+-- overriding the default 'FromConfig' instance.+overrideFetch :: forall a. Typeable a => (Key -> Config -> IO a) -> Dynamic+overrideFetch f =+ toDyn @(OverrideFromConfig a) $ OverrideFromConfig f++-- | Exception to show that a value couldn't be parsed properly+data ConfigParsingError =+ ConfigParsingError Key Text TypeRep+ deriving (Typeable, Eq)++instance Exception ConfigParsingError+instance Show ConfigParsingError where+ show (ConfigParsingError key value aTypeRep) =+ concat+ [ "Couldn't parse value '"+ , Text.unpack value+ , "' from key '"+ , show key+ , "' as "+ , show aTypeRep+ ]++-- | Helper function to throw 'ConfigParsingError'+throwConfigParsingError :: forall a b. (Typeable a) => Key -> Text -> IO b+throwConfigParsingError key text =+ throwIO $ configParsingError @a key text++-- | Helper function to create a 'ConfigParsingError'+configParsingError :: forall a. (Typeable a) => Key -> Text -> ConfigParsingError+configParsingError key text =+ ConfigParsingError key text $ typeRep (Proxy :: Proxy a)++-- | Exception to show that some non optional 'Key' was missing while trying+-- to 'fetchFromConfig'+data MissingRequiredKey =+ MissingRequiredKey [Key] TypeRep+ deriving (Typeable, Eq)++instance Exception MissingRequiredKey+instance Show MissingRequiredKey where+ show (MissingRequiredKey keys aTypeRep) =+ concat+ [ "Failed to get a '"+ , show aTypeRep+ , "' from keys: "+ , Text.unpack+ $ Text.intercalate ", "+ $ fmap (Text.pack . show)+ $ keys++ ]++-- | Simplified helper function to throw a 'MissingRequiredKey'+throwMissingRequiredKey :: forall t a. Typeable t => Key -> IO a+throwMissingRequiredKey key =+ throwMissingRequiredKeys @t [key]++-- | Simplified helper function to create a 'MissingRequiredKey'+missingRequiredKey :: forall t. Typeable t => Key -> MissingRequiredKey+missingRequiredKey key =+ missingRequiredKeys @t [key]++-- | Helper function to throw a 'MissingRequiredKey'+throwMissingRequiredKeys :: forall t a. Typeable t => [Key] -> IO a+throwMissingRequiredKeys keys =+ throwIO $ missingRequiredKeys @t keys++-- | Helper function to create a 'MissingRequiredKey'+missingRequiredKeys :: forall a. (Typeable a) => [Key] -> MissingRequiredKey+missingRequiredKeys keys =+ MissingRequiredKey keys (typeRep (Proxy :: Proxy a))++-- | Fetch from value from the defaults map of a 'Config' or else throw+fetchRequiredFromDefaults :: forall a. (Typeable a) => Key -> Config -> IO a+fetchRequiredFromDefaults key config =+ case fetchFromDefaults key config of+ Nothing -> do+ throwMissingRequiredKey @a key+ Just a ->+ return a++-- | Fetch from value from the defaults map of a 'Config' or else return a 'Nothing'+fetchFromDefaults :: forall a. (Typeable a) => Key -> Config -> Maybe a+fetchFromDefaults key config =+ getKeyFromDefaults key config+ >>= fromDynamics @a++-- | Same as 'fetchFromConfig' using the root key+fetchFromRootConfig :: forall a. (FromConfig a, Typeable a) => Config -> IO a+fetchFromRootConfig =+ fetchFromConfig ""++-- | Same as 'fetchFromConfig' but adding a user defined default before 'fetchFromConfig'ing+-- so it doesn't throw a MissingKeyError+fetchFromConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Config -> Key -> a -> IO a+fetchFromConfigWithDefault config key configDefault =+ fetchFromConfig key (config & addDefault key configDefault)++-- | Same as 'fetchFromConfigWithDefault' using the root key+fetchFromRootConfigWithDefault :: forall a. (Typeable a, FromConfig a) => Config -> a -> IO a+fetchFromRootConfigWithDefault config configDefault =+ fetchFromRootConfig (config & addDefault "" configDefault)++-- | Purely 'Generic's machinery, ignore...+class FromConfigG f where+ fromConfigG :: Key -> Config -> IO (f a)++instance FromConfigG inner =>+ FromConfigG (D1 metadata inner) where+ fromConfigG key config = do+ M1 <$> fromConfigG key config++instance (FromConfigWithConNameG inner, Constructor constructor) =>+ FromConfigG (C1 constructor inner) where+ fromConfigG key config =+ M1 <$> fromConfigWithConNameG @inner (conName @constructor undefined) key config++-- | Purely 'Generic's machinery, ignore...+class FromConfigWithConNameG f where+ fromConfigWithConNameG :: String -> Key -> Config -> IO (f a)++instance (FromConfigWithConNameG left, FromConfigWithConNameG right) =>+ FromConfigWithConNameG (left :*: right) where+ fromConfigWithConNameG s key config = do+ leftValue <- fromConfigWithConNameG @left s key config+ rightValue <- fromConfigWithConNameG @right s key config+ return (leftValue :*: rightValue)++instance (FromConfigG inner, Selector selector) =>+ FromConfigWithConNameG (S1 selector inner) where+ fromConfigWithConNameG s key config =+ let+ applyFirst :: (Char -> Char) -> Text -> Text+ applyFirst f t = case Text.uncons t of+ Just (c, ts) -> Text.cons (f c) ts+ Nothing -> t++ fieldName = Text.pack $ selName @selector undefined+ prefix = applyFirst Char.toLower $ Text.pack s+ scopedKey =+ case Text.stripPrefix prefix fieldName of+ Just stripped -> applyFirst Char.toLower stripped+ Nothing -> fieldName+ in M1 <$> fromConfigG @inner (key /. fromText scopedKey) config++instance (FromConfig inner, Typeable inner) => FromConfigG (Rec0 inner) where+ fromConfigG key config = do+ K1 <$> fetchFromConfig @inner key config++-- | Purely 'Generic's machinery, ignore...+class IntoDefaultsG f where+ intoDefaultsG :: Key -> f a -> [(Key, Dynamic)]++instance IntoDefaultsG inner =>+ IntoDefaultsG (D1 metadata inner) where+ intoDefaultsG key (M1 inner) =+ intoDefaultsG key inner++instance (IntoDefaultsWithConNameG inner, Constructor constructor) =>+ IntoDefaultsG (C1 constructor inner) where+ intoDefaultsG key (M1 inner) =+ intoDefaultsWithConNameG @inner (conName @constructor undefined) key inner++-- | Purely 'Generic's machinery, ignore...+class IntoDefaultsWithConNameG f where+ intoDefaultsWithConNameG :: String -> Key -> f a -> [(Key, Dynamic)]++instance (IntoDefaultsWithConNameG left, IntoDefaultsWithConNameG right) =>+ IntoDefaultsWithConNameG (left :*: right) where+ intoDefaultsWithConNameG s key (left :*: right) = do+ intoDefaultsWithConNameG @left s key left+ +++ intoDefaultsWithConNameG @right s key right++instance (IntoDefaultsG inner, Selector selector) =>+ IntoDefaultsWithConNameG (S1 selector inner) where+ intoDefaultsWithConNameG s key (M1 inner) =+ let+ applyFirst :: (Char -> Char) -> Text -> Text+ applyFirst f t = case Text.uncons t of+ Just (c, ts) -> Text.cons (f c) ts+ Nothing -> t++ fieldName = Text.pack $ selName @selector undefined+ prefix = applyFirst Char.toLower $ Text.pack s+ scopedKey =+ case Text.stripPrefix prefix fieldName of+ Just stripped -> applyFirst Char.toLower stripped+ Nothing -> fieldName+ in intoDefaultsG @inner (key /. fromText scopedKey) inner++instance (Typeable inner) => IntoDefaultsG (Rec0 inner) where+ intoDefaultsG key (K1 inner) = do+ [(key, toDyn inner)]
+ src/Conferer/Key.hs view
@@ -0,0 +1,25 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API for Key related features+module Conferer.Key+ ( Key+ -- * Creating 'Key's+ , mkKey+ , fromText+ -- * Maniputaing 'Key's+ , (/.)+ , stripKeyPrefix+ , isKeyPrefixOf+ , isValidKeyFragment+ , isKeyCharacter+ -- * Introspecting 'Key's+ , rawKeyComponents+ , unconsKey+ ) where++import Conferer.Key.Internal
+ src/Conferer/Key/Internal.hs view
@@ -0,0 +1,103 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module for Key related features+module Conferer.Key.Internal where++import Data.String (IsString(..))+import Data.Text (Text)+import qualified Data.Text as Text+import Data.Function (on)+import Data.List (stripPrefix, isPrefixOf)+import qualified Data.Char as Char+-- | This type is used extensivelly as a way to point into a 'Conferer.Source.Source'+-- and in turn into a 'Conferer.Config.Config'. The intended way to create them is+-- is using 'mkKey'.+--+-- It's a list of alphanumeric words and each 'Conferer.Source.Source' can interpret+-- it as it sees fit.+newtype Key = Key+ { unKey :: [Text]+ } deriving (Eq, Ord)++instance Show Key where+ show key = "\"" ++ Text.unpack (keyName key) ++ "\""++instance IsString Key where+ fromString = mkKey++-- | Helper function to create 'Key's, this function always works, but+-- since 'Key's reject some string this function transforms the input+-- to provide lawful 'Key's instead of throwing.+--+-- For example:+--+-- > 'mkKey' "sOmE.KEy" == "some.key"+-- > 'mkKey' "1.key" == "1.key"+-- > 'mkKey' "1_thing.key" == "1thing.key"+-- > 'mkKey' "some....key" == "some.key"+-- > 'mkKey' ".." == ""+mkKey :: String -> Key+mkKey s =+ Key .+ filter (/= mempty) .+ fmap (Text.filter isKeyCharacter . Text.toLower) .+ Text.split (== '.') .+ fromString+ $ s++-- | Same as 'mkKey' but for 'Text'+fromText :: Text -> Key+fromText = mkKey . Text.unpack++-- | Collapse a key into a textual representation+keyName :: Key -> Text+keyName = Text.intercalate "." . unKey++-- | This function tells if a key is a subkey of another key based+-- using key fragments instead of letters as units+--+-- > 'isKeyPrefixOf' "foo" "foo.bar" == True+-- > 'isKeyPrefixOf' "foo" "foo" == True+-- > 'isKeyPrefixOf' "foo" "fooa" == False+isKeyPrefixOf :: Key -> Key -> Bool+isKeyPrefixOf = isPrefixOf `on` unKey++-- | Given k1 and k2 this function drops k1 as a prefix from k2, if+-- k1 is not a prefix of k2 it returns 'Nothing'+--+-- > 'keyPrefixOf' "foo" "foo.bar" == Just "bar"+-- > 'keyPrefixOf' "foo" "foo" == Just ""+-- > 'keyPrefixOf' "foo" "fooa" == Nothing+-- > 'keyPrefixOf' "" k == Just k+stripKeyPrefix :: Key -> Key -> Maybe Key+stripKeyPrefix key1 key2 = Key <$> (stripPrefix `on` unKey) key1 key2++-- | Concatenate two keys+(/.) :: Key -> Key -> Key+parent /. child = Key (unKey parent ++ unKey child)++-- | Get raw components from a key, usually to do some manipulation+rawKeyComponents :: Key -> [Text]+rawKeyComponents = unKey++-- | Get first component of a key and the rest of the key+unconsKey :: Key -> Maybe (Text, Key)+unconsKey (Key []) = Nothing+unconsKey (Key (k:ks)) = Just (k, Key ks)++-- | Check if a 'Text' is a valid fragment of a 'Key', meaning+-- that each character 'isKeyCharacter'+isValidKeyFragment :: Text -> Bool+isValidKeyFragment t =+ (not $ Text.null t) && Text.all isKeyCharacter t++-- | Checks if the given 'Char' is a valid for a 'Key'.+-- Meaning it is a lower case ascii letter or a number.+isKeyCharacter :: Char -> Bool+isKeyCharacter c =+ Char.isAsciiLower c || Char.isDigit c
− src/Conferer/Provider/CLIArgs.hs
@@ -1,43 +0,0 @@-module Conferer.Provider.CLIArgs- (- -- * Command line arguments Provider- -- | This provider provides keys from the command line arguments passed into- -- the program. It only accepts arguments with @--@ and an equals, for- -- example: @./awesomeapp --warp.port=5000@- mkCLIArgsProvider- , mkCLIArgsProvider'- , parseArgsIntoKeyValue- )-where--import Data.Text (Text)-import qualified Data.Text as Text-import Data.Maybe (mapMaybe)-import Data.String (fromString)-import System.Environment (getArgs)--import Conferer.Types-import Conferer.Provider.Simple----- | Create a 'ProviderCreator' for CLIArgs from a argument list-mkCLIArgsProvider' :: [String] -> ProviderCreator-mkCLIArgsProvider' args = \config -> do- let configMap = parseArgsIntoKeyValue args- mkMapProvider configMap config---- | Same as 'mkCLIArgsProvider'' but using 'getArgs' to provide the argument--- list-mkCLIArgsProvider :: ProviderCreator-mkCLIArgsProvider = \config -> do- args <- getArgs- mkCLIArgsProvider' args config---- | Parse an argument list into a dictionary suitable for a 'Provider'-parseArgsIntoKeyValue :: [String] -> [(Key, Text)]-parseArgsIntoKeyValue =- fmap (\(k, s) -> (fromString $ Text.unpack k, s)) .- fmap (\s -> fmap (Text.drop 1) $ Text.breakOn "=" s).- mapMaybe (Text.stripPrefix "--") .- takeWhile (/= "--") .- fmap Text.pack
− src/Conferer/Provider/Env.hs
@@ -1,67 +0,0 @@-module Conferer.Provider.Env- (--- * Env Provider--- | This 'Provider' provides config values from env vars given a prefix that's--- used to avoid colliding with different system configuration------ For example if you use the 'Prefix' "awesomeapp" and get the 'Key'--- "warp.port" this provider will try to lookup the env var called--- @AWESOMEAPP_WARP_PORT@.---- * Usage--- | To use this provider simply choose a prefix and add it using the--- 'addProvider' function like:------ @--- config & 'addProvider' ('mkEnvProvider' "awesomeapp")--- @- mkEnvProvider- , mkEnvProvider'- , Prefix- , LookupEnvFunc- , keyToEnvVar- ) where---import Data.Text (Text)-import qualified Data.Text as Text-import qualified System.Environment as System--import Conferer.Types---- | 'ProviderCreator' for env 'Provider' that uses the real 'System.lookupEnv'--- function-mkEnvProvider :: Prefix -> ProviderCreator-mkEnvProvider prefix =- mkEnvProvider' System.lookupEnv prefix---- | 'ProviderCreator' for env 'Provider' that allows parameterizing the--- function used to lookup for testing-mkEnvProvider' :: LookupEnvFunc -> Prefix -> ProviderCreator-mkEnvProvider' lookupEnv prefix = \_config ->- return $- Provider- { getKeyInProvider = \k -> do- let envVarName = Text.unpack $ keyToEnvVar prefix k- fmap Text.pack <$> lookupEnv envVarName- }---- | Type alias for the function to lookup env vars-type LookupEnvFunc = String -> IO (Maybe String)----- | A text to namespace env vars-type Prefix = Text---- | Get the env name from a prefix and a key by uppercasing and--- intercalating underscores------ >>> keyToEnVar "awesomeapp" "warp.port"--- "AWESOMEAPP_WARP_PORT"-keyToEnvVar :: Prefix -> Key -> Text-keyToEnvVar prefix (Path keys) =- Text.toUpper- $ Text.intercalate "_"- $ filter (/= mempty)- $ prefix : keys-
− src/Conferer/Provider/Files.hs
@@ -1,21 +0,0 @@-module Conferer.Provider.Files where--import qualified Data.Text as Text-import Data.Maybe (fromMaybe)--import Conferer.Types-import Conferer.FromConfig.Basics ()--fromRight :: a -> Either e a -> a-fromRight a (Left _) = a-fromRight _ (Right a) = a--getFilePathFromEnv :: Config -> String -> IO FilePath-getFilePathFromEnv config extension = do- env <- updateFromConfig "env" config "development"- return $ mconcat- [ "config/"- , Text.unpack env- , "."- , extension- ]
− src/Conferer/Provider/Mapping.hs
@@ -1,34 +0,0 @@-module Conferer.Provider.Mapping- (- -- * Namespaced higher-order provider- -- | This provider takes a provider and returns a new provider that- -- always transforms the key according to either a function for- -- 'mkMappingProvider'' or a 'Map' for 'mkMappingProvider'- mkMappingProvider- , mkMappingProvider'- )-where--import Data.Map (Map)-import qualified Data.Map as Map--import Conferer.Types---- | Create a 'ProviderCreator' using a function to transform the supplied keys--- and another 'ProviderCreator'-mkMappingProvider' :: (Key -> Maybe Key) -> ProviderCreator -> ProviderCreator-mkMappingProvider' mapper providerCreator config = do- configProvider <- providerCreator config-- return $ Provider- { getKeyInProvider = \k -> do- case mapper k of- Just newKey -> getKeyInProvider configProvider newKey- Nothing -> return Nothing- }---- | Create a 'ProviderCreator' using a 'Map' 'Key' 'Key' to transform the supplied keys--- and another 'ProviderCreator'-mkMappingProvider :: Map Key Key -> ProviderCreator -> ProviderCreator-mkMappingProvider configMap configProvider =- mkMappingProvider' (`Map.lookup` configMap) configProvider
− src/Conferer/Provider/Namespaced.hs
@@ -1,23 +0,0 @@-module Conferer.Provider.Namespaced- (- -- * Namespaced higher-order provider- -- | This provider takes a provider and returns a new provider that- -- always checks that the 'Key' given always starts with certain 'Key'- -- and then strips that prefix before consulting its inner Provider- mkNamespacedProvider- ) where--import Data.List (stripPrefix)--import Conferer.Types---- | Create a 'ProviderCreator' from a prefix and another 'ProviderCreator'-mkNamespacedProvider :: Key -> ProviderCreator -> ProviderCreator-mkNamespacedProvider (Path key) configCreator = \config -> do- configProvider <- configCreator config- return $ Provider- { getKeyInProvider = \(Path k) -> do- case stripPrefix key k of- Just newKey -> getKeyInProvider configProvider (Path newKey)- Nothing -> return Nothing- }
− src/Conferer/Provider/Null.hs
@@ -1,18 +0,0 @@-module Conferer.Provider.Null- (- -- * Does Nothing Provider- -- | The stub provider that never has a key- mkNullProvider- )-where--import Conferer.Types---- | Create a null 'Provider'-mkNullProvider :: ProviderCreator-mkNullProvider _config =- return $ Provider- { getKeyInProvider =- \_k -> do- return Nothing- }
− src/Conferer/Provider/PropertiesFile.hs
@@ -1,54 +0,0 @@-module Conferer.Provider.PropertiesFile where--import Data.Text (Text)-import Data.Function ((&))-import System.Directory (doesFileExist)-import Data.Maybe (catMaybes)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text--import Conferer.Types-import Conferer.Provider.Files-import Conferer.Provider.Null-import Conferer.Provider.Simple---- | 'ProviderCreator' for properties file 'Provider' that read from a--- config file in @config/{env}.properties@ and parses it as a properties--- file with @some.key=a value@ lines-mkPropertiesFileProvider :: ProviderCreator-mkPropertiesFileProvider = \config -> do- filePath <- getFilePathFromEnv config "properties"- fileExists <- doesFileExist filePath- if fileExists- then do- fileContent <- Text.readFile filePath- mkPropertiesFileProvider' fileContent config- else do- mkNullProvider config----- | 'ProviderCreator' for properties file 'Provider' that only parses a--- given 'Text' as a properties file-mkPropertiesFileProvider' :: Text -> ProviderCreator-mkPropertiesFileProvider' fileContent =- \config -> do- let keyValues =- fileContent- & Text.lines- & fmap lineToKeyValue- & catMaybes- mkMapProvider keyValues config----- | Transform a line into a key/value pair (or not)-lineToKeyValue :: Text -> Maybe (Key, Text)-lineToKeyValue line =- Text.breakOn "=" line- & (\(rawKey, rawValue) ->- case Text.stripPrefix "=" rawValue of- Just value ->- Just (Path $ Text.splitOn "." rawKey, value)- Nothing ->- Nothing- )-
− src/Conferer/Provider/Simple.hs
@@ -1,34 +0,0 @@-module Conferer.Provider.Simple- (- -- * Simple Provider- -- | This provider provides values from a hardcoded Map passed at creation- -- time that can not be changed afterwards, it's mostly used as a necessary- -- utility- mkMapProvider- , mkMapProvider'- , mkPureMapProvider- ) where--import Data.Map (Map)-import qualified Data.Map as Map-import Data.Text (Text)--import Conferer.Types---- | Make a 'ProviderCreator' from a 'Map'-mkMapProvider' :: Map Key Text -> ProviderCreator-mkMapProvider' configMap _config =- return $ mkPureMapProvider configMap---- | Make a 'Provider' from a 'Map'-mkPureMapProvider :: Map Key Text -> Provider-mkPureMapProvider configMap =- Provider- { getKeyInProvider =- \k -> do- return $ Map.lookup k configMap- }---- | Make a 'Provider' from 'List' of 'Key', 'Text' pairs-mkMapProvider :: [(Key, Text)] -> ProviderCreator-mkMapProvider = mkMapProvider' . Map.fromList
+ src/Conferer/Source.hs view
@@ -0,0 +1,18 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module for Source related features+module Conferer.Source+ ( Source(..)+ , IsSource(..)+ , SourceCreator+ , module Conferer.Key+ ) where++import Conferer.Key+import Conferer.Config.Internal.Types+import Conferer.Source.Internal
+ src/Conferer/Source/CLIArgs.hs view
@@ -0,0 +1,76 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Command line arguments based source+module Conferer.Source.CLIArgs where++import Data.Text (Text)+import qualified Data.Text as Text+import Data.Maybe (mapMaybe)+import System.Environment (getArgs)++import Conferer.Source+import qualified Conferer.Source.InMemory as InMemory+++-- | This source provides keys from the command line arguments passed into+-- the program. It only accepts arguments with @--@ and an equals, for+-- example: @./awesomeapp --warp.port=5000@+data CLIArgsSource =+ CLIArgsSource+ { originalCliArgs :: RawCLIArgs+ , innerSource :: Source+ } deriving (Show)++-- | Type alias for cli args+type RawCLIArgs = [String]++instance IsSource CLIArgsSource where+ getKeyInSource CLIArgsSource{..} key = do+ getKeyInSource innerSource key+ getSubkeysInSource CLIArgsSource{..} key = do+ getSubkeysInSource innerSource key+++-- | Create a 'SourceCreator' using 'fromEnv'+fromConfig :: SourceCreator+fromConfig = \_config ->+ fromEnv++-- | Create a 'Source' using 'fromArgs' but using real cli args+fromEnv :: IO Source+fromEnv = do+ args <- getArgs+ return $ fromArgs args++-- | Create a 'Source' using cli args passed as parameter+fromArgs :: RawCLIArgs -> Source+fromArgs originalCliArgs =+ let configMap = parseArgsIntoKeyValue originalCliArgs+ innerSource = InMemory.fromAssociations configMap+ in Source $ CLIArgsSource {..}++-- | Parse an argument list into a dictionary suitable for a 'Source'+parseArgsIntoKeyValue :: [String] -> [(Key, Text)]+parseArgsIntoKeyValue =+ fmap (\s ->+ let (k, rawValue) = Text.breakOn "=" s+ in case Text.uncons rawValue of+ Nothing -> (fromText k, "true")+ (Just ('=', v)) -> (fromText k, v)+ -- Since rawValue comes from breaking on "=" the first character+ -- should always be '=' or none at all+ (Just (_, _)) ->+ error $ unlines+ [ "'"+ , Text.unpack rawValue+ , "' should always start with '='"+ ]+ ) .+ mapMaybe (Text.stripPrefix "--") .+ takeWhile (/= "--") .+ fmap Text.pack
+ src/Conferer/Source/Env.hs view
@@ -0,0 +1,84 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Environment based source+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.Env where++import Data.Text (Text)+import qualified Data.Text as Text+import qualified System.Environment as System+import Data.Maybe (mapMaybe)++import Conferer.Source+import qualified Conferer.Source.InMemory as InMemory++-- | Source that interfaces with the environment transforming keys+-- by uppercasing and interspersing underscores, and using a prefix+-- to avoid clashing with system env vars+--+-- so with "app" prefix, @"some.key"@ turns into @APP_SOME_KEY@+data EnvSource =+ EnvSource+ { environment :: RawEnvironment+ , keyPrefix :: Prefix+ , innerSource :: Source+ } deriving (Show)++-- | Type alias for the environment+type RawEnvironment = [(String, String)]++-- | Type alias for the env vars prefix+type Prefix = Text++instance IsSource EnvSource where+ getKeyInSource EnvSource{..} key = do+ getKeyInSource innerSource key+ getSubkeysInSource EnvSource{..} key = do+ getSubkeysInSource innerSource key++-- | Create a 'SourceCreator' using 'fromEnv'+fromConfig :: Prefix -> SourceCreator+fromConfig prefix _config = do+ fromEnv prefix++-- | Create a 'Source' using the real environment+fromEnv :: Prefix -> IO Source+fromEnv prefix = do+ rawEnvironment <- System.getEnvironment+ return $ fromEnvList rawEnvironment prefix++-- | Create a 'Source' using a hardcoded list of env vars+fromEnvList :: RawEnvironment -> Prefix -> Source+fromEnvList environment keyPrefix =+ let+ mappings =+ mapMaybe (\(key, v) -> do+ k <- envVarToKey keyPrefix $ Text.pack key+ return (k, Text.pack v)+ )+ environment+ innerSource = InMemory.fromAssociations mappings+ in Source EnvSource {..}++-- | Get the env name from a prefix and a key by uppercasing and+-- intercalating underscores+keyToEnvVar :: Prefix -> Key -> Text+keyToEnvVar prefix keys =+ Text.toUpper+ $ Text.intercalate "_"+ $ filter (/= mempty)+ $ prefix : rawKeyComponents keys++-- | The opossite of 'keyToEnvVar'+envVarToKey :: Prefix -> Text -> Maybe Key+envVarToKey prefix envVar =+ let+ splitEnvVar = fromText $ Text.replace "_" "." envVar+ in+ stripKeyPrefix (fromText prefix) splitEnvVar+
+ src/Conferer/Source/Files.hs view
@@ -0,0 +1,25 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Public API module providing some helper functions related to files+{-# LANGUAGE TypeApplications #-}+module Conferer.Source.Files where++import Data.Maybe (fromMaybe)+import System.FilePath++import Conferer.Config+import Conferer.FromConfig++-- | Helper function to get a file from the config specifying the extension and using+-- current env+getFilePathFromEnv :: Key -> String -> Config -> IO FilePath+getFilePathFromEnv key extension config = do+ env <- fromMaybe "development" <$> fetchFromConfig @(Maybe String) "env" config+ let defaultPath = "config" </> env <.> extension+ File filepath <- fetchFromConfigWithDefault @File config key $ File defaultPath+ return filepath
+ src/Conferer/Source/InMemory.hs view
@@ -0,0 +1,44 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- In memory source mostly used for testing+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.InMemory where++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Text (Text)++import Conferer.Source++-- | A 'Source' mostly use for mocking which is configured directly using a+-- 'Map'+newtype InMemorySource =+ InMemorySource+ { configMap :: Map Key Text+ } deriving (Show, Eq)++instance IsSource InMemorySource where+ getKeyInSource InMemorySource {..} key =+ return $ Map.lookup key configMap+ getSubkeysInSource InMemorySource {..} key = do+ return $ filter (\k -> key `isKeyPrefixOf` k && key /= k) $ Map.keys configMap++-- | Create a 'SourceCreator' from a list of associations+fromConfig :: [(Key, Text)] -> SourceCreator+fromConfig configMap _config =+ return $ fromAssociations configMap++-- | Create a 'Source' from a 'Map'+fromMap :: Map Key Text -> Source+fromMap configMap =+ Source . InMemorySource $ configMap++-- | Create a 'Source' from a list of associations+fromAssociations :: [(Key, Text)] -> Source+fromAssociations =+ fromMap . Map.fromList
+ src/Conferer/Source/Internal.hs view
@@ -0,0 +1,35 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: unstable+-- Portability: portable+--+-- Internal module for Key related features+{-# LANGUAGE ExistentialQuantification #-}+module Conferer.Source.Internal where++import Data.Text (Text)+import Conferer.Key (Key)++-- | Concrete type for 'IsSource'+data Source = forall s. (IsSource s, Show s) => Source s++instance Show Source where+ show (Source s) = "Source " ++ show s++-- | Main interface for interacting with external systems that provide configuration+-- which will be used by 'Conferer.FromConfig.FromConfig' to fetch values.+class IsSource s where+ -- | This function is used by the 'Conferer.Config.Config' to get values from this+ -- 'Source'.+ getKeyInSource :: s -> Key -> IO (Maybe Text)+ -- | This function is used by the 'Conferer.Config.Config' to list possible values+ -- from the 'Source' that if the user 'getKeyInSource', it will be found.+ getSubkeysInSource :: s -> Key -> IO [Key]++instance IsSource Source where+ getKeyInSource (Source source) =+ getKeyInSource source+ getSubkeysInSource (Source source) =+ getSubkeysInSource source
+ src/Conferer/Source/Namespaced.hs view
@@ -0,0 +1,43 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Source that namespaces an inner source+{-# LANGUAGE RecordWildCards #-}+module Conferer.Source.Namespaced where++import Conferer.Source++-- | This source takes a source and returns a new source that+-- always checks that the 'Key' given always starts with certain 'Key'+-- and then strips that prefix before consulting its inner Source+data NamespacedSource =+ NamespacedSource+ { scopeKey :: Key+ , innerSource :: Source+ } deriving (Show)++instance IsSource NamespacedSource where+ getKeyInSource NamespacedSource{..} key = do+ case stripKeyPrefix scopeKey key of+ Just innerKey -> getKeyInSource innerSource innerKey+ Nothing -> return Nothing+ getSubkeysInSource NamespacedSource{..} key = do+ case stripKeyPrefix scopeKey key of+ Just innerKey -> do+ fmap (scopeKey /.) <$> getSubkeysInSource innerSource innerKey+ Nothing -> return []++-- | Create a 'SourceCreator' from a prefix and another 'SourceCreator'+fromConfig :: Key -> SourceCreator -> SourceCreator+fromConfig scopeKey configCreator = \config -> do+ innerSource <- configCreator config+ return $ fromInner scopeKey innerSource++-- | Create a 'Source' from a prefix and another 'Source'+fromInner :: Key -> Source -> Source+fromInner scopeKey innerSource = do+ Source $ NamespacedSource{..}
+ src/Conferer/Source/Null.hs view
@@ -0,0 +1,32 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Do nothing source+module Conferer.Source.Null where++import Conferer.Source++-- | Stub source that has no keys+data NullSource =+ NullSource+ deriving (Show, Eq)++instance IsSource NullSource where+ getKeyInSource _source _key =+ return Nothing+ getSubkeysInSource _source _key =+ return []++-- | Create 'SourceCreator'+fromConfig :: SourceCreator+fromConfig _config =+ return empty++-- | Create a 'Source'+empty :: Source+empty =+ Source $ NullSource
+ src/Conferer/Source/PropertiesFile.hs view
@@ -0,0 +1,84 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Properties file source+module Conferer.Source.PropertiesFile where++import Data.Text (Text)+import Data.Function ((&))+import System.Directory (doesFileExist)+import Data.Maybe (catMaybes)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text++import Conferer.Source+import Conferer.Source.Files+import qualified Conferer.Source.Null as Null+import qualified Conferer.Source.InMemory as InMemory++-- | 'Source' that uses a config file in @config/{env}.properties@ and+-- parses it as a properties file with @some.key=a value@ lines+data PropertiesFileSource =+ PropertiesFileSource+ { originalFilePath :: FilePath+ , innerSource :: Source+ } deriving (Show)++instance IsSource PropertiesFileSource where+ getKeyInSource PropertiesFileSource{..} key = do+ getKeyInSource innerSource key+ getSubkeysInSource PropertiesFileSource{..} key = do+ getSubkeysInSource innerSource key++-- | Create a 'SourceCreator' using 'getFilePathFromEnv' to get the path to file+-- and 'fromFilePath'+fromConfig :: Key -> SourceCreator+fromConfig key config = do+ filePath <- getFilePathFromEnv key "properties" config+ fromFilePath' filePath++-- | Create a 'SourceCreator' reading the file and using that as a properties file, but+-- if the file doesn't exist do nothing.+fromFilePath :: FilePath -> SourceCreator+fromFilePath filepath _config =+ fromFilePath' filepath++-- | Create a 'Source' reading the file and using that as a properties file, but+-- if the file doesn't exist do nothing.+fromFilePath' :: FilePath -> IO Source+fromFilePath' filePath = do+ fileExists <- doesFileExist filePath+ if fileExists+ then do+ fileContent <- Text.readFile filePath+ return $ fromFileContent filePath fileContent+ else+ return Null.empty++-- | Create a 'Source' using some content as a properties file+fromFileContent :: FilePath -> Text -> Source+fromFileContent originalFilePath fileContent =+ let keyValues =+ fileContent+ & Text.lines+ & fmap lineToKeyValue+ & catMaybes+ innerSource = InMemory.fromAssociations keyValues+ in Source $ PropertiesFileSource {..}++-- | Transform a line into a key/value pair (or not)+lineToKeyValue :: Text -> Maybe (Key, Text)+lineToKeyValue line =+ Text.breakOn "=" line+ & (\(rawKey, rawValue) ->+ case Text.stripPrefix "=" rawValue of+ Just value ->+ Just (fromText rawKey, value)+ Nothing ->+ Nothing+ )+
+ src/Conferer/Test.hs view
@@ -0,0 +1,24 @@+-- |+-- Copyright: (c) 2019 Lucas David Traverso+-- License: MPL-2.0+-- Maintainer: Lucas David Traverso <lucas6246@gmail.com>+-- Stability: stable+-- Portability: portable+--+-- Some testing utilities+module Conferer.Test+ ( configWith+ ) where++import Conferer.Config+import qualified Conferer.Source.InMemory as InMemory+import Data.Text (Text)+import Data.Dynamic++-- | Create a Config mostly used for testing 'Conferer.FromConfig.FromConfig'+-- instances without having to create a full config+configWith :: [(Key, Dynamic)] -> [(Key, Text)] -> IO Config+configWith defaults keyValues =+ emptyConfig + & addDefaults defaults+ & addSource (InMemory.fromConfig keyValues)
− src/Conferer/Types.hs
@@ -1,118 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeOperators #-}-module Conferer.Types where--import Data.String-import Data.Text (Text)-import qualified Data.Text as Text-import Data.Map (Map)-import qualified Data.Map as Map-import Control.Exception-import Data.Typeable-import GHC.Generics---- | Core interface for library provided configuration, basically consists of--- getting a 'Key' and informing returning a maybe signaling the value and--- if it's present in that specific provider-data Provider =- Provider- { getKeyInProvider :: Key -> IO (Maybe Text)- }---- | The way to index 'Provider's, basically list of names that will be adapted--- to whatever the provider needs-newtype Key- = Path { unKey :: [Text] }- deriving (Show, Eq, Ord)--instance IsString Key where- fromString s = Path $ filter (/= mempty) $ Text.split (== '.') $ fromString s---- | Collapse a key into a textual representation-keyName :: Key -> Text-keyName = Text.intercalate "." . unKey---- | Core type that the user of this library interact with, in the future it may--- contain more this besides a list of providers-data Config =- Config- { providers :: [Provider]- , defaults :: Map Key Text- }---- | The type for creating a provider given a 'Config', some providers require a--- certain configuration to be initialized (for example: the redis provider--- needs connection info to connect to the server)-type ProviderCreator = Config -> IO Provider--keyNotPresentError :: forall a. (Typeable a) => Key -> Proxy a -> FailedToFetchError-keyNotPresentError key =- throw $ FailedToFetchError key $ typeRep (Proxy :: Proxy a)---- | Default defining instance------ Here a 'Nothing' means that the value didn't appear in the config, some--- instances never return a value since they have defaults that can never--- fail-class DefaultConfig a where- configDef :: a---- | Main typeclass for defining the way to get values from config, hiding the--- 'Text' based nature of the 'Provider's.--- updated using a config, so for example a Warp.Settings can get updated from a config,--- but that doesn't make much sense for something like an 'Int'------ You'd normally would never implement this typeclass, if you want to implement--- 'FromConfig' you should implement that directly, and if you want to use--- 'DefaultConfig' and 'FromConfig' to implement 'FromConfig' you should let--- the default 'Generics' based implementation do it's thing-class FromConfig a where- updateFromConfig :: Key -> Config -> a -> IO a- default updateFromConfig :: (Generic a, Typeable a, FromConfigG (Rep a)) => Key -> Config -> a -> IO a- updateFromConfig k c a = to <$> updateFromConfigG k c (from a)-- fetchFromConfig :: Key -> Config -> IO (Maybe a)- default fetchFromConfig :: (Generic a, FromConfigG (Rep a)) => Key -> Config -> IO (Maybe a)- fetchFromConfig k c = fmap to <$> fetchFromConfigG k c---- | Purely 'Generics' machinery, ignore...-class FromConfigG f where- updateFromConfigG :: Key -> Config -> f a -> IO (f a)- fetchFromConfigG :: Key -> Config -> IO (Maybe (f a))--data ConfigParsingError =- ConfigParsingError Key Text TypeRep- deriving (Typeable, Eq)--instance Show ConfigParsingError where- show (ConfigParsingError key value typeRep) =- concat- [ "Couldn't parse value '"- , Text.unpack value- , "' from key '"- , Text.unpack (keyName key)- , "' as "- , show typeRep- ]--instance Exception ConfigParsingError--data FailedToFetchError =- FailedToFetchError Key TypeRep- deriving (Typeable, Eq)--instance Show FailedToFetchError where- show (FailedToFetchError key typeRep) =- concat- [ "Couldn't get a "- , show typeRep- , " from key '"- , Text.unpack (keyName key)- , "'"- ]--instance Exception FailedToFetchError
+ test/Conferer/ConfigSpec.hs view
@@ -0,0 +1,211 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.ConfigSpec where++import Test.Hspec+import Data.Text (Text)+import Data.Dynamic++import Conferer.Config+import Conferer.Source.InMemory+import Conferer.FromConfig.Internal (fromDynamics)++missingKey :: Key -> KeyLookupResult -> Bool +missingKey expectedKey (MissingKey k) = [expectedKey] == k+missingKey _ _ = False++foundInSources :: Key -> Text -> KeyLookupResult -> Bool +foundInSources expectedKey expected (FoundInSources k t) = + expected == t && expectedKey == k+foundInSources _keyExpected _expected _ = + False++foundInDefaults :: forall expected. (Eq expected, Typeable expected)+ => Key -> expected -> KeyLookupResult -> Bool +foundInDefaults expectedKey expected (FoundInDefaults k d) = + Just expected == fromDynamics @expected d && expectedKey == k+foundInDefaults _expctedKey _expected _ = + False++spec :: Spec+spec = do+ describe "Config" $ do+ let mkConfig keyMappings defaults content = + pure (emptyConfig+ & addKeyMappings keyMappings+ & addDefaults defaults)+ >>= addSource (fromConfig content)+ describe "#getKey" $ do+ it "getting a non existent key returns missing key" $ do+ c <- mkConfig [] [] []+ res <- getKey "aaa" c+ res `shouldSatisfy` missingKey "aaa"++ it "getting a key only present in the defaults" $ do+ c <- mkConfig [] [("some.key", toDyn @Int 1)] []+ res <- getKey "some.key" c+ res `shouldSatisfy` foundInDefaults "some.key" (1 :: Int)++ context "with multiple sources and defaults" $ do+ let mkConfig' defaults sourceWithPriority otherSource =+ pure (emptyConfig+ & addDefaults defaults)+ >>= addSource (fromConfig sourceWithPriority)+ >>= addSource (fromConfig otherSource)++ it "getting an key returns unwraps the original map" $ do+ c <- mkConfig' [] [] [("some.key", "1")]+ res <- getKey "some.key" c+ res `shouldSatisfy` foundInSources "some.key" "1"++ it "getting an existent key returns in the bottom maps gets it" $ do+ c <- mkConfig' [] [("some.key", "2")] [("some.key", "1")]+ res <- getKey "some.key" c+ res `shouldSatisfy` foundInSources "some.key" "2"+ describe "with some key mapping" $ do+ context "with basic one to one mapping" $ + it "gets the value through a mapping" $ do+ c <- mkConfig+ [ ("something", "server") ]+ []+ [ ("server", "aaa") ]+ res <- getKey "something" c+ res `shouldSatisfy` foundInSources "server" "aaa"+ context "with a nested key mapping" $ do+ it "goes through all the mappings and gets the right value" $ do+ c <- mkConfig+ [ ("something", "else")+ , ("else", "server")+ ]+ []+ [ ("server", "aaa")+ ]+ res <- getKey "something" c+ res `shouldSatisfy` foundInSources "server" "aaa"+ context "with circular mappings" $ do+ it "gets the first key" $ do+ c <- mkConfig+ [ ("a", "b")+ , ("b", "a")+ , ("b", "c")+ ]+ []+ [ ("c", "aaa")+ ]+ res <- getKey "a" c+ res `shouldSatisfy` foundInSources "c" "aaa"+ context "with nested key" $ do+ it "maps the right upper key" $ do+ c <- mkConfig+ [ ("a", "b")+ ]+ []+ [ ("b.k", "aaa")+ ]+ res <- getKey "a.k" c+ res `shouldSatisfy` foundInSources "b.k" "aaa"+ context "with some defaults" $ do+ it "maps and allows getting the default" $ do+ c <- mkConfig+ [ ("a", "b")+ ]+ [ ("b", toDyn False)+ ]+ []+ res <- getKey "a" c+ res `shouldSatisfy` foundInDefaults "a" False+ describe "#listSubkeys" $ do+ it "return an empty list when nothing is configured" $ do+ c <- mkConfig [] [] []+ res <- listSubkeys "some" c+ res `shouldBe` []+ context "with some values in the config" $ do+ it "when nothing is configured" $ do+ c <- mkConfig [] [] [("some.key", "")]+ res <- listSubkeys "some" c+ res `shouldBe` ["some.key"]+ context "with a config that has a value configured and \+ \we get that same value" $ do+ it "returns that key in the list of subkeys" $ do+ c <- mkConfig [] [] [("some", "")]+ res <- listSubkeys "some" c+ res `shouldBe` []+ context "with a config that has a value configured but \+ \we get a different value" $ do+ it "returns an empty list" $ do+ c <- mkConfig [] [] [("some", "")]+ res <- listSubkeys "other" c+ res `shouldBe` []+ context "with a config with defaults" $ do+ it "returns those defaults in the list" $ do+ c <- mkConfig [] [("some.key", toDyn @Int 7)] []+ res <- listSubkeys "some" c+ res `shouldBe` ["some.key"]+ context "with configs in both defaults and sources" $ do+ it "returns both results combined" $ do+ c <- mkConfig [] [("some.key", toDyn @Int 7)] [("some.other", "")]+ res <- listSubkeys "some" c+ res `shouldBe` ["some.key", "some.other"]+ context "mappings" $ do+ context "with a simple mapping and a configured value" $ do+ it "returns the keys that are present based on the mapping" $ do+ c <- mkConfig+ [ ("a", "b")+ ]+ []+ [ ("b.k", "aaa")+ ]+ res <- listSubkeys "a" c+ res `shouldBe` ["a.k"]+ context "with a multiple mappings and a configured value" $ do+ it "returns the right keys" $ do+ c <- mkConfig+ [ ("a", "b")+ , ("b", "c")+ ]+ []+ [ ("c.k", "aaa")+ ]+ res <- listSubkeys "a" c+ res `shouldBe` ["a.k"]+ context "with circular mappings" $ do+ it "returns the right keys" $ do+ c <- mkConfig+ [ ("a", "b")+ , ("b", "a")+ ]+ []+ [ ("a.k", "aaa")+ ]+ res <- listSubkeys "a" c+ res `shouldBe` ["a.k"]+ context "with reducing mappings" $ do+ xit "returns the right keys" $ do+ c <- mkConfig+ [ ("a.k", "a")+ ]+ []+ [ ("a.k", "aaa")+ ]+ res <- listSubkeys "a" c+ -- getKey "a.k.k" c >>= print+ res `shouldBe` ["a.k", "a.k.k"]+ it "keys that are present based on the mapping" $ do+ c <- mkConfig+ [ ("a", "b")+ ]+ [ ("b.k", toDyn @String "aaa")+ ]+ [ ]+ res <- listSubkeys "a" c+ res `shouldBe` ["a.k"]++ describe "#addDefaults" $ do+ context "with multiple defaults on the same key" $ do+ it "the last one has more priority" $ do+ let c = emptyConfig+ & addDefaults+ [ ("some.key", toDyn @Int 1)+ , ("some.key", toDyn @Int 2)+ ]+ res <- getKey "some.key" c+ res `shouldSatisfy` foundInDefaults "some.key" (2 :: Int)
− test/Conferer/FromConfig/BasicsSpec.hs
@@ -1,88 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE AllowAmbiguousTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Conferer.FromConfig.BasicsSpec where--import Test.Hspec-import Conferer.Types-import Data.Text-import Conferer-import Control.Exception (evaluate)-import Data.Typeable-import Control.DeepSeq--configWith :: [(Key, Text)] -> IO Config-configWith keyValues = emptyConfig & addProvider (mkMapProvider keyValues)--configParserError_ :: ConfigParsingError -> Bool-configParserError_ = const True--configParserError :: Key -> Text -> ConfigParsingError -> Bool-configParserError key txt (ConfigParsingError k t _) =- key == k && t == txt--fetch :: (FromConfig a, Show a, Typeable a) => Key -> Config -> IO (Maybe a)-fetch = getFromConfig--spec :: Spec-spec = context "Basics" $ do- describe "fetching an Int from config" $ do- it "getting a value that can't be parsed as an int returns an error message" $ do- config <- configWith [ ("anInt", "50A") ]- fetch @Int "anInt" config `shouldThrow` configParserError "anInt" "50A"-- it "getting a value that can be parsed correctly returns the int" $ do- config <- configWith [ ("anInt", "50") ]- fetchedValue <- fetch @Int "anInt" config- fetchedValue `shouldBe` Just 50-- describe "fetching a Bool from config" $ do- it "getting a value that can't be parsed as a bool returns an error message" $ do- config <- configWith [ ("aBool", "nope") ]- fetch @Bool "aBool" config `shouldThrow` configParserError_-- it "getting a value that can be parsed as a bool returns the bool" $ do- config <- configWith [ ("aBool", "True"), ("anotherBool", "False") ]- fetchedValue <- fetch "aBool" config- fetchedValue `shouldBe` Just True- anotherFetchedValue <- fetch "anotherBool" config- anotherFetchedValue `shouldBe` Just False-- it "the parsing of the bool value is case insensitive" $ do- config <- configWith [ ("aBool", "TRUE"), ("anotherBool", "fAlSe") ]- fetchedValue <- fetch "aBool" config- fetchedValue `shouldBe` Just True- anotherFetchedValue <- fetch "anotherBool" config- anotherFetchedValue `shouldBe` Just False-- describe "fetching a String from config" $ do- it "getting a value returns the value as a string" $ do- config <- configWith [ ("aString", "Bleh") ]- fetchedValue <- fetch @String "aString" config- fetchedValue `shouldBe` Just "Bleh"-- describe "fetching a Float from config" $ do- it "if the value can be parsed as float, it returns that float" $ do- config <- configWith [ ("aFloat", "9.5") ]- fetchedValue <- fetch @Float "aFloat" config- fetchedValue `shouldBe` Just 9.5-- it "if the value cannot be parsed as float, it fails" $ do- config <- configWith [ ("aFloat", "ASD") ]- fetch @Float "aFloat" config `shouldThrow` configParserError_-- describe "fetching a String from config" $ do- context "when the key is there but has a wrong value" $ do- it "returns Nothing" $ do- config <- configWith [ ("anInt", "Bleh") ]- fetch @Int "anInt" config `shouldThrow` configParserError_- context "when the key is not there" $ do- it "returns Nothing" $ do- config <- configWith [ ]- fetchedValue <- fetch @Int "anInt" config- fetchedValue `shouldBe` Nothing- it "returns Nothing" $ do- config <- configWith [ ]- fetchedValue <- fetch @(Maybe Int) "anInt" config- fetchedValue `shouldBe` Just Nothing
+ test/Conferer/FromConfig/BoolSpec.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.BoolSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+ context "Basic fetching" $ do+ describe "fetching a Bool from config" $ do+ ensureEmptyConfigThrows @Bool++ ensureUsingDefaultReturnsSameValue @Bool True+ ensureUsingDefaultReturnsSameValue @Bool False++ ensureSingleConfigParsesTheRightThing @Bool "true" True+ ensureSingleConfigParsesTheRightThing @Bool "false" False++ context "parsing is case insensitive" $ do+ ensureSingleConfigParsesTheRightThing @Bool "faLSe" False+ ensureSingleConfigParsesTheRightThing @Bool "TRUE" True++ ensureSingleConfigThrowsParserError @Bool "nope"
+ test/Conferer/FromConfig/Extended.hs view
@@ -0,0 +1,148 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.Extended+ ( module Conferer.FromConfig+ , module GHC.Generics+ , configWith+ , anyConfigParserError+ , aConfigParserError+ , aMissingRequiredKey+ , aMissingRequiredKeys+ , ensureEmptyConfigThrows+ , ensureUsingDefaultReturnsSameValue+ , ensureSingleConfigParsesTheRightThing+ , ensureSingleConfigThrowsParserError+ , ensureSingleConfigThrows+ , ensureFetchParses+ , ensureFetchThrows+ , toDyn+ , module Conferer.Config+ ) where++import Data.Text+import Data.Typeable+import Test.Hspec+import GHC.Generics+import Control.Exception+import Data.Dynamic+import Data.Function++import Conferer.Config+import Conferer.FromConfig.Internal+ ( MissingRequiredKey(..)+ , ConfigParsingError(..)+ )+import Conferer.FromConfig+import qualified Conferer.Source.InMemory as InMemory++configWith :: [(Key, Text)] -> IO Config+configWith keyValues =+ emptyConfig+ & addSource (InMemory.fromConfig keyValues)++anyConfigParserError :: ConfigParsingError -> Bool+anyConfigParserError _ = True++aConfigParserError :: Key -> Text -> ConfigParsingError -> Bool+aConfigParserError key txt (ConfigParsingError k t _) =+ key == k && t == txt++aMissingRequiredKey :: forall t. Typeable t => Key -> MissingRequiredKey -> Bool+aMissingRequiredKey key (MissingRequiredKey k t) =+ [key] == k && typeRep (Proxy :: Proxy t) == t++aMissingRequiredKeys :: forall t. Typeable t => [Key] -> MissingRequiredKey -> Bool+aMissingRequiredKeys keys (MissingRequiredKey k t) =+ keys == k && typeRep (Proxy :: Proxy t) == t++data InvalidThing = InvalidThing deriving (Show, Eq)++ensureEmptyConfigThrows :: forall a. (Typeable a, FromConfig a) => SpecWith ()+ensureEmptyConfigThrows =+ context "with empty config" $ do+ it "throws an exception" $ do+ config <- configWith []+ fetchFromConfig @a "some.key" config+ `shouldThrow` aMissingRequiredKey @a "some.key"++ensureSingleConfigThrowsParserError ::+ forall a. (FromConfig a, Typeable a) =>+ Text -> SpecWith ()+ensureSingleConfigThrowsParserError keyContent =+ context "with invalid types in the defaults" $ do+ it "throws an exception" $ do+ config <- configWith [("some.key", keyContent)]+ fetchFromConfig @a "some.key" config+ `shouldThrow` aConfigParserError "some.key" keyContent++ensureUsingDefaultReturnsSameValue ::+ forall a. (Typeable a, Eq a, Show a, FromConfig a) =>+ a -> SpecWith ()+ensureUsingDefaultReturnsSameValue value =+ context ("with a default of '" ++ show value ++ "'") $ do+ it "gets that same value" $ do+ config <- configWith []+ fetchedValue <- fetchFromConfig @a "some.key"+ (config & addDefault "some.key" value)+ fetchedValue `shouldBe` value++ensureSingleConfigParsesTheRightThing ::+ forall a. (Eq a, Show a, FromConfig a, Typeable a) =>+ Text -> a -> SpecWith ()+ensureSingleConfigParsesTheRightThing keyContent value =+ context ("with a config value of '" ++ unpack keyContent ++ "'" ) $ do+ it "gets the right value" $ do+ config <- configWith [("some.key", keyContent)]+ fetchedValue <- fetchFromConfig @a "some.key" config+ fetchedValue `shouldBe` value++ensureSingleConfigThrows ::+ forall a e. (FromConfig a, Typeable a, Exception e) =>+ Text -> (e -> Bool) -> SpecWith ()+ensureSingleConfigThrows keyContent checkException =+ it "gets the right value" $ do+ config <- configWith [("some.key", keyContent)]+ fetchFromConfig @a "some.key" config+ `shouldThrow` checkException++ensureFetchParses ::+ forall a.+ ( FromConfig a+ , Typeable a+ , Eq a+ , Show a+ )+ => [(Key, Text)]+ -> [(Key, Dynamic)]+ -> a+ -> SpecWith ()+ensureFetchParses configs defaults expectedValue =+ it "gets the right value" $ do+ config <- addDefaults (mapKeys defaults) <$> configWith (mapKeys configs)+ fetchedValue <- fetchFromConfig @a "some.key" config+ fetchedValue `shouldBe` expectedValue+ where+ mapKeys :: [(Key, any)] -> [(Key, any)]+ mapKeys = fmap (\(k, x) -> ("some.key" /. k, x))++ensureFetchThrows ::+ forall a e.+ ( FromConfig a+ , Typeable a+ , Exception e+ )+ => [(Key, Text)]+ -> [(Key, Dynamic)]+ -> (e -> Bool)+ -> SpecWith ()+ensureFetchThrows configs defaults exceptionCheck =+ it "throws an exception" $ do+ config <- addDefaults (mapKeys defaults) <$> configWith (mapKeys configs)+ fetchFromConfig @a "some.key" config+ `shouldThrow` exceptionCheck+ where+ mapKeys :: forall x. [(Key, x)] -> [(Key, x)]+ mapKeys = fmap (\(k, x) -> ("some.key" /. k, x))
+ test/Conferer/FromConfig/FileSpec.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.FromConfig.FileSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended+import Conferer.FromConfig ()+import System.FilePath ((</>))+import Data.Text (pack)++spec :: Spec+spec = do+ context "File fromConfig" $ do+ describe "fetching a File from config" $ do+ ensureFetchParses @File [] [("", toDyn $ File "file.png")] $+ File "file.png"+ ensureFetchThrows @File [] [] $+ aMissingRequiredKeys @String+ [ "some.key"+ , "some.key.extension"+ , "some.key.dirname"+ , "some.key.basename"+ , "some.key.filename"+ ]++ context "with whole path in root" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ ]+ []+ $ File $ "some" </> "file.png"++ context "with whole path in root and overriding extension" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ , ("extension", "jpg")+ ]+ []+ $ File $ "some" </> "file.jpg"++ context "with whole path in root and overriding extension and basename" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ , ("extension", "jpg")+ , ("basename", "somefile")+ ]+ []+ $ File $ "some" </> "somefile.jpg"++ context "with whole path in root and overriding dirname" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ , ("dirname", "dir")+ ]+ []+ $ File $ "dir" </> "file.png"++ context "with both filename and basename the most specific takes priority" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ , ("filename", "somefile.jpg")+ , ("basename", "coolfile")+ ]+ []+ $ File $ "some" </> "coolfile.jpg"++ context "with both filename and extension the most specific takes priority" $ do+ ensureFetchParses @File+ [ ("", pack $ "some" </> "file.png")+ , ("filename", "somefile.jpg")+ , ("extension", "gif")+ ]+ []+ $ File $ "some" </> "somefile.gif"++ context "without root path specificied, with subcomponents that complete a path" $ do+ ensureFetchParses @File+ [ ("filename", "somefile.jpg")+ , ("dirname", pack $ "some" </> "path")+ ]+ []+ $ File $ "some" </> "path" </> "somefile.jpg"
+ test/Conferer/FromConfig/ListSpec.hs view
@@ -0,0 +1,171 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.ListSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++data Thing = Thing+ { thingA :: Int+ , thingB :: String+ } deriving (Generic, Show, Eq)++instance FromConfig Thing++spec :: Spec+spec = do+ describe "list parsing" $ do+ ensureEmptyConfigThrows @[Int]+ ensureUsingDefaultReturnsSameValue @[Int] [7]++ context "with an empty keys it always gets an empty list" $ do+ ensureFetchParses+ @[Int]+ [ ("keys", "")+ ]+ [ ("", toDyn @[Int] [1, 2, 3]) ]+ []+ context "with a fully defined list without a default" $ do+ ensureFetchParses+ @[Int]+ [ ("0", "2")+ ]+ []+ [2]++ context "with a non number key" $ do+ ensureFetchParses+ @[Int]+ [ ("a", "0")+ , ("b", "1")+ ]+ []+ [0, 1]++ context "orders the values lexicographically" $ do+ ensureFetchParses+ @[Int]+ [ ("09", "0")+ , ("10", "1")+ ]+ []+ [0, 1]+ context "with a prototype as default" $ do+ ensureFetchParses+ @[Thing]+ [ ("0.a", "0")+ , ("1.b", "aaa")+ ]+ [ ("prototype", toDyn (Thing 7 "lala"))+ ]+ [ Thing { thingA = 0, thingB = "lala"}+ , Thing { thingA = 7, thingB = "aaa"}+ ]++ context "with a partial prototype that gets completed later" $ do+ ensureFetchParses+ @[Thing]+ [ ("0.a", "0")+ , ("prototype.b", "lala")+ ]+ []+ [ Thing { thingA = 0, thingB = "lala"}+ ]++ context "when the user updates the prototype via config" $ do+ ensureFetchParses+ @[Thing]+ [ ("0.a", "0")+ , ("prototype.b", "aaa")+ ]+ [("prototype", toDyn Thing {thingA = 7, thingB = "lala"})+ ]+ [ Thing { thingA = 0, thingB = "aaa"}+ ]+ context "listing keys explicitly uses keys in that order" $ do+ ensureFetchParses+ @[Thing]+ [ ("1.a", "0")+ , ("1.b", "a")+ , ("a.a", "1")+ , ("a.b", "b")+ , ("keys", "1,a")+ ]+ [ ]+ [ Thing 0 "a"+ , Thing 1 "b"+ ]+ context "listing keys explicitly uses the prototype if the key is not complete" $ do+ ensureFetchParses+ @[Thing]+ [ ("1.a", "0")+ , ("keys", "1")+ ]+ [ ("prototype", toDyn $ Thing 7 "lele")+ ]+ [ Thing 0 "lele"+ ]+ context "listing keys explicitly I can use values from the default" $ do+ ensureFetchParses+ @[Thing]+ [ ("keys", "defaults.0")+ ]+ [ ("", toDyn+ [ Thing {thingA = 0, thingB = "a"}+ , Thing {thingA = 1, thingB = "b"}+ ])+ ]+ [ Thing 0 "a"+ ]+ context "listing keys explicitly I can use values from the default \+ \ and override some of the values" $ do+ ensureFetchParses+ @[Thing]+ [ ("keys", "defaults.0")+ , ("defaults.0.a", "7")+ ]+ [ ("", toDyn+ [ Thing {thingA = 0, thingB = "a"}+ , Thing {thingA = 1, thingB = "b"}+ ])+ ]+ [ Thing 7 "a"+ ]+ context "listing keys explicitly and using a default from an index \+ \that's not present" $ do+ ensureFetchThrows+ @[Thing]+ [ ("keys", "defaults.5")+ ]+ [ ("", toDyn+ [ Thing {thingA = 0, thingB = "a"}+ , Thing {thingA = 1, thingB = "b"}+ ])+ ]+ $ aMissingRequiredKey @Int "some.key.defaults.5.a"+ context "listing a default keys that's not present ignores the \+ \prototype" $ do+ ensureFetchThrows+ @[Thing]+ [ ("keys", "defaults.5")+ ]+ [ ("prototype", toDyn $ Thing 7 "lele")+ , ("", toDyn+ [ Thing {thingA = 0, thingB = "a"}+ , Thing {thingA = 1, thingB = "b"}+ ])+ ]+ $ aMissingRequiredKey @Int "some.key.defaults.5.a"+ context "fetching maps every key (and they can be used if the lower \+ \fromconfig uses listSubkeys" $ do+ ensureFetchParses+ @[[Int]]+ [ ("1.0", "0")+ ]+ [ ("prototype.1", toDyn @Int 8)+ ]+ [[0, 8]]
+ test/Conferer/FromConfig/MaybeSpec.hs view
@@ -0,0 +1,33 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.MaybeSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++data Thing = Thing+ { thingA :: Int+ , thingB :: String+ } deriving (Generic, Show, Eq)++instance FromConfig Thing++spec :: Spec+spec = do+ describe "fetching a Maybe from config" $ do+ context "when the key is there and has a valid value" $ do+ ensureFetchParses @(Maybe Int) [("", "7")] [] $ Just 7+ context "when the key is missing" $ do+ ensureFetchParses @(Maybe Int) [] [] Nothing+ context "when the key is there but has a wrong value" $ do+ ensureFetchThrows @(Maybe Int) [("", "Bleh")] [] anyConfigParserError+ context "with default of the inner type" $ do+ ensureFetchParses @(Maybe Int) [] [("", toDyn @Int 7)] $ Just 7+ context "with default of a Just inner type" $ do+ ensureFetchParses @(Maybe Int) [] [("", toDyn @(Maybe Int) $ Just 7)] $ Just 7+ context "with default of a Nothing and no configuration" $ do+ ensureFetchParses @(Maybe Int) [] [("", toDyn @(Maybe Int) $ Nothing)] $ Nothing
+ test/Conferer/FromConfig/NumbersSpec.hs view
@@ -0,0 +1,29 @@++{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Conferer.FromConfig.NumbersSpec (spec) where++import Test.Hspec+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+ context "Numbers fetching" $ do+ describe "fetching an Int from config" $ do+ ensureEmptyConfigThrows @Int+ ensureUsingDefaultReturnsSameValue @Int 7+ ensureSingleConfigParsesTheRightThing @Int "7" 7+ ensureSingleConfigParsesTheRightThing @Int "-7" (-7)+ ensureSingleConfigThrowsParserError @Int "50A"++ describe "fetching a Float from config" $ do+ ensureEmptyConfigThrows @Float+ ensureUsingDefaultReturnsSameValue @Float 7.5+ ensureSingleConfigParsesTheRightThing @Float "9.5" 9.5+ ensureSingleConfigParsesTheRightThing @Float "-9.5" (-9.5)+ ensureSingleConfigThrowsParserError @Float "9.50J"+ ensureSingleConfigThrowsParserError @Float ".5"+ ensureSingleConfigThrowsParserError @Float "9."
+ test/Conferer/FromConfig/StringLikeSpec.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE TypeApplications #-}++module Conferer.FromConfig.StringLikeSpec (spec) where++import Test.Hspec+import Data.Text (Text)+import Conferer.FromConfig.Extended+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS++spec :: Spec+spec = do+ describe "fetching a String from config" $ do+ ensureEmptyConfigThrows @String+ ensureUsingDefaultReturnsSameValue @String "aaa"+ ensureSingleConfigParsesTheRightThing @String "thing" "thing"+ describe "fetching text from config" $ do+ ensureEmptyConfigThrows @Text+ ensureUsingDefaultReturnsSameValue @Text "aaa"+ ensureSingleConfigParsesTheRightThing @Text "thing" "thing"+ describe "fetching bytestring from config" $ do+ ensureEmptyConfigThrows @BS.ByteString+ ensureUsingDefaultReturnsSameValue @BS.ByteString "aaa"+ ensureSingleConfigParsesTheRightThing @BS.ByteString "thing" "thing"+ describe "fetching lazy bytestring from config" $ do+ ensureEmptyConfigThrows @LBS.ByteString+ ensureUsingDefaultReturnsSameValue @LBS.ByteString "aaa"+ ensureSingleConfigParsesTheRightThing @LBS.ByteString "thing" "thing"
+ test/Conferer/FromConfigSpec.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE TypeApplications #-}+module Conferer.FromConfigSpec (spec) where++import Test.Hspec+import Conferer.FromConfig+import Conferer.FromConfig.Extended++spec :: Spec+spec = do+ describe "Override FromConfig" $ do+ ensureFetchParses @Int+ []+ [ ("", overrideFetch @Int $ \_k _c -> pure 42) ]+ 42
test/Conferer/GenericsSpec.hs view
@@ -4,14 +4,10 @@ import Test.Hspec -import Conferer-import Conferer.Types (FromConfig, DefaultConfig, configDef)+import Conferer.FromConfig -import Data.Typeable import GHC.Generics--fetch :: (FromConfig a, Show a, Typeable a, DefaultConfig a) => Key -> Config -> IO a-fetch k c = getFromConfig k c+import Conferer.FromConfig.Extended data Thing = Thing { thingA :: Int@@ -19,6 +15,7 @@ } deriving (Generic, Show, Eq) instance FromConfig Thing+ instance DefaultConfig Thing where configDef = Thing 0 0 @@ -28,79 +25,74 @@ } deriving (Generic, Show, Eq) instance FromConfig Bigger+ instance DefaultConfig Bigger where- configDef = Bigger (configDef { thingA = 27}) 1+ configDef = Bigger (configDef {thingA = 27}) 1 spec :: Spec spec = do describe "Generics" $ do context "with a simple record" $ do+ context "without a default but with all of the keys defined" $ do+ ensureFetchParses+ [ ("a", "0")+ , ("b", "0")+ ]+ []+ Thing { thingA = 0, thingB = 0 } context "when no keys are set" $ do- it "returns the default" $ do- c <- emptyConfig- & addProvider (mkMapProvider [ ])-- res <- fetch @Thing "somekey" c- res `shouldBe` Thing { thingA = 0, thingB = 0 }+ ensureFetchParses+ []+ [ ("", toDyn $ configDef @Thing)+ ]+ Thing { thingA = 0, thingB = 0 } context "when all keys are set" $ do- it "return the keys set" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ("somekey.a", "1")- , ("somekey.b", "2")- ])-- res <- fetch @Thing "somekey" c- res `shouldBe` Thing { thingA = 1, thingB = 2 }+ ensureFetchParses+ [ ("a", "1")+ , ("b", "2")+ ]+ [ ("", toDyn $ configDef @Thing)+ ]+ Thing { thingA = 1, thingB = 2 } context "when some keys are set" $ do- it "uses the default and returns the keys set" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ("somekey.b", "2")- ])-- res <- fetch @Thing "somekey" c- res `shouldBe` Thing { thingA = 0, thingB = 2 }+ ensureFetchParses+ [ ("b", "2")+ ]+ [ ("", toDyn $ configDef @Thing)+ ]+ Thing { thingA = 0, thingB = 2 } context "with a nested record" $ do context "when none of the keys are set" $ do- it "returns the default of both records" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ])-- res <- fetch @Bigger "somekey" c- res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 1}+ ensureFetchParses+ [ ]+ [ ("", toDyn @Bigger configDef )+ ]+ Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 1} context "when some keys of the top record are set" $ do- it "returns the default for the inner record" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ("somekey.b", "30")- ])-- res <- fetch @Bigger "somekey" c- res `shouldBe` Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 30}+ ensureFetchParses+ [ ("b", "30")+ ]+ [ ("", toDyn @Bigger configDef)+ ]+ Bigger { biggerThing = Thing { thingA = 27, thingB = 0 }, biggerB = 30} context "when some keys of the inner record are set" $ do- it "returns the inner record updated" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ("somekey.thing.a", "30")- ])-- res <- fetch @Bigger "somekey" c- res `shouldBe` Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1}+ ensureFetchParses+ [ ("thing.a", "30")+ ]+ [ ("", toDyn @Bigger configDef)+ ]+ Bigger { biggerThing = Thing { thingA = 30, thingB = 0 }, biggerB = 1} context "when every key is set" $ do- it "returns everything with the right values" $ do- c <- emptyConfig- & addProvider (mkMapProvider- [ ("somekey.thing.a", "10")- , ("somekey.thing.b", "20")- , ("somekey.b", "30")- ])-- res <- fetch @Bigger "somekey" c- res `shouldBe` Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}+ ensureFetchParses+ [ ("thing.a", "10")+ , ("thing.b", "20")+ , ("b", "30")+ ]+ [ ("", toDyn @Bigger configDef)+ ]+ Bigger { biggerThing = Thing { thingA = 10, thingB = 20 }, biggerB = 30}
+ test/Conferer/KeySpec.hs view
@@ -0,0 +1,39 @@+module Conferer.KeySpec where++import Test.Hspec++import Conferer.Key+import Conferer.Key.Internal++spec :: Spec+spec = do+ describe "#fromString" $ do+ it "parsing keys does the right thing" $ do+ "some.key" `shouldBe` Key ["some", "key"]+ it "an empty string is the empty list" $ do+ "" `shouldBe` Key []+ it "empty key fragments are removed" $ do+ "some..key" `shouldBe` Key ["some", "key"]+ it "are matched in a case insensitive way" $ do+ "some.key" `shouldBe` ("SoME.KeY" :: Key)+ it "'s true representation is case insensitive" $ do+ "somE.Key" `shouldBe` Key ["some", "key"]+ describe "#isValidKeyFragment" $ do+ context "with a all leters" $ do+ it "is valid" $+ isValidKeyFragment "fragment" `shouldBe` True+ context "with only numbers" $ do+ it "is valid" $+ isValidKeyFragment "000" `shouldBe` True+ context "with both numbers and letters" $ do+ it "is valid" $+ isValidKeyFragment "000" `shouldBe` True+ context "with a dot" $ do+ it "is not valid" $ do+ isValidKeyFragment "some.fragment" `shouldBe` False+ context "with an uppercase letter" $ do+ it "is not valid" $ do+ isValidKeyFragment "FRAGMENT" `shouldBe` False+ context "with an empty string" $ do+ it "is not valid" $ do+ isValidKeyFragment "" `shouldBe` False
− test/Conferer/Provider/ArgsSpec.hs
@@ -1,38 +0,0 @@-module Conferer.Provider.ArgsSpec where--import Test.Hspec--import Conferer--spec :: Spec-spec = do- describe "with a mapping provider" $ do- let mkConf args =- emptyConfig- & addProvider- (mkCLIArgsProvider' args)-- it "gets a parameters with it's value if it starts with the right prefix" $ do- c <- mkConf []- res <- getKey "some.key" c- res `shouldBe` Nothing-- it "with a value that begins with the right prefix it uses it" $ do- c <- mkConf ["--some.key=value"]- res <- getKey "some.key" c- res `shouldBe` Just "value"-- it "with a reapeated value it uses the last one" $ do- c <- mkConf ["--some.key=value", "--some.key=different value"]- res <- getKey "some.key" c- res `shouldBe` Just "different value"-- it "ignores values that don't start with the right prefix" $ do- c <- mkConf ["some.key=value", "-some.key=value", "-Xsome.key=value", "some.key"]- res <- getKey "some.key" c- res `shouldBe` Nothing-- it "after encountering a -- it stops parsing parameters" $ do- c <- mkConf ["--", "--some.key=value"]- res <- getKey "some.key" c- res `shouldBe` Nothing
− test/Conferer/Provider/EnvSpec.hs
@@ -1,41 +0,0 @@-module Conferer.Provider.EnvSpec where--import Test.Hspec-import qualified Data.Map as Map--import Conferer--fakeLookupEnv :: [(String, String)] -> LookupEnvFunc-fakeLookupEnv fakeEnv = \envName ->- return $ Map.lookup envName $ Map.fromList fakeEnv--spec :: Spec-spec = do- describe "with an env config" $ do- let- mkEnvConfig =- emptyConfig- & addProvider- (mkEnvProvider'- (fakeLookupEnv- [ ("TMUX","/tmp/tmux-1000/default,2822,0")- , ("TMUX_PANE","%1")- , ("TMUX_PLUGIN_MANAGER_PATH","/home/user/.tmux/plugins/")- ])- "TMUX"- )- it "getting an existent key returns unwraps top level value (wihtout \- \children)" $ do- c <- mkEnvConfig- res <- getKey "." c- res `shouldBe` Just "/tmp/tmux-1000/default,2822,0"-- it "getting an existent key for a child gets that value" $ do- c <- mkEnvConfig- res <- getKey "pane" c- res `shouldBe` Just "%1"-- it "keys should always be consistent as to how the words are separated" $ do- c <- mkEnvConfig- res <- getKey "pane" c- res `shouldBe` Just "%1"
− test/Conferer/Provider/MappingSpec.hs
@@ -1,43 +0,0 @@-module Conferer.Provider.MappingSpec where--import Test.Hspec-import qualified Data.Map as Map-import Data.Function ((&))--import Conferer--spec :: Spec-spec = do- describe "with a mapping provider" $ do- it "getting an existent key in the original map but that's not mapped in the \- \wrapper doesn't exist" $ do- c <- emptyConfig- & addProvider (mkMappingProvider Map.empty- $ mkMapProvider [("some.key", "some value")])- res <- getKey "some.key" c- res `shouldBe` Nothing-- it "getting a non existent key isn't there" $ do- c <- emptyConfig- & addProvider (mkMappingProvider (Map.fromList [("k", "key")])- $ mkMapProvider [("key", "75")])-- res <- getKey "xxxx" c- res `shouldBe` Nothing-- it "getting an existent key that's mapped but doesn't exist on the \- \inner provider isn't there" $ do- c <- emptyConfig- & addProvider (mkMappingProvider (Map.fromList [("another.key", "some.key")])- $ mkMapProvider [])-- res <- getKey "another.key" c- res `shouldBe` Nothing-- it "getting an existent key that's mapped properly gets it and exists on \- \the inner provider gets it" $ do- c <- emptyConfig- & addProvider (mkMappingProvider (Map.fromList [("another.key", "some.key")])- $ mkMapProvider [("some.key", "some value")])- res <- getKey "another.key" c- res `shouldBe` Just "some value"
− test/Conferer/Provider/NamespacedSpec.hs
@@ -1,21 +0,0 @@-module Conferer.Provider.NamespacedSpec where--import Test.Hspec--import Conferer--spec :: Spec-spec = do- describe "namespaced config" $ do- it "return nothing if the key doesn't match" $ do- c <- emptyConfig- & addProvider (mkNamespacedProvider "postgres"- $ mkMapProvider [("url", "some url")])- res <- getKey "url" c- res `shouldBe` Nothing- it "returns the wrapped value" $ do- c <- emptyConfig- & addProvider (mkNamespacedProvider "postgres"- $ mkMapProvider [("url", "some url")])- res <- getKey "postgres.url" c- res `shouldBe` Just "some url"
− test/Conferer/Provider/NullSpec.hs
@@ -1,13 +0,0 @@-module Conferer.Provider.NullSpec where--import Test.Hspec--import Conferer--spec :: Spec-spec = do- it "always fails to get a key" $ do- c <- emptyConfig- & addProvider mkNullProvider- res <- getKey "some.key" c- res `shouldBe` Nothing
− test/Conferer/Provider/PropertiesFileSpec.hs
@@ -1,39 +0,0 @@-module Conferer.Provider.PropertiesFileSpec where--import Test.Hspec-import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Map as Map--import Conferer-import Conferer.Core-import Conferer.Provider.PropertiesFile--fakeLookupEnv :: [(String, String)] -> LookupEnvFunc-fakeLookupEnv fakeEnv = \envName ->- return $ Map.lookup envName $ Map.fromList fakeEnv--spec :: Spec-spec = do- describe "with a properties file config" $ do- it "getting an existent key returns unwraps top level value (wihtout \- \children)" $ do- c <- mkStandaloneProvider $ mkPropertiesFileProvider' "some.key=a value"- res <- getKeyInProvider c "some.key"- res `shouldBe` Just "a value"-- it "getting an existent key for a child gets that value" $ do- c <- mkStandaloneProvider $ mkPropertiesFileProvider' $ Text.unlines- [ "some.key=a value"- , "some.key=b"- ]- res <- getKeyInProvider c "some.key"- res `shouldBe` Just "b"-- it "keys should always be consistent as to how the words are separated" $ do- c <- mkStandaloneProvider $ mkPropertiesFileProvider' $ Text.unlines- [ "some.key=a value"- , "some.key=b"- ]- res <- getKeyInProvider c "another.key"- res `shouldBe` Nothing
− test/Conferer/Provider/SimpleSpec.hs
@@ -1,22 +0,0 @@-module Conferer.Provider.SimpleSpec where--import Test.Hspec--import Conferer--spec :: Spec-spec = do- describe "json provider" $ do- let creator =- emptyConfig- & addProvider (mkMapProvider [ ("postgres.url", "some url")])-- it "getting a non existent key returns an empty config" $ do- c <- creator- res <- getKey "some.key" c- res `shouldBe` Nothing-- it "getting an existent key returns unwraps the original map" $ do- c <- creator- res <- getKey "postgres.url" c- res `shouldBe` Just "some url"
+ test/Conferer/Source/CLIArgsSpec.hs view
@@ -0,0 +1,42 @@+module Conferer.Source.CLIArgsSpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.CLIArgs++spec :: Spec+spec = do+ describe "with a mapping source" $ do+ let mkConf args =+ return $ fromArgs args++ it "gets a parameters with it's value if it starts with the right prefix" $ do+ c <- mkConf []+ res <- getKeyInSource c "some.key"+ res `shouldBe` Nothing++ it "with a value that begins with the right prefix it uses it" $ do+ c <- mkConf ["--some.key=value"]+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "value"++ it "with a reapeated value it uses the last one" $ do+ c <- mkConf ["--some.key=value", "--some.key=different value"]+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "different value"++ it "ignores values that don't start with the right prefix" $ do+ c <- mkConf ["some.key=value", "-some.key=value", "-Xsome.key=value", "some.key"]+ res <- getKeyInSource c "some.key"+ res `shouldBe` Nothing++ it "after encountering a -- it stops parsing parameters" $ do+ c <- mkConf ["--", "--some.key=value"]+ res <- getKeyInSource c "some.key"+ res `shouldBe` Nothing++ it "with passed flag without a value it returns true" $ do+ c <- mkConf ["--some.key"]+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "true"
+ test/Conferer/Source/EnvSpec.hs view
@@ -0,0 +1,58 @@+module Conferer.Source.EnvSpec where++import Test.Hspec+import Test.QuickCheck++import Conferer.Source+import Conferer.Source.Env++spec :: Spec+spec = do+ describe "with an env source" $ do+ let+ mkEnvConfig envVars =+ return $ fromEnvList envVars "APP"++ it "getting an existent key returns unwraps top level value (without \+ \children)" $ do+ c <- mkEnvConfig+ [ ("APP_THING","thing")+ , ("APP","root")+ , ("APP_PG_HOST","some host")+ , ("APP_PG_PORT","some port")+ , ("SOMETHING_ELSE","else")+ ]+ res <- getKeyInSource c ""+ res `shouldBe` Just "root"++ it "getting an existent key for a child gets that value" $ do+ c <- mkEnvConfig+ [ ("APP_THING","thing")+ ]+ res <- getKeyInSource c "thing"+ res `shouldBe` Just "thing"++ it "listing some keys returns all the right values" $ do+ c <- mkEnvConfig+ [ ("APP_PG_HOST","some host")+ , ("APP_PG_PORT","some port")+ ]+ res <- getSubkeysInSource c "pg"+ res `shouldBe` ["pg.host", "pg.port"]++ it "listing the keys under the root list everything excluding ." $ do+ c <- mkEnvConfig+ [ ("APP_SOME","value")+ , ("APP","value")+ , ("SOMETHING_ELSE","else")+ ]+ res <- getSubkeysInSource c ""+ res `shouldBe` ["some"]++ it "key to env var and back be identity" $ property $+ forAll+ (elements ["a", "a.b", "", "a.b.c", "UPPER"])+ $ \k ->+ envVarToKey "theapp" (keyToEnvVar "theapp" k)+ == Just k+
+ test/Conferer/Source/InMemorySpec.hs view
@@ -0,0 +1,32 @@+module Conferer.Source.InMemorySpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.InMemory++spec :: Spec+spec = do+ describe "in memory source" $ do+ let source =+ fromAssociations [("postgres.url", "some url")]++ it "getting a non existent key returns an empty config" $ do+ res <- getKeyInSource source "some.key"+ res `shouldBe` Nothing++ it "getting an existent key returns unwraps the original map" $ do+ res <- getKeyInSource source "postgres.url"+ res `shouldBe` Just "some url"++ it "listing subkeys works" $ do+ res <- getSubkeysInSource source "postgres"+ res `shouldBe` ["postgres.url"]++ it "listing subkeys never returns the same key" $ do+ res <- getSubkeysInSource source "postgres.url"+ res `shouldBe` []++ it "listing subkeys that are not present" $ do+ res <- getSubkeysInSource source "stuff"+ res `shouldBe` []
+ test/Conferer/Source/NamespacedSpec.hs view
@@ -0,0 +1,25 @@+module Conferer.Source.NamespacedSpec where++import Test.Hspec++import Conferer.Source++import qualified Conferer.Source.InMemory as InMemory+import Conferer.Source.Namespaced++spec :: Spec+spec = do+ describe "namespaced config" $ do+ let source =+ fromInner "postgres" $+ InMemory.fromAssociations [("url", "some url")]+ it "return nothing if the key doesn't match" $ do+ res <- getKeyInSource source "url"+ res `shouldBe` Nothing+ it "returns the wrapped value" $ do+ res <- getKeyInSource source "postgres.url"+ res `shouldBe` Just "some url"+ it "listing subkeys" $ do+ res <- getSubkeysInSource source "postgres"+ res `shouldBe` ["postgres.url"]+
+ test/Conferer/Source/NullSpec.hs view
@@ -0,0 +1,12 @@+module Conferer.Source.NullSpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.Null++spec :: Spec+spec = do+ it "always fails to get a key" $ do+ res <- getKeyInSource empty "some.key"+ res `shouldBe` Nothing
+ test/Conferer/Source/PropertiesFileSpec.hs view
@@ -0,0 +1,32 @@+module Conferer.Source.PropertiesFileSpec where++import Test.Hspec++import Conferer.Source+import Conferer.Source.PropertiesFile++spec :: Spec+spec = do+ describe "with a properties file config" $ do+ let mk = return . fromFileContent "file.properties"+ it "getting an existent key returns unwraps top level value (without \+ \children)" $ do+ c <- mk "some.key=a value"+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "a value"++ it "getting an existent key for a child gets that value" $ do+ c <- mk "some.key=b"+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "b"++ it "keys should always be consistent as to how the words are separated" $ do+ c <- mk "some.key=a value"+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just "a value"++ it "respects leading spaces in values" $ do+ c <- mk "some.key= a value "+ res <- getKeyInSource c "some.key"+ res `shouldBe` Just " a value "+
test/ConfererSpec.hs view
@@ -1,33 +1,47 @@+{-# LANGUAGE TypeApplications #-}+-- {-# LANGUAGE DeriveGeneric #-}+-- {-# LANGUAGE TypeApplications #-}+ module ConfererSpec where import Test.Hspec-import Conferer +import Data.Text (Text)+import Conferer.FromConfig (fetchFromConfig)+import Conferer.Source.InMemory (fromConfig)+import Data.Dynamic (toDyn)+import Conferer.Config (Config)+import Conferer (mkConfig', Key)+ spec :: Spec spec = do- describe "keys" $ do- it "parsing keys does the right thing" $ do- "some.key" `shouldBe` Path ["some", "key"]- it "an empty string is the empty list" $ do- "" `shouldBe` Path []+ describe "mkConfig'" $ do+ let a = fromConfig [("keyPresentInBoth", "valueInA"), ("keyPresentOnlyInA", "valueInA")]+ b = fromConfig [("keyPresentInBoth", "valueInB"), ("keyPresentOnlyInB", "valueInB")]+ shouldHaveKeyWithValue :: Config -> Key -> Text -> Expectation+ shouldHaveKeyWithValue config key expected = do+ actual <- fetchFromConfig key config+ actual `shouldBe` expected+ describe "the precedence of the sources is defined by the order in the list" $ do+ it "if several sources have a value for the key, the first source in the list that has it is used" $ do+ config <- mkConfig' [] [a, b] - describe "with a config with a nested value" $ do- let mkConfig =- pure emptyConfig- >>= addProvider (mkMapProvider [ ("postgres.url", "some url")])- >>= addProvider (mkMapProvider [ ("postgres.url", "different url") , ("server.port", "4000")])+ config `shouldHaveKeyWithValue` "keyPresentInBoth" $ "valueInA"+ it "if only one source has a value for the key, that source is used" $ do+ config <- mkConfig' [] [a, b] - it "getting a non existent key returns an empty config" $ do- c <- mkConfig- res <- getKey "aaa" c- res `shouldBe` Nothing+ config `shouldHaveKeyWithValue` "keyPresentOnlyInB" $ "valueInB"+ it "if the key is not present in any source, it doesn't retrieve any value" $ do+ config <- mkConfig' [] [a, b] - it "getting an existent key returns unwraps the original map" $ do- c <- mkConfig- res <- getKey "postgres.url" c- res `shouldBe` Just "some url"- it "getting an existent key returns in the bottom maps gets it" $ do- c <- mkConfig- res <- getKey "server.port" c- res `shouldBe` Just "4000"+ value <- fetchFromConfig "keyNotPresentInAnySource" config+ value `shouldBe` (Nothing :: Maybe Text)+ describe "adds the defaults to the config" $ do+ it "if the key is present in a source and in the default, it uses the first source that has it" $ do+ config <- mkConfig' [("keyPresentOnlyInA", toDyn @Text "defaultValue")] [a] + config `shouldHaveKeyWithValue` "keyPresentOnlyInA" $ "valueInA"+ it "if the key is not present in any source but it's in a default, it uses the default" $ do+ config <- mkConfig' [("keyPresentOnlyInA", toDyn @Text "defaultValue")] [b]++ config `shouldHaveKeyWithValue` "keyPresentOnlyInA" $ "defaultValue"
+ test/ConfererSpecMain.hs view
@@ -0,0 +1,7 @@+module ConfererSpecMain where++import Test.Hspec.Runner+import qualified Spec++main :: IO ()+main = hspecWith defaultConfig Spec.spec
test/Spec.hs view
@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}