envy-extensible (empty) → 0.1.0.0
raw patch · 8 files changed
+265/−0 lines, 8 filesdep +QuickCheckdep +basedep +doctestsetup-changed
Dependencies added: QuickCheck, base, doctest, envy, envy-extensible, extensible, hspec, main-tester
Files
- LICENSE +30/−0
- README.md +4/−0
- Setup.hs +2/−0
- envy-extensible.cabal +51/−0
- src/Data/Extensible/Envy.hs +114/−0
- test/Data/Extensible/EnvySpec.hs +59/−0
- test/Spec.hs +1/−0
- test/doctest.hs +4/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020 IIJ Innovation Institute, Inc.++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 IIJ Innovation Institute, Inc. 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.
+ README.md view
@@ -0,0 +1,4 @@+# envy-extensible++Provides [`FromEnv`](http://hackage.haskell.org/package/envy/docs/System-Envy.html#t:FromEnv) instance for [`Record`](https://hackage.haskell.org/package/extensible/docs/Data-Extensible-Field.html#t:Record) and functions to create `Record` from environment variable using [Parser](http://hackage.haskell.org/package/envy/docs/System-Envy.html#t:Parser). +See [the spec file](https://github.com/igrep/envy-extensible/blob/master/test/Data/Extensible/EnvySpec.hs) for examples.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ envy-extensible.cabal view
@@ -0,0 +1,51 @@+cabal-version: 2.2+name: envy-extensible+version: 0.1.0.0+synopsis: Provides FromEnv in envy instance for Record of extensible.+-- description:+homepage: https://github.com/igrep/envy-extensible#readme+license: BSD-3-Clause+license-file: LICENSE+author: IIJ Innovation Institute, Inc.+maintainer: yuji-yamamoto@iij.ad.jp+copyright: 2020 IIJ Innovation Institute, Inc.+category: Data, Record+build-type: Simple+extra-source-files: README.md++common shared+ default-language: Haskell2010+ build-depends: , base >= 4.7 && < 5+ , extensible >= 0.6+ , envy >= 2.0++library+ import: shared+ hs-source-dirs: src+ exposed-modules: Data.Extensible.Envy++test-suite envy-extensible-test+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: Data.Extensible.EnvySpec+ build-depends: , envy-extensible+ , hspec+ , main-tester+ , QuickCheck+ build-tool-depends: hspec-discover:hspec-discover+ ghc-options: -rtsopts++test-suite envy-extensible-doctest+ import: shared+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: doctest.hs+ build-depends: , envy-extensible+ , doctest+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall++source-repository head+ type: git+ location: https://github.com/igrep/envy-extensible
+ src/Data/Extensible/Envy.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans #-}++--------------------------------------------------------------------------------+-- |+-- Module : Data.Extensible.Envy+-- Copyright : (c) 2020 IIJ Innovation Institute, Inc.+-- License : BSD3+-- Maintainer: YAMAMOTO Yuji <yuji-yamamoto@iij.ad.jp>+-- Stability : Experimental+--+-- Provides 'Env.FromEnv' instance for 'Ex.Record' and functions to+-- create 'Ex.Record' from environment variable using 'Env.Parser'.+--------------------------------------------------------------------------------+module Data.Extensible.Envy+ ( recordFromEnvWith+ , recordFromEnv+ , FieldLabelToEnvName+ , defaultFieldLabelToEnvName+ , camelToUpperSnakeCase+ ) where+++import qualified Data.Char as C+import Data.Extensible (Forall, Instance1)+import qualified Data.Extensible as Ex+import Data.Functor.Identity (Identity (Identity), runIdentity)+import Data.Kind (Type)+import Data.Proxy (Proxy (Proxy))+import GHC.TypeLits (KnownSymbol, Symbol)+import qualified System.Envy as Env+++-- | Function to convert field labels of 'Ex.Record' into the+-- name of environment variable.+-- Applied to each field label before passing it to 'Env.env'+type FieldLabelToEnvName = String -> String+++-- | The default of 'FieldLabelToEnvName'.+--+-- If the first argument is empty, just convert the field label+-- (second argument) into @UPPER_SNAKE_CASE@.+--+-- >>> defaultFieldLabelToEnvName "" "thisIsATest"+-- "THIS_IS_A_TEST"+--+-- Otherwise, convert the field label into @UPPER_SNAKE_CASE@,+-- then prepend the first argument with an underscore @_@.+--+-- >>> defaultFieldLabelToEnvName "PREFIXED" "thisIsATest"+-- "PREFIXED_THIS_IS_A_TEST"+defaultFieldLabelToEnvName :: String -> FieldLabelToEnvName+defaultFieldLabelToEnvName "" s = camelToUpperSnakeCase s+defaultFieldLabelToEnvName prefix s = prefix ++ "_" ++ camelToUpperSnakeCase s+{-# INLINE defaultFieldLabelToEnvName #-}+++-- | Used internally in 'defaultFieldLabelToEnvName'.+-- Published for your convenience.+camelToUpperSnakeCase :: FieldLabelToEnvName+camelToUpperSnakeCase =+ foldMap (\c -> if C.isUpper c then '_' : [c] else [C.toUpper c])+{-# INLINE camelToUpperSnakeCase #-}+++-- |+-- @+-- recordFromEnv = recordFromEnvWith $ defaultFieldLabelToEnvName ""+-- @+recordFromEnv+ :: forall (xs :: [Ex.Assoc Symbol Type]) h+ . Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs+ => Env.Parser (Ex.RecordOf h xs)+recordFromEnv = recordFromEnvWith $ defaultFieldLabelToEnvName ""+{-# INLINE recordFromEnv #-}+++-- | 'Env.Parser' for 'Ex.Record'+recordFromEnvWith+ :: forall (xs :: [Ex.Assoc Symbol Type]) h+ . Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs+ => FieldLabelToEnvName+ -> Env.Parser (Ex.RecordOf h xs)+recordFromEnvWith fl2en =+ Ex.hgenerateFor+ (Proxy :: Proxy (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h))) f+ where+ f membership = Ex.Field <$> Env.env (fl2en $ Ex.stringKeyOf membership)+{-# INLINE recordFromEnvWith #-}+++-- | Returns 'recordFromEnv' when the first argument of 'Env.fromEnv' is @Nothing@.+instance Forall (Ex.KeyTargetAre KnownSymbol (Instance1 Env.Var h)) xs+ => Env.FromEnv (Ex.RecordOf (h :: Type -> Type) xs)+ where+ fromEnv (Just r) = pure r+ fromEnv Nothing = recordFromEnv+ {-# INLINE fromEnv #-}+++-- | Necessary to make 'Ex.Record' an instance of 'Env.FromEnv'+instance Env.Var a => Env.Var (Identity a) where+ toVar = Env.toVar . runIdentity+ {-# INLINE toVar #-}+ fromVar = fmap Identity . Env.fromVar+ {-# INLINE fromVar #-}
+ test/Data/Extensible/EnvySpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE ExplicitNamespaces #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeOperators #-}++module Data.Extensible.EnvySpec+ ( main+ , spec+ ) where++import Data.Either (isLeft)+import Data.Extensible (type (>:), (<:), (@=))+import qualified Data.Extensible as Ex+import qualified System.Envy as Env+import Test.Hspec+import Test.Main (withEnv)++import Data.Extensible.Envy+++type SomeRecord = Ex.Record+ '[ "fooField" >: String+ , "bar" >: Bool+ , "baz" >: Int+ ]+++main :: IO ()+main = hspec spec+++spec :: Spec+spec = describe "recordFromEnvWith" $ do+ let fl2en = defaultFieldLabelToEnvName "EXAMPLE_RECORD"+ context "When all of the required environment variables are created" $+ it "can be created by System.Envy.runEnv" $ do+ let env =+ [ ("EXAMPLE_RECORD_FOO_FIELD", Just "string")+ , ("EXAMPLE_RECORD_BAR", Just "True")+ , ("EXAMPLE_RECORD_BAZ", Just "1230")+ ]+ expected :: SomeRecord+ expected =+ #fooField @= "string"+ <: #bar @= True+ <: #baz @= 1230+ <: Ex.nil+ withEnv env $+ Env.runEnv (recordFromEnvWith fl2en) `shouldReturn` Right expected+ context "When some of the required environment variables are not created" $+ it "can't be created by System.Envy.runEnv" $ do+ let env =+ [ ("EXAMPLE_RECORD_FOO_FIELD", Just "string")+ , ("EXAMPLE_RECORD_BAR", Just "True")+ , ("EXAMPLE_RECORD_BAZ", Nothing)+ ]+ withEnv env $ do+ result <- Env.runEnv (recordFromEnvWith fl2en) :: IO (Either String SomeRecord)+ result `shouldSatisfy` isLeft
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/doctest.hs view
@@ -0,0 +1,4 @@+import Test.DocTest++main :: IO ()+main = doctest ["src/Data/Extensible/Envy.hs"]