EVP 0 → 0.1

raw patch · 6 files changed

+208/−72 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• EVP.cabal +2/−2
• README.md +16/−1
• src/EVP.hs +140/−64
• src/EVP/Internal.hs +30/−0
• tests/test.hs +13/−5

@@ -1,5 +1,12 @@ # Revision history for EVP +## 0.1++* `string`, `yaml`, and `parse` now takes a new `Var` type which has an `IsString` instance+* Added `group` function to give a name to a group of parsers. Group names are purely cosmetic, and are displayed in the log messages.+* Added `helpFlag` (defaults to `EVP_HELP`). When this is set, EVP displays a summary of the parser in dotenv format.+* Added `defaultsTo`+ ## 0 -- YYYY-mm-dd  * First version. Released on an unsuspecting world.

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               EVP-version:            0+version:            0.1 synopsis:           Environment Variable Parser description:        See README.md homepage:           https://github.com/fumieval/EVP@@ -24,7 +24,7 @@  library     import:           warnings-    exposed-modules:  EVP+    exposed-modules:  EVP, EVP.Internal     build-depends:    base >=4.16, containers, data-default-class, text, yaml     hs-source-dirs:   src     default-language: GHC2021

@@ -14,6 +14,7 @@  ```haskell {-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE OverloadedStrings #-}  import EVP qualified @@ -30,7 +31,7 @@     -- obtain the environment variable as is     _foo <- EVP.string "FOO"     -- you can also provide a default value-    _debug <- EVP.yamlDefault "DEBUG_MODE" False+    _debug <- EVP.yaml $ "DEBUG_MODE" `EVP.defaultsTo` False     pure () ``` @@ -75,6 +76,20 @@ EVP.scanWith EVP.def     { EVP.unusedLogger = EVP.assumePrefix "MYAPP_" <> EVP.obsolete ["OBSOLETE_VAR"] }     parser+```++Parser group+----++You can provide an additional context to a parser by applying `group "group name"`.+Group names appear in the log messages:++```+[EVP Info] DEBUG_MODE: False (default)+[EVP Info/MySQL] MYSQL_HOST: localhost+[EVP Info/MySQL] MYSQL_PASSWORD: <REDACTED>+[EVP Error/MySQL] Failed to parse MYSQL_PORT=blah: Aeson exception:+[EVP Error/MySQL] Error in $: parsing Int failed, expected Number, but encountered String ```  Design context

@@ -1,118 +1,158 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NoFieldSelectors #-} {-# LANGUAGE RecordWildCards #-} module EVP   ( Name   , Error(..)   -- * Parsers+  , Scan+  , Var(..)   , string   , yaml   , parse   , secret-  -- * Providing a default value-  , stringDefault-  , yamlDefault-  , parseDefault+  , group+  , defaultsTo   -- * Runner   , Settings(..)   , def   , scan   , scanWith   , enumerate+  , help   -- * Logger+  , GroupStack+  , renderError   , assumePrefix   , obsolete-  -- * Internal-  , Scan(..)+  -- * Advanced+  , modifyError   ) where +import Control.Applicative import Control.Monad import Data.Bifunctor import Data.Default.Class-import Data.List (isPrefixOf)+import Data.List (isPrefixOf, intercalate) import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.String import Data.Yaml qualified as Yaml+import Data.Text qualified as T+import Data.Text.Lazy qualified as TL import Data.Text.Encoding+import Data.Typeable+import EVP.Internal import System.Environment import System.Exit import System.IO -type Name = String+data Var a = Var+  { name :: Name+  , defaultValue :: Maybe a+  , metavar :: Maybe String+  } deriving (Show, Eq) -data Error = Missing Name-  | ParseError Name String-  deriving Show+-- | Provide a default value.+defaultsTo :: Var a -> a -> Var a+defaultsTo v a = v { defaultValue = Just a }+infixl 1 `defaultsTo` --- | Obtain the environment variable.-string :: (IsString a) => Name -> Scan a-string v = Var v (\case-  Nothing -> Left (Missing v)-  Just x -> Right (x, fromString x)) (Pure id)+instance Typeable a => IsString (Var a) where+  fromString name = Var name Nothing Nothing -stringDefault :: (IsString a) => Name -> String -> Scan a-stringDefault v d = Var v (\case-  Nothing -> Right (d <> " (default)", fromString d)-  Just x -> Right (x, fromString x)) (Pure id)+-- | Obtain the environment variable.+string :: (IsString a, Show a, Typeable a) => Var a -> Scan a+string Var{..} = Scan ScanF+  { name+  , parser = \case+    Nothing -> case defaultValue of+      Nothing -> Left (Missing name)+      Just d -> Right (show d <> " (default)", d)+    Just x -> Right (x, fromString x)+  , metavar = metavar <|> toString <$> defaultValue+  } (Pure id) --- | Parse the environment variable as a YAML value.-yaml :: (Show a, Yaml.FromJSON a) => Name -> Scan a-yaml v = parse v decodeYaml+toString :: (Typeable a, Show a) => a -> String+toString val+  | Just str <- cast val = str+  | Just str <- cast val = T.unpack str+  | Just str <- cast val = TL.unpack str+  | Just str <- cast val = T.unpack $ decodeUtf8 str+  | otherwise = show val  -- | Parse the environment variable as a YAML value.-yamlDefault :: (Show a, Yaml.FromJSON a) => Name -> a -> Scan a-yamlDefault v d = parseDefault v d decodeYaml+yaml :: forall a. (Show a, Typeable a, Yaml.FromJSON a, Yaml.ToJSON a) => Var a -> Scan a+yaml Var{..} = parse Var+  { metavar = metavar+    <|> fmap (T.unpack . T.strip . decodeUtf8 . Yaml.encode) defaultValue+    <|> Just (show $ typeRep (Proxy :: Proxy a))+  , ..+  }+  decodeYaml  decodeYaml :: Yaml.FromJSON a => String -> Either String a-decodeYaml = first show . Yaml.decodeEither' . encodeUtf8 . fromString--parse :: (Show a) => Name -> (String -> Either String a) -> Scan a-parse v f = Var v (\case-  Nothing -> Left (Missing v)-  Just x -> bimap (ParseError v) withShow $ f x) (Pure id)+decodeYaml = first Yaml.prettyPrintParseException . Yaml.decodeEither' . encodeUtf8 . fromString -parseDefault :: (Show a) => Name -> a -> (String -> Either String a) -> Scan a-parseDefault v d f = Var v (\case-  Nothing -> Right (show d <> " (default)", d)-  Just x -> bimap (ParseError v) withShow $ f x) (Pure id)+-- | Parse the environment variable with a custom parser.+parse :: (Show a) => Var a -> (String -> Either String a) -> Scan a+parse Var{..} f = Scan ScanF+  { name+  , parser = \case+    Nothing -> case defaultValue of+      Nothing -> Left (Missing name)+      Just d -> Right (show d <> " (default)", d)+    Just x -> bimap (ParseError name x) withShow $ f x+  , metavar+  }+  (Pure id)  -- | Disable logging of parsed values. secret :: Scan a -> Scan a secret (Pure a) = Pure a-secret (Var v f k) = Var v (fmap (first (const "<REDACTED>")) . f) (secret k)+secret (Scan v k) = Scan (v { parser = fmap (first (const "<REDACTED>")) . parser v }) (secret k)+secret (Group name s) = Group name $ secret s +-- | Give a name to a group of parsers.+group :: String -> Scan a -> Scan a+group = Group+ withShow :: Show a => a -> (String, a) withShow x = (show x, x)-  -data Scan a where-  Pure :: a -> Scan a-  Var :: Name -> (Maybe String -> Either Error (String, a)) -> Scan (a -> b) -> Scan b -instance Functor Scan where-  fmap f (Pure a) = Pure (f a)-  fmap f (Var k g c) = Var k g (fmap (f.) c)--instance Applicative Scan where-  pure = Pure-  Pure f <*> k = f <$> k-  Var k f c <*> r = Var k f (flip <$> c <*> r)-    type EnvMap = Map.Map String String +type GroupStack = [String]++renderError :: Error -> String+renderError (Missing name) = unwords ["Missing environment variable", name]+renderError (ParseError name value reason) = unwords ["Failed to parse", name <> "=" <> value <> ":", reason]+renderError (CustomError reason) = reason+ data Settings = Settings-  { parseLogger :: Name -> String -> IO ()-  , errorLogger :: Error -> IO ()+  { parseLogger :: GroupStack -> Name -> String -> IO ()+  , errorLogger :: GroupStack -> Error -> IO ()   , unusedLogger :: Name -> Maybe (IO ())   , pedantic :: Bool -- ^ exit on warning+  , helpFlag :: Maybe Name -- ^ when an environment varialbe with this name is set, print the help message and exit   }-  ++header :: GroupStack -> String -> String+header [] level = "[EVP " <> level <> "] "+header xs level = mconcat ["[EVP ", level, concatMap ("/"<>) $ reverse xs, "] "]+ instance Default Settings where   def = Settings-    { parseLogger = \name value -> putStrLn $ unwords ["[EVP Info]", name <> ":", value]-    , errorLogger = \e -> hPutStrLn stderr $ unwords ["[EVP Error]", show e]+    { parseLogger = \stack name value -> do+      isTerminal <- hIsTerminalDevice stdout+      hPutStrLn (if isTerminal then stdout else stderr)+        $ header stack "Info" <> name <> ": " <> value+    , errorLogger = \stack e -> hPutStrLn stderr $ intercalate "\n" $ map (header stack "Error" <>) $ lines $ renderError e     , unusedLogger = mempty     , pedantic = False+    , helpFlag = Just "EVP_HELP"     }  -- | Custom logging function for 'unusedLogger'.@@ -133,16 +173,25 @@ enumerate m = Set.toList $ go Set.empty m where   go :: Set.Set Name -> Scan a -> Set.Set Name   go !s (Pure _) = s-  go !s (Var k _ cont) = go (Set.insert k s) cont+  go !s (Scan k cont) = go (Set.insert (name k) s) cont+  go !s (Group _ cont) = go s cont +-- | Parse environment variables with the default settings. scan :: Scan a -> IO a scan = scanWith def +-- | Parse environment variables with custom settings. scanWith :: Settings -> Scan a -> IO a scanWith Settings{..} action = do   envs0 <- Map.fromList <$> getEnvironment-  (remainder, errors, result) <- go envs0 envs0 action-  mapM_ errorLogger errors++  forM_ helpFlag $ \flag -> do+    when (flag `Map.member` envs0) $ do+      putStrLn $ help action+      exitSuccess++  (remainder, errors, result) <- go envs0 envs0 [] action+  mapM_ (uncurry errorLogger) errors   case foldMap unusedLogger $ Map.keys remainder of     Nothing -> pure ()     Just m -> do@@ -152,13 +201,40 @@     Nothing -> exitFailure     Just a -> pure a   where-    go :: EnvMap -> EnvMap -> Scan a -> IO (EnvMap, [Error], Maybe a)-    go _ envs (Pure a) = pure (envs, [], Just a)-    go allEnvs envs (Var name parser cont) = case parser (Map.lookup name allEnvs) of+    go :: EnvMap -> EnvMap -> GroupStack -> Scan a -> IO (EnvMap, [(GroupStack, Error)], Maybe a)+    go _ envs _ (Pure a) = pure (envs, [], Just a)+    go allEnvs envs groupStack (Group name inner) = do+      let stack = name : groupStack+      go allEnvs envs stack inner+    go allEnvs envs groupStack (Scan ScanF{..} cont) = case parser (Map.lookup name allEnvs) of       Left e -> do-        (remainder, errors, _) <- go allEnvs (Map.delete name envs) cont-        pure (remainder, e : errors, Nothing)+        (remainder, errors, _) <- go allEnvs (Map.delete name envs) groupStack cont+        pure (remainder, (groupStack, e) : errors, Nothing)       Right (display, v) -> do-        parseLogger name display-        (remainder, errors, func) <- go allEnvs (Map.delete name envs)  cont+        parseLogger groupStack name display+        (remainder, errors, func) <- go allEnvs (Map.delete name envs) groupStack cont         pure (remainder, errors, ($ v) <$> func)++modifyError :: (Error -> Error) -> Scan a -> Scan a+modifyError func = go where+  go :: Scan a -> Scan a+  go (Pure a) = Pure a+  go (Scan v k) = Scan (apply v) (go k)+  go (Group name k) = Group name (go k)++  apply ScanF{..} = ScanF+    { name+    , parser = first func . parser+    , metavar+    }++-- | Display the list of environment variables and their default values in the dotenv format.+help :: Scan a -> String+help = unlines . go 1 where++  go :: Int -> Scan a -> [String]+  go _ (Pure _) = []+  go depth (Scan v k) = format v : go depth k+  go depth (Group name k) = (replicate depth '#' <> " " <> name) : go (depth + 1) k++  format ScanF{..} = name <> "=" <> maybe "" id metavar

@@ -0,0 +1,30 @@+module EVP.Internal where++type Name = String++data Error = Missing Name+  | ParseError Name String String+  | CustomError String+  deriving Show++data ScanF a = ScanF+  { name :: Name+  , parser :: Maybe String -> Either Error (String, a)+  , metavar :: Maybe String+  } deriving Functor+  +data Scan a where+  Pure :: a -> Scan a+  Scan :: ScanF a -> Scan (a -> b) -> Scan b+  Group :: String -> Scan a -> Scan a++instance Functor Scan where+  fmap f (Pure a) = Pure (f a)+  fmap f (Scan k c) = Scan k (fmap (f.) c)+  fmap f (Group name s) = Group name $ fmap f s++instance Applicative Scan where+  pure = Pure+  Pure f <*> k = f <$> k+  Scan k c <*> r = Scan k (flip <$> c <*> r)+  Group name s <*> r = Group name (s <*> r)

@@ -1,13 +1,16 @@ {-# LANGUAGE ApplicativeDo #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-}  import Data.Text (Text)-import EVP qualified+import EVP  main :: IO ()-main = EVP.scanWith EVP.def-    { EVP.unusedLogger = EVP.assumePrefix "MYAPP_" <> EVP.obsolete ["OBSOLETE_VAR"] }-    parser+main = do+    EVP.scanWith EVP.def+        { EVP.unusedLogger = EVP.assumePrefix "MYAPP_" <> EVP.obsolete ["OBSOLETE_VAR"] }+        parser+    putStrLn "Hello, world!"  -- ApplicativeDo is important here because Scan is not a monad. parser :: EVP.Scan ()@@ -19,7 +22,12 @@     -- obtain the environment variable as is     _ :: Text <- EVP.string "FOO"     -- you can also provide a default value-    _ :: Bool <- EVP.yamlDefault "DEBUG_MODE" False+    _ :: Bool <- EVP.yaml $ "DEBUG_MODE" `EVP.defaultsTo` False+    _ <- EVP.group "MySQL" $ do+        _ :: String <- EVP.string $ "MYSQL_HOST" `EVP.defaultsTo` "localhost"+        _ :: Int <- EVP.yaml $ "MYSQL_PORT" `EVP.defaultsTo` 3306+        _ :: String <- EVP.secret $ EVP.string "MYSQL_PASSWORD"+        pure ()     pure ()  {-