embed-config (empty) → 0.0.0.0

raw patch · 7 files changed

+288/−0 lines, 7 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, embed-config, file-embed, hspec, template-haskell, yaml

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• README.md +27/−0
• embed-config.cabal +56/−0
• src/Data/Yaml/Config/Embed.hs +47/−0
• src/Data/Yaml/Config/Kebab.hs +62/−0
• test/embed-config-test.hs +61/−0

@@ -0,0 +1,5 @@+# Changelog for embed-config++## 0.0.0.0++* First release

@@ -0,0 +1,30 @@+Copyright SimSpace (c) 2022++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of SimSpace nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,27 @@+# embed-config [![embed-config](https://img.shields.io/hackage/v/embed-config.svg?logo=haskell&color=blueviolet)](https://hackage.haskell.org/package/embed-config)++Reasonable conventions for embedding YAML configuration with Template Haskell++## Quick Start++**config/settings.yml**+```yaml+foo-bar: 42+baz-quux: hello+```++**src/MyApp/Config.hs**+```haskell+module MyApp.Config where++import Data.Yaml.Config.Embed (AesonKebab(..), embedConfig)++loadConfig :: IO Config+loadConfig = $(embedConfig)++data Config = Config+  { fooBar :: Int+  , bazQuux :: String+  } deriving stock (Show, Eq, Generic)+    deriving (FromJSON) via AesonKebab Config+```

@@ -0,0 +1,56 @@+cabal-version: 1.12++name:           embed-config+version:        0.0.0.0+description:    Please see the README on GitHub at <https://github.com/simspace/embed-config#readme>+synopsis:       Reasonable conventions for embedding YAML configuration with Template Haskell+category:       Configuration+homepage:       https://github.com/simspace/embed-config#readme+bug-reports:    https://github.com/simspace/embed-config/issues+author:         Cary Robbins+maintainer:     carymrobbins@gmail.com+copyright:      2022 SimSpace+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/simspace/embed-config++library+  exposed-modules:+      Data.Yaml.Config.Embed+      Data.Yaml.Config.Kebab+  other-modules:+      Paths_embed_config+  hs-source-dirs: src+  build-depends:+      base >=4.7 && <5+    , aeson >=1.5.6.0 && <2+    , bytestring >=0.10.12.0 && <1+    , file-embed >=0.0.15.0 && <1+    , template-haskell >=2.16.0.0 && <3+    , yaml >=0.11.8.0 && <1+  default-language: Haskell2010+  ghc-options:+    -Wall -fwarn-tabs -Wincomplete-uni-patterns+    -Werror=missing-home-modules -eventlog +RTS -A32M -RTS++test-suite embed-config-test+  type: exitcode-stdio-1.0+  main-is: embed-config-test.hs+  hs-source-dirs: test+  ghc-options:+    -Wall -fwarn-tabs -Wincomplete-uni-patterns+    -Werror=missing-home-modules -eventlog +RTS -A32M -RTS+    -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5+    , aeson+    , embed-config+    , hspec+  default-language: Haskell2010

@@ -0,0 +1,47 @@+-- | Reasonable conventions for embedding YAML configuration with Template Haskell+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+module Data.Yaml.Config.Embed+  ( module Data.Yaml.Config.Embed+  , AesonKebab(..)+  )+  where++import Control.Exception (throwIO)+import Data.Aeson (FromJSON, Value)+import Data.ByteString (ByteString)+import Data.FileEmbed (embedFile, makeRelativeToProject)+import Data.Yaml.Config.Kebab (AesonKebab(..))+import Language.Haskell.TH.Syntax (Exp, Q)++import qualified Data.Yaml as Yaml+import qualified Data.Yaml.Config as Yaml.Config++-- | TH function for loading @config/settings.yml@ relative to+-- the project in which the TH splice is written.+--+-- > loadConfig :: IO MyConfig+-- > loadConfig = $(embedConfig)+embedConfig :: Q Exp+embedConfig = embedConfigRelativeToProject "config/settings.yml"++-- | TH function for loading the supplied config file path+-- relative to the project in which the TH splice is written.+--+-- > loadConfig :: IO MyConfig+-- > loadConfig = $(embedConfigRelativeToProject "path/to/settings.yml")+embedConfigRelativeToProject :: FilePath -> Q Exp+embedConfigRelativeToProject relPath = do+  absPath <- makeRelativeToProject relPath+  [| loadFromBytes $(embedFile absPath) |]++-- | Given the file content, read a YAML config file.+loadFromBytes :: (FromJSON a) => ByteString -> IO a+loadFromBytes bytes = do+  yaml <- either throwIO pure $ Yaml.decodeEither' bytes+  loadFromValue yaml++-- | Given the file content as an Aeson 'Value', read a YAML config file.+loadFromValue :: (FromJSON a) => Value -> IO a+loadFromValue yaml = do+  Yaml.Config.loadYamlSettings [] [yaml] Yaml.Config.useEnv

@@ -0,0 +1,62 @@+-- | Provides kebab-case instances for @aeson@.+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE UndecidableInstances #-}+module Data.Yaml.Config.Kebab where++import Data.Aeson (FromJSON, ToJSON)+import GHC.Generics (Generic, Rep)++import qualified Data.Aeson as Aeson+import qualified Data.Char as Char+import qualified Language.Haskell.TH.Syntax as TH++-- | A DerivingVia wrapper that only turns all fields into kebab-case.+-- No other field processing occurs, which also means no field prefix stripping.+newtype AesonKebab a = AesonKebab a++-- | Default 'Aeson.Options' which sets 'Aeson.fieldLabelModifier' to use 'kebab'.+aesonKebabOptions :: Aeson.Options+aesonKebabOptions =+  Aeson.defaultOptions+    { Aeson.fieldLabelModifier = kebab+    }++-- | Convert a @camelCase@ string to @kebab-case@.+kebab :: String -> String+kebab s = do+  c <- s+  if Char.isUpper c then ['-', Char.toLower c] else [c]++-- | Gets the given identifier name as a 'String' but converts it+-- to @kebab-case@. Useful for+--+-- > fooBar = True+-- > kebabName 'fooBar == "foo-bar"+kebabName :: TH.Name -> String+kebabName = kebab . getName++-- | Gets the given identifier name as a 'String'.+--+-- If @DuplicateRecordFields@ is enabled, detects the names in the form of+-- @$sel:name:Type@ and extracts the @name@.+getName :: TH.Name -> String+getName (TH.Name (TH.OccName s) _) =+  case s of+    '$' : _ -> takeWhile (/= ':') (drop 5 s)+    _ -> s++instance+  ( Generic a+  , Aeson.GToJSON Aeson.Zero (Rep a)+  , Aeson.GToEncoding Aeson.Zero (Rep a)+  ) => ToJSON (AesonKebab a)+  where+  toJSON (AesonKebab a) = Aeson.genericToJSON aesonKebabOptions a+  toEncoding (AesonKebab a) = Aeson.genericToEncoding aesonKebabOptions a++instance+  ( Generic a+  , Aeson.GFromJSON Aeson.Zero (Rep a)+  ) => FromJSON (AesonKebab a)+  where+  parseJSON v = AesonKebab <$> Aeson.genericParseJSON aesonKebabOptions v

@@ -0,0 +1,61 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE TemplateHaskell #-}+module Main where++import Data.Aeson (FromJSON)+import Data.Yaml.Config.Embed (AesonKebab(..), embedConfig, embedConfigRelativeToProject)+import GHC.Generics (Generic)+import System.Environment (setEnv, unsetEnv)+import Test.Hspec (describe, hspec, it, shouldReturn)++main :: IO ()+main = hspec do+  describe "embedConfig" do+    it "default-environment" do+      unsetEnv "FOO_BAR"+      unsetEnv "BAZ_QUUX"+      $(embedConfig) `shouldReturn`+        Config1+          { fooBar = 1+          , bazQuux = "two"+          }+    it "custom-environment" do+      setEnv "FOO_BAR" "7"+      setEnv "BAZ_QUUX" "twelve"+      $(embedConfig) `shouldReturn`+        Config1+          { fooBar = 7+          , bazQuux = "twelve"+          }+  describe "embedConfigRelativeToProject" do+    it "default-environment" do+      unsetEnv "SPAM_EGGS"+      unsetEnv "PARROT_ZOOM"+      $(embedConfigRelativeToProject "config/settings2.yml") `shouldReturn`+        Config2+          { spamEggs = 3+          , parrotZoom = "hi"+          }+    it "custom-environment" do+      setEnv "SPAM_EGGS" "255"+      setEnv "PARROT_ZOOM" "bye"+      $(embedConfigRelativeToProject "config/settings2.yml") `shouldReturn`+        Config2+          { spamEggs = 255+          , parrotZoom = "bye"+          }++data Config1 = Config1+  { fooBar :: Int+  , bazQuux :: String+  } deriving stock (Show, Eq, Generic)+    deriving (FromJSON) via AesonKebab Config1++data Config2 = Config2+  { spamEggs :: Int+  , parrotZoom :: String+  } deriving stock (Show, Eq, Generic)+    deriving (FromJSON) via AesonKebab Config2