envparse 0.3.0 → 0.3.1

raw patch · 7 files changed

+403/−8 lines, 7 filesdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.markdown +6/−1
• envparse.cabal +13/−4
• example/Generic.hs +46/−0
• src/Env/Generic.hs +167/−0
• src/Env/Parse.hs +1/−3
• test/Env/GenericSpec.hs +57/−0
• test/EnvSpec.hs +113/−0

@@ -1,4 +1,9 @@-0.2.2+0.3.1+=====++  * Supported `Generic`ally derived `Parser`s on GHC 7.10.++0.3.0 =====    * Supported user-defined `Reader` errors. (https://github.com/supki/envparse/pull/4)

@@ -1,5 +1,5 @@ name:                envparse-version:             0.3.0+version:             0.3.1 synopsis:            Parse environment variables description:   Here's a simple example of a program that uses @envparse@'s parser:@@ -59,6 +59,7 @@   CHANGELOG.markdown   example/Main.hs   example/CustomError.hs+  example/Generic.hs  source-repository head   type:     git@@ -67,18 +68,22 @@ source-repository this   type:     git   location: https://github.com/supki/envparse-  tag:      0.3.0+  tag:      0.3.1  library   default-language:     Haskell2010   build-depends:-      base       >= 4.6 && < 5+      base+      >= 4.6 && < 5     , containers   hs-source-dirs:     src   exposed-modules:     Env+  if impl(ghc >= 7.10)+    exposed-modules:+      Env.Generic   other-modules:     Env.Error     Env.Free@@ -94,7 +99,8 @@   type:     exitcode-stdio-1.0   build-depends:-      base       >= 4.6 && < 5+      base+      >= 4.6 && < 5     , containers     , hspec   hs-source-dirs:@@ -102,5 +108,8 @@     test   main-is:     Spec.hs+  other-modules:+    EnvSpec+    Env.GenericSpec   ghc-options:     -Wall

@@ -0,0 +1,46 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 710+module Main (main) where++main :: IO ()+main =+  return ()+#else+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TypeOperators #-}+-- | Greetings for $NAME+--+-- @+-- % GENERIC_NAME=a5579150 runhaskell -isrc example/Generic.hs+-- Hello, a5579150!+-- % GENERIC_NAME=a5579150 GENERIC_QUIET=1 runhaskell -isrc example/Generic.hs+-- %+-- @+module Main (main) where++import Control.Monad (unless)+import Env+import Env.Generic+++data Hello = Hello+  { name  :: String ? "Target for the greeting"+  , quiet :: Bool   ? "Whether to actually print the greeting"+  } deriving (Show, Eq, Generic)++instance Record Error Hello++main :: IO ()+main = do+  Hello {name=Help n, quiet=Help q} <- hello+  unless q $+    putStrLn ("Hello, " ++ n ++ "!")++hello :: IO Hello+hello =+  Env.parse (header "envparse example") (prefixed "GENERIC_" record)+#endif

@@ -0,0 +1,167 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+module Env.Generic+  ( Record(..)+  , Field(..)+  , (?)(..)+  , G.Generic+  ) where++import           Control.Applicative (liftA2, (<|>))+import           Control.Monad (guard)+import qualified Data.Char as Char+import           Data.Int (Int8, Int16, Int32, Int64)+import           Data.Word (Word8, Word16, Word32, Word64)+import qualified Data.List as List+import           Data.Maybe (fromMaybe)+import           Data.Proxy (Proxy(Proxy))+import qualified GHC.Generics as G+import qualified GHC.TypeLits as G+import           Numeric.Natural (Natural)+import           Prelude hiding (mod)++import qualified Env+++class Record e a where+  record :: Env.Parser e a+  default record :: (r ~ G.Rep a, G.Generic a, GRecord e r) => Env.Parser e a+  record =+    fmap G.to (gr State {statePrefix="", stateCon="", stateVar=""})++-- | Generic parsing state.+data State = State+  { statePrefix :: String -- ^ All variables' names have this prefix.+  , stateCon    :: String -- ^ Constructor currently being processed.+  , stateVar    :: String -- ^ Variable name to use for the next component.+  } deriving (Show, Eq)++class GRecord e f where+  gr :: State -> Env.Parser e (f a)++-- | We are not interested in any metadata of the type constructor definition.+instance GRecord e a => GRecord e (G.D1 c a) where+  gr =+    fmap G.M1 . gr++-- | Constant values are converted to 'Env.Parser's using their 'Field' instance.+instance (Env.AsUnset e, Field e a) => GRecord e (G.K1 i a) where+  gr State {stateVar} =+    fmap G.K1 (field stateVar Nothing)++-- | Constructor's name is used as a prefix to try to remove from+-- selectors when building environment variable names.+instance (G.Constructor c, GRecord e a) => GRecord e (G.C1 c a) where+  gr state =+    fmap G.M1 (gr state {stateCon=con})+   where+    con = G.conName (G.M1 Proxy :: G.M1 t c Proxy b)++-- | Products are converted to products of parsers.+instance (GRecord e f, GRecord e g) => GRecord e (f G.:*: g) where+  gr x =+    liftA2 (G.:*:) (gr x) (gr x)++-- | Sums are converted to sums of parsers.+instance (GRecord e f, GRecord e g) => GRecord e (f G.:+: g) where+  gr x =+    fmap G.L1 (gr x) <|> fmap G.R1 (gr x)++-- | Record selectors' names determine suffixes of environment variables' names.+instance (G.Selector c, Type c ~ 'Record, GRecord e a) => GRecord e (G.S1 c a) where+  gr state@State {statePrefix, stateCon} =+    fmap G.M1 (gr state {stateVar=statePrefix ++ suffix})+   where+    sel = G.selName (G.M1 Proxy :: G.M1 t c Proxy b)+    suffix = let+        x = camelTo2 sel+      in fromMaybe x $ do+        y <- List.stripPrefix (map Char.toLower stateCon) sel+        camelTo2 y <$ guard (not (List.null y))++-- | Stolen from Aeson and adapted.+camelTo2 :: String -> String+camelTo2 = map Char.toUpper . go2 . go1+ where+  go1 "" = ""+  go1 (x:u:l:xs) | Char.isUpper u && Char.isLower l = x : '_' : u : l : go1 xs+  go1 (x:xs) = x : go1 xs++  go2 "" = ""+  go2 (l:u:xs) | Char.isLower l && Char.isUpper u = l : '_' : u : go2 xs+  go2 (x:xs) = x : go2 xs++-- | Decide whether the constructor is a record.+type family Type x :: ConType where+  Type G.NoSelector = 'Plain+  Type x = 'Record++-- | Constructor can be either a plain thing or a record.+data ConType = Plain | Record++class Field e a where+  field :: String -> Maybe String -> Env.Parser e a+  default field :: (Env.AsUnset e, Env.AsUnread e, Read a) => String -> Maybe String -> Env.Parser e a+  field name help =+    Env.var Env.auto name (foldMap Env.help help)++instance (Env.AsUnset e, Env.AsUnread e) => Field e Int++instance (Env.AsUnset e, Env.AsUnread e) => Field e Int8++instance (Env.AsUnset e, Env.AsUnread e) => Field e Int16++instance (Env.AsUnset e, Env.AsUnread e) => Field e Int32++instance (Env.AsUnset e, Env.AsUnread e) => Field e Int64++instance (Env.AsUnset e, Env.AsUnread e) => Field e Integer++instance (Env.AsUnset e, Env.AsUnread e) => Field e Word++instance (Env.AsUnset e, Env.AsUnread e) => Field e Word8++instance (Env.AsUnset e, Env.AsUnread e) => Field e Word16++instance (Env.AsUnset e, Env.AsUnread e) => Field e Word32++instance (Env.AsUnset e, Env.AsUnread e) => Field e Word64++instance (Env.AsUnset e, Env.AsUnread e) => Field e Natural++instance (Env.AsUnset e, Env.AsUnread e) => Field e Float++instance (Env.AsUnset e, Env.AsUnread e) => Field e Double++instance Env.AsUnset e => Field e String where+  field name help =+    Env.var Env.str name (foldMap Env.help help)++instance (Env.AsUnset e, Env.AsUnread e) => Field e Char where+  field name help =+    Env.var reader name (foldMap Env.help help)+   where+    reader = \case+      [c] -> pure c+      str -> Left (Env.unread str)++instance (Env.AsUnset e, Env.AsEmpty e) => Field e Bool where+  field name help =+    Env.switch name (foldMap Env.help help)++-- | Variable tagged with its help message.+newtype a ? tag = Help { unHelp :: a }+    deriving (Show, Eq, Functor, Foldable, Traversable)++instance (G.KnownSymbol tag, Field e a) => Field e (a ? tag) where+  field name _ =+    fmap Help (field name (pure (G.symbolVal (Proxy :: Proxy tag))))

@@ -151,8 +151,6 @@   mempty = Mod id   mappend (Mod f) (Mod g) = Mod (g . f) -- -- | Environment variable metadata data Var a = Var   { varHelp    :: Maybe String@@ -175,7 +173,7 @@  -- | Flag metadata data Flag a = Flag-  { flagHelp    :: Maybe String+  { flagHelp   :: Maybe String   }  defaultFlag :: Flag a

@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Env.GenericSpec (spec) where++import Test.Hspec+#if __GLASGOW_HASKELL__ < 710+++spec :: Spec+spec =+  return ()+#else++import Env+import Env.Generic+++spec :: Spec+spec = do+  fooBarSpec+  quxSpec++data FooBar = FooBar+  { foo :: String+  , bar :: Int+  } deriving (Show, Eq, Generic)++instance Record Error FooBar++fooBarSpec :: Spec+fooBarSpec =+  describe "FooBar" $+    it "can be parsed using the Generic parser" $+      p [("FOO", "blah"), ("BAR", "4")] `shouldBe`+        pure FooBar {foo="blah", bar=4}++data Qux = Qux+  { quxXyz   :: Bool+  , quxXyzZy :: Int+  } deriving (Show, Eq, Generic)++instance Record Error Qux++quxSpec :: Spec+quxSpec =+  describe "Qux" $+    it "can be parsed using the Generic parser" $+      p [("XYZ", "1"), ("XYZ_ZY", "7")] `shouldBe`+        pure Qux {quxXyz=True, quxXyzZy=7}++p :: Record Error a => [(String, String)] -> Either [(String, Error)] a+p =+  parsePure record+#endif

@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}+module EnvSpec (spec) where++import           Control.Applicative+import           Control.Monad+#if __GLASGOW_HASKELL__ < 710+import           Data.Monoid (mempty)+#endif+import           Prelude hiding (pi)+import           Test.Hspec+import           Text.Read (readMaybe)++import           Env++default (Integer, Double, String)+++spec :: Spec+spec =+  describe "parsing" $ do+    it "parsing the environment with the noop parser always succeeds" $+      p (pure ()) `shouldBe` Just ()++    it "parsing the environment with the failing parser always fails" $+      p Control.Applicative.empty `shouldBe` Nothing++    it "looking for the non-existing env var fails" $+      p (var str "xyzzy" mempty) `shouldBe` Nothing++    it "looking for the existing env var is a success" $+      p (var str "foo" mempty) `shouldBe` Just "bar"++    it "looking for many existing env vars is a success" $ do+      let x = (,) <$> var str "foo" mempty <*> var str "qux" mempty+      p x `shouldBe` Just ("bar", "quux")++    it "looking for the existing env var selects the active flag value" $+      p (flag 4 7 "foo" mempty) `shouldBe` Just 7++    it "looking for the existing but empty env var selects the default flag value" $+      p (flag 4 7 "empty" mempty) `shouldBe` Just 4++    it "looking for the non-existing env var selects the default flag value" $+      p (flag 4 7 "xyzzy" mempty) `shouldBe` Just 4++    context "readers" $ do+      it "can use a reader to parse the env var value" $+        p (var auto "num" mempty) `shouldBe` Just 4++      it "can use a custom reader" $ do+        p (var greaterThan5 "num"  mempty) `shouldBe` Nothing+        p (var greaterThan5 "num2" mempty) `shouldBe` Just 7++      it "'nonempty' weeds out variables set to the empty string" $+        p (var (str <=< nonempty) "empty" mempty) `shouldBe` Nothing++    context "alternatives" $ do+      it "can look through a list of alternatives" $+        p (asum+          [ var (\_ -> pure 1) "nope"       mempty+          , var (\_ -> pure 2) "still-nope" mempty+          , var (\_ -> pure 3) "yep"        mempty+          ]) `shouldBe` Just 3++      it "variables can have default values" $+        p (asum+          [ var (\_ -> pure 1) "nope"       mempty+          , var (\_ -> pure 2) "still-nope" (def 4)+          , var (\_ -> pure 3) "yep"        mempty+          ]) `shouldBe` Just 4++    context "modifiers" $ do+      it "the latter modifier overwrites the former" $+        p (var (\_ -> Left (unread "nope")) "never" (def 4 <> def 7)) `shouldBe` Just 7++      it "‘prefixed’ modifier changes the names of the variables" $+        p (prefixed "spec_" (var str "foo" mempty)) `shouldBe` Just "totally-not-bar"++      it "‘prefixed’ modifier can be nested" $+        p (prefixed "pre" (prefixed "pro" (var str "morphism" mempty)))+       `shouldBe`+        Just "zygohistomorphic"+++greaterThan5 :: AsUnread e => Reader e Int+greaterThan5 s =+  note (unread "fail") (do v <- readMaybe s; guard (v > 5); return v)++p :: Parser Error a -> Maybe a+p x = hush (parsePure x fancyEnv)++fancyEnv :: [(String, String)]+fancyEnv =+  [ "foo"      ~> "bar"+  , "spec_foo" ~> "totally-not-bar"+  , "prepromorphism"+               ~> "zygohistomorphic"+  , "qux"      ~> "quux"+  , "num"      ~> "4"+  , "num2"     ~> "7"+  , "yep"      ~> "!"+  , "empty"    ~> ""+  ]+ where+  (~>) = (,)++note :: a -> Maybe b -> Either a b+note a = maybe (Left a) Right++hush :: Either a b -> Maybe b+hush = either (const Nothing) Just