diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,13 @@ ## MASTER +## Dotenv 0.6.0.1 +* Add support for `megaparsec-7.0.1` +* Drop support for `GHC 7.8.4` + +## Dotenv 0.6.0.0 +* Move `loadSafeFile` to `Configuration.Dotenv` +* Export `Configuration.Dotenv.Types` from `Configuration.Dotenv` +* Change `loadSafeFile` signature to accept different types of validators. +* Add `type ValidatorMap = Map Text (Text -> Bool)` for custom validations. ## Dotenv 0.5.2.5 * Update `exceptions` bounds `>= 0.8 && < 0.11` diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -35,8 +35,8 @@ settings into the environment: ```haskell -import qualified Configuration.Dotenv as Dotenv -Dotenv.loadFile defaultConfig +import Configuration.Dotenv (loadFile, defaultConfig) +loadFile defaultConfig ``` After calling `Dotenv.load`, you are able to read the values set in your diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -13,9 +13,9 @@ import Control.Monad (void, unless) -import Configuration.Dotenv (loadFile) +import Configuration.Dotenv (loadFile, loadSafeFile) import Configuration.Dotenv.Types (Config(..), defaultConfig) -import Configuration.Dotenv.Scheme ( runSchemaChecker ) +import Configuration.Dotenv.Scheme.Parser ( defaultValidatorMap ) import System.Process (system) import System.Exit (exitWith) @@ -45,7 +45,7 @@ in do void $ loadFile configDotenv unless disableSchema - (runSchemaChecker schemaFile configDotenv) + (void $ loadSafeFile defaultValidatorMap schemaFile configDotenv) system (program ++ concatMap (" " ++) args) >>= exitWith where opts = info (helper <*> versionOption <*> config) diff --git a/dotenv.cabal b/dotenv.cabal --- a/dotenv.cabal +++ b/dotenv.cabal @@ -1,5 +1,5 @@ name: dotenv -version: 0.5.2.5 +version: 0.6.0.1 synopsis: Loads environment variables from dotenv files homepage: https://github.com/stackbuilders/dotenv-hs description: @@ -21,8 +21,9 @@ . To use, call `loadFile` from your application: . + > import Control.Monad (void) > import Configuration.Dotenv - > loadFile False "/my/dotenvfile" + > void $ loadFile defaultConfig . This package also includes an executable that can be used to inspect the results of applying one or more Dotenv files @@ -61,8 +62,8 @@ , base-compat >= 0.4 , dotenv , optparse-applicative >=0.11 && < 0.15 - , megaparsec >= 6.0 && < 7.0 - , process >= 1.4.3.0 + , megaparsec + , process , text , transformers >=0.4 && < 0.6 , yaml >= 0.8 @@ -89,8 +90,9 @@ build-depends: base >=4.7 && <5.0 , base-compat >= 0.4 , directory - , megaparsec >= 6.0 && < 7.0 - , process >= 1.4.3.0 + , megaparsec >= 7.0.1 && < 8.0 + , containers + , process >= 1.6.4.0 && < 1.7 , text , transformers >=0.4 && < 0.6 , exceptions >= 0.8 && < 0.11 @@ -128,15 +130,16 @@ build-depends: base >=4.7 && <5.0 , base-compat >= 0.4 + , containers , dotenv , directory - , megaparsec >= 6.0 && < 7.0 + , megaparsec , hspec - , process >= 1.4.3.0 + , process , text , transformers >=0.4 && < 0.6 , exceptions >= 0.8 && < 0.11 - , hspec-megaparsec >= 1.0 && < 2.0 + , hspec-megaparsec >= 2.0 && < 3.0 , yaml >= 0.8 if !impl(ghc >= 7.10) diff --git a/spec/Configuration/Dotenv/ParseSpec.hs b/spec/Configuration/Dotenv/ParseSpec.hs --- a/spec/Configuration/Dotenv/ParseSpec.hs +++ b/spec/Configuration/Dotenv/ParseSpec.hs @@ -9,7 +9,7 @@ import Data.Void (Void) import Test.Hspec (it, describe, Spec, hspec) import Test.Hspec.Megaparsec (shouldParse, shouldFailOn, shouldSucceedOn) -import Text.Megaparsec (ParseError, parse) +import Text.Megaparsec (ParseErrorBundle, parse) main :: IO () main = hspec spec @@ -151,5 +151,5 @@ it "parses empty content (when the file is empty)" $ parseConfig `shouldSucceedOn` "" -parseConfig :: String -> Either (ParseError Char Void) [ParsedVariable] +parseConfig :: String -> Either (ParseErrorBundle String Void) [ParsedVariable] parseConfig = parse configParser "" diff --git a/spec/Configuration/Dotenv/Scheme/ParseSpec.hs b/spec/Configuration/Dotenv/Scheme/ParseSpec.hs --- a/spec/Configuration/Dotenv/Scheme/ParseSpec.hs +++ b/spec/Configuration/Dotenv/Scheme/ParseSpec.hs @@ -1,63 +1,35 @@ +{-# LANGUAGE OverloadedStrings #-} + {-# OPTIONS_GHC -fno-warn-orphans #-} module Configuration.Dotenv.Scheme.ParseSpec (spec) where -import Data.Either (isLeft, isRight) import Data.Yaml (decodeFileEither) import Test.Hspec import Configuration.Dotenv.Scheme.Types -import Configuration.Dotenv.Scheme.Parser +-- | Extract Right from Either +-- fromRight :: (Show a, Show b) => Either a b -> b fromRight (Right v) = v fromRight (Left v) = error ("Left " ++ show v ++ " constructor instead" ) +-- | +-- spec :: Spec -spec = do - specInstance - specParse - -specInstance :: Spec -specInstance = describe "parse a config env file" $ - it "parses the env config values from a file" $ - let expected :: [Env] - expected = - [ Env "DOTENV" EnvBool True - , Env "OTHERENV" EnvBool False - , Env "PORT" EnvInteger True - , Env "TOKEN" EnvInteger False - , Env "URL" EnvText True +spec = + describe "parse a config env file" $ + it "parses the env config values from a file" $ + let expected :: [Env] + expected = + [ Env "DOTENV" (EnvType "bool") True + , Env "OTHERENV" (EnvType "bool") False + , Env "PORT" (EnvType "integer") True + , Env "TOKEN" (EnvType "integer") False + , Env "URL" (EnvType "text") True + , Env "TWO" (EnvType "twoLetters") False ] - in do - actual <- decodeFileEither "spec/fixtures/.scheme.yml" - fromRight actual `shouldBe` expected - -specParse :: Spec -specParse = - describe "parseEnvAs" $ do - context "given an integer" $ do - context "when the integer can be parsed" $ - it "should return Right ()" $ - let varContent = "123" - integer = EnvInteger - in varContent `parseEnvAs` integer `shouldSatisfy` isRight - - context "when the integer can't be parsed" $ - it "should return Left (ParseError Char Void)" $ - let varContent = "123x" - integer = EnvInteger - in varContent `parseEnvAs` integer `shouldSatisfy` isLeft - - context "given a bool" $ do - context "when the bool can be parsed" $ - it "should return Right ()" $ - let varContent = "true" - boolean = EnvBool - in varContent `parseEnvAs` boolean `shouldSatisfy` isRight - - context "when the bool can't be parsed" $ - it "should return False" $ - let varContent = "truex" - boolean = EnvBool - in varContent `parseEnvAs` boolean `shouldSatisfy` isLeft + in do + actual <- decodeFileEither "spec/fixtures/.scheme.yml" + fromRight actual `shouldBe` expected diff --git a/spec/Configuration/Dotenv/SchemeSpec.hs b/spec/Configuration/Dotenv/SchemeSpec.hs --- a/spec/Configuration/Dotenv/SchemeSpec.hs +++ b/spec/Configuration/Dotenv/SchemeSpec.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Configuration.Dotenv.SchemeSpec (spec) where import Configuration.Dotenv.Scheme @@ -6,23 +8,25 @@ import Test.Hspec +-- | +-- spec :: Spec spec = do describe "checkScheme" $ do context "when the env configs are unique" $ it "should succeed the check" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger True + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") True ] in checkScheme schemeEnvs `shouldBe` schemeEnvs context "when there are duplicated env configs" $ it "should fail the check" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger True - , Env "FOO" EnvInteger True + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") True + , Env "FOO" (EnvType "integer") True ] msg = "Duplicated env variable configuration in schema: FOO" in evaluate (checkScheme schemeEnvs) `shouldThrow` errorCall msg @@ -33,48 +37,48 @@ context "when the required envs are defined" $ it "should succeed the type check" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger False + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") False ] - dotenvs = [("FOO","true"), ("BAR","123")] - in checkConfig dotenvs schemeEnvs `shouldReturn` () + dotenvs = [("FOO","True"), ("BAR","123")] + in checkConfig defaultValidatorMap dotenvs schemeEnvs `shouldReturn` () context "when the not required envs are missing" $ it "should succeed the type check" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger False + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") False ] - dotenvs = [("FOO","true")] - in checkConfig dotenvs schemeEnvs `shouldReturn` () + dotenvs = [("FOO","True")] + in checkConfig defaultValidatorMap dotenvs schemeEnvs `shouldReturn` () context "when the required envs are missing" $ it "should fail before the type check" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger False + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") False ] dotenvs = [("BAR","123")] msg = "The following envs: FOO must be in the dotenvs" - in checkConfig dotenvs schemeEnvs `shouldThrow` errorCall msg + in checkConfig defaultValidatorMap dotenvs schemeEnvs `shouldThrow` errorCall msg context "when there are missing dotenvs in the scheme" $ it "should fail before type checking" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAR" EnvInteger False + [ Env "FOO" (EnvType "bool") True + , Env "BAR" (EnvType "integer") False ] - dotenvs = [("FOO","true"), ("BAR","123"), ("BAZ","text")] + dotenvs = [("FOO","True"), ("BAR","123"), ("BAZ","text")] msg = "The following envs: BAZ must be in your scheme.yml" - in checkConfig dotenvs schemeEnvs `shouldThrow` errorCall msg + in checkConfig defaultValidatorMap dotenvs schemeEnvs `shouldThrow` errorCall msg context "when there are missing scheme envs in the dotenv vars" $ it "should fail before type checking" $ let schemeEnvs = - [ Env "FOO" EnvBool True - , Env "BAZ" EnvText True - , Env "BAR" EnvInteger False + [ Env "FOO" (EnvType "bool") True + , Env "BAZ" (EnvType "text") True + , Env "BAR" (EnvType "integer") False ] - dotenvs = [("FOO","true"), ("BAR","123")] + dotenvs = [("FOO","True"), ("BAR","123")] msg = "The following envs: BAZ must be in the dotenvs" - in checkConfig dotenvs schemeEnvs `shouldThrow` errorCall msg + in checkConfig defaultValidatorMap dotenvs schemeEnvs `shouldThrow` errorCall msg diff --git a/spec/Configuration/DotenvSpec.hs b/spec/Configuration/DotenvSpec.hs --- a/spec/Configuration/DotenvSpec.hs +++ b/spec/Configuration/DotenvSpec.hs @@ -1,16 +1,26 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Configuration.DotenvSpec (main, spec) where import Configuration.Dotenv.Types (Config(..)) -import Configuration.Dotenv (load, loadFile, parseFile, onMissingFile) +import Configuration.Dotenv + ( load + , loadFile + , loadSafeFile + , parseFile + , onMissingFile + ) + import Test.Hspec import System.Process (readCreateProcess, shell) import System.Environment (lookupEnv) import Control.Monad (liftM, void) import Data.Maybe (fromMaybe) +import qualified Data.Text as T +import qualified Data.Map.Lazy as M #if !MIN_VERSION_base(4,8,0) import Data.Functor ((<$>)) #endif @@ -25,8 +35,6 @@ import System.Environment.Compat (getEnvironment, setEnv, unsetEnv) #endif -{-# ANN module "HLint: ignore Reduce duplication" #-} - main :: IO () main = hspec spec @@ -99,6 +107,45 @@ lookupEnv "DOTENV" `shouldReturn` Just "true" lookupEnv "UNICODE_TEST" `shouldReturn` Just "Manabí" lookupEnv "ANOTHER_ENV" `shouldReturn` Just "hello" + + describe "loadSafeFile" $ after_ clearEnvs $ + context "given a custom map" $ do + context "when the envs are written accordingly to the rules in the map" $ + it "should validate accordingly to the rules in the custom map" $ + let hasTwoLetters text = T.length text == 2 + customMap = M.fromList + [ ("twoLetters", hasTwoLetters) + , ("bool", const True) + , ("text", const True) + , ("integer", const True) + ] + schemaFile = "spec/fixtures/.scheme.yml" + config = Config ["spec/fixtures/.dotenv.safe"] [] False + expectedEnvs = + [ ("DOTENV","true") + , ("OTHERENV","false") + , ("PORT","8000") + , ("URL","http://example.com") + , ("TWO","xD") + ] + in do + envs <- loadSafeFile customMap schemaFile config + envs `shouldMatchList` expectedEnvs + + context "when the envs are written in an unexpected way" $ + it "should throw an errorCall" $ + let unexpectedFormat text = T.length text == 3 + customMap = M.fromList + [ ("twoLetters", unexpectedFormat) + , ("bool", const True) + , ("text", const True) + , ("integer", const True) + ] + schemaFile = "spec/fixtures/.scheme.yml" + config = Config ["spec/fixtures/.dotenv.safe"] [] False + in void $ loadSafeFile customMap schemaFile config + `shouldThrow` anyErrorCall + describe "parseFile" $ after_ clearEnvs $ do it "returns variables from a file without changing the environment" $ do diff --git a/spec/fixtures/.scheme.yml b/spec/fixtures/.scheme.yml --- a/spec/fixtures/.scheme.yml +++ b/spec/fixtures/.scheme.yml @@ -12,3 +12,5 @@ - name: URL type: text required: true +- name: TWO + type: twoLetters diff --git a/src/Configuration/Dotenv.hs b/src/Configuration/Dotenv.hs --- a/src/Configuration/Dotenv.hs +++ b/src/Configuration/Dotenv.hs @@ -1,6 +1,6 @@ -- | --- Module : Configuration.Dotenv --- Copyright : © 2015–2016 Stack Builders Inc. +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. -- License : MIT -- -- Maintainer : Stack Builders @@ -13,22 +13,33 @@ {-# LANGUAGE RecordWildCards #-} module Configuration.Dotenv - ( load + ( + -- * Dotenv Load Functions + load , loadFile + , loadSafeFile , parseFile - , onMissingFile ) + , onMissingFile + -- * Dotenv Types + , module Configuration.Dotenv.Types + , ValidatorMap + , defaultValidatorMap + ) where -import Control.Monad (liftM) +import Control.Monad (liftM, when) import Configuration.Dotenv.Parse (configParser) import Configuration.Dotenv.ParsedVariable (interpolateParsedVariables) +import Configuration.Dotenv.Scheme +import Configuration.Dotenv.Scheme.Types (ValidatorMap, defaultValidatorMap) import Configuration.Dotenv.Types (Config(..)) import Control.Monad.Catch import Control.Monad.IO.Class (MonadIO(..)) import Data.List (union, intersectBy, unionBy) +import System.Directory (doesFileExist) import System.Environment (lookupEnv) import System.IO.Error (isDoesNotExistError) -import Text.Megaparsec (parse, parseErrorPretty) +import Text.Megaparsec (parse, errorBundlePretty) #if MIN_VERSION_base(4,7,0) import System.Environment (getEnvironment, setEnv) @@ -51,8 +62,8 @@ -- with the values defined in the dotenv file. loadFile :: MonadIO m - => Config - -> m [(String, String)] + => Config -- ^ Dotenv configuration + -> m [(String, String)] -- ^ Environment variables loaded loadFile Config{..} = do environment <- liftIO getEnvironment readedVars <- concat `liftM` mapM parseFile configPath @@ -80,7 +91,7 @@ contents <- liftIO $ readFile f case parse configParser f contents of - Left e -> error $ parseErrorPretty e + Left e -> error $ errorBundlePretty e Right options -> liftIO $ interpolateParsedVariables options applySetting :: MonadIO m => Bool -> (String, String) -> m (String, String) @@ -104,3 +115,18 @@ -> m a -- ^ Action to perform if file is indeed missing -> m a onMissingFile f h = catchIf isDoesNotExistError f (const h) + +-- | @loadSafeFile@ parses the /.scheme.yml/ file and will perform the type checking +-- of the environment variables in the /.env/ file. +loadSafeFile + :: MonadIO m + => ValidatorMap -- ^ Map with custom validations + -> FilePath -- ^ Filepath for schema file + -> Config -- ^ Dotenv configuration + -> m [(String, String)] -- ^ Environment variables loaded +loadSafeFile mapFormat schemaFile config = do + envs <- loadFile config + exists <- liftIO $ doesFileExist schemaFile + when exists $ + liftIO (readScheme schemaFile >>= checkConfig mapFormat envs . checkScheme) + return envs diff --git a/src/Configuration/Dotenv/Parse.hs b/src/Configuration/Dotenv/Parse.hs --- a/src/Configuration/Dotenv/Parse.hs +++ b/src/Configuration/Dotenv/Parse.hs @@ -1,6 +1,6 @@ -- | --- Module : Configuration.Dotenv.Parse --- Copyright : © 2015–2016 Stack Builders Inc. +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. -- License : MIT -- -- Maintainer : Stack Builders @@ -26,9 +26,12 @@ #endif import Control.Monad (void) import Data.Void (Void) -import Text.Megaparsec (Parsec, between, eof, - sepEndBy, ()) -import Text.Megaparsec.Char +import Text.Megaparsec (Parsec, anySingle, between, eof, + sepEndBy, (), oneOf, + noneOf) +import Text.Megaparsec.Char (alphaNumChar, char, eol, + spaceChar, digitChar, + letterChar) import qualified Text.Megaparsec.Char.Lexer as L type Parser = Parsec Void String @@ -58,14 +61,14 @@ value = (quotedValue <|> unquotedValue) "variable value" where quotedValue = quotedWith SingleQuote <|> quotedWith DoubleQuote - unquotedValue = Unquoted <$> (many $ fragment "\'\" \t\n\r") + unquotedValue = Unquoted <$> many (fragment "\'\" \t\n\r") -- | Parse a value quoted with given character. quotedWith :: QuoteType -> Parser VarValue -quotedWith SingleQuote = SingleQuoted <$> (between (char '\'') (char '\'') $ many (literalValueFragment "\'\\")) -quotedWith DoubleQuote = DoubleQuoted <$> (between (char '\"') (char '\"') $ many (fragment "\"")) +quotedWith SingleQuote = SingleQuoted <$> between (char '\'') (char '\'') (many (literalValueFragment "\'\\")) +quotedWith DoubleQuote = DoubleQuoted <$> between (char '\"') (char '\"') (many (fragment "\"")) -fragment :: [Char] -> Parser VarFragment +fragment :: String -> Parser VarFragment fragment charsToEscape = interpolatedValueCommandInterpolation <|> interpolatedValueVarInterpolation @@ -85,10 +88,10 @@ where symbol = L.symbol sc -literalValueFragment :: [Char] -> Parser VarFragment -literalValueFragment charsToEscape = VarLiteral <$> (some $ escapedChar <|> normalChar) +literalValueFragment :: String -> Parser VarFragment +literalValueFragment charsToEscape = VarLiteral <$> some (escapedChar <|> normalChar) where - escapedChar = (char '\\' *> anyChar) "escaped character" + escapedChar = (char '\\' *> anySingle) "escaped character" normalChar = noneOf charsToEscape "unescaped character" ---------------------------------------------------------------------------- diff --git a/src/Configuration/Dotenv/ParsedVariable.hs b/src/Configuration/Dotenv/ParsedVariable.hs --- a/src/Configuration/Dotenv/ParsedVariable.hs +++ b/src/Configuration/Dotenv/ParsedVariable.hs @@ -1,3 +1,14 @@ +-- | +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. +-- License : MIT +-- +-- Maintainer : Stack Builders +-- Stability : experimental +-- Portability : portable +-- +-- Helpers to interpolate environment variables + {-# LANGUAGE CPP #-} module Configuration.Dotenv.ParsedVariable (ParsedVariable(..), diff --git a/src/Configuration/Dotenv/Scheme.hs b/src/Configuration/Dotenv/Scheme.hs --- a/src/Configuration/Dotenv/Scheme.hs +++ b/src/Configuration/Dotenv/Scheme.hs @@ -1,37 +1,30 @@ +-- | +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. +-- License : MIT +-- +-- Maintainer : Stack Builders +-- Stability : experimental +-- Portability : portable +-- +-- Helpers for loadSafeFile + module Configuration.Dotenv.Scheme ( checkConfig , checkScheme - , loadSafeFile - , runSchemaChecker + , readScheme ) where import Control.Monad -import Control.Monad.IO.Class (MonadIO(..)) import Data.List import Data.Yaml (decodeFileEither, prettyPrintParseException) -import Text.Megaparsec -import System.Directory (doesFileExist) -import Configuration.Dotenv (loadFile) -import Configuration.Dotenv.Types (Config(..)) import Configuration.Dotenv.Scheme.Helpers import Configuration.Dotenv.Scheme.Parser import Configuration.Dotenv.Scheme.Types --- | @loadSafeFile@ parses the /.scheme.yml/ file and will perform the type checking --- of the environment variables in the /.env/ file. -loadSafeFile - :: MonadIO m - => FilePath - -> Config - -> m [(String, String)] -loadSafeFile schemaFile config = do - envs <- loadFile config - liftIO (readScheme schemaFile >>= checkConfig envs . checkScheme) - return envs - readScheme :: FilePath -> IO [Env] readScheme schemeFile = do eitherEnvConf <- decodeFileEither schemeFile @@ -53,12 +46,12 @@ duplicatedConfErrorMsg = ("Duplicated env variable configuration in schema: " ++) . showMissingDotenvs checkConfig - :: [(String, String)] + :: ValidatorMap + -> [(String, String)] -> [Env] -> IO () -checkConfig envvars envsWithType = - let prettyParsedErrors = unlines . fmap parseErrorTextPretty - envsTypeAndValue = joinEnvs envsWithType envvars +checkConfig mapFormat envvars envsWithType = + let envsTypeAndValue = joinEnvs envsWithType envvars valuesAndTypes = matchValueAndType envsTypeAndValue dotenvsMissing = filter required (missingDotenvs envsWithType envsTypeAndValue) schemeEnvsMissing = missingSchemeEnvs envvars envsTypeAndValue @@ -71,15 +64,6 @@ (error $ "The following envs: " ++ showMissingSchemeEnvs schemeEnvsMissing ++ " must be in your scheme.yml") - case parseEnvsWithScheme valuesAndTypes of - Left errors -> error (prettyParsedErrors errors) - _ -> return () - -runSchemaChecker - :: FilePath - -> Config - -> IO () -runSchemaChecker schemeFile config = do - exists <- doesFileExist schemeFile - when exists - (void $ loadSafeFile schemeFile config) + case parseEnvsWithScheme mapFormat valuesAndTypes of + Left errors -> error (unlines errors) + _ -> return () diff --git a/src/Configuration/Dotenv/Scheme/Helpers.hs b/src/Configuration/Dotenv/Scheme/Helpers.hs --- a/src/Configuration/Dotenv/Scheme/Helpers.hs +++ b/src/Configuration/Dotenv/Scheme/Helpers.hs @@ -1,3 +1,14 @@ +-- | +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. +-- License : MIT +-- +-- Maintainer : Stack Builders +-- Stability : experimental +-- Portability : portable +-- +-- Helpers for loadSafeFile + {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} diff --git a/src/Configuration/Dotenv/Scheme/Parser.hs b/src/Configuration/Dotenv/Scheme/Parser.hs --- a/src/Configuration/Dotenv/Scheme/Parser.hs +++ b/src/Configuration/Dotenv/Scheme/Parser.hs @@ -1,47 +1,65 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. +-- License : MIT +-- +-- Maintainer : Stack Builders +-- Stability : experimental +-- Portability : portable +-- +-- Helpers for loadSafeFile -module Configuration.Dotenv.Scheme.Parser where +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Configuration.Dotenv.Scheme.Parser + ( defaultValidatorMap + , parseEnvsWithScheme + , typeValidator + ) + where + #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((*>), pure) import Data.Functor ((<$>)) #endif import Data.Either -import Data.Void -import Text.Megaparsec -import Text.Megaparsec.Char +import qualified Data.Map.Lazy as ML + +import qualified Data.Text as T + import Configuration.Dotenv.Scheme.Types + +-- | +-- parseEnvsWithScheme - :: [(String, EnvType)] - -> Either [ParseError Char Void] () -parseEnvsWithScheme valuesAndTypes = + :: ValidatorMap -- ^ MapFormat validations + -> [(String, EnvType)] -- ^ Value and Type + -> Either [String] () +parseEnvsWithScheme validatorMap valuesAndTypes = let parsedEithers = parseEnvs <$> valuesAndTypes - parseEnvs (val, type') = val `parseEnvAs` type' + parseEnvWith = typeValidator validatorMap + parseEnvs (val, type') = val `parseEnvWith` type' in if all isRight parsedEithers then Right () else Left (lefts parsedEithers) -parseEnvAs - :: String -- ^ Value of the env variable +-- | +-- +typeValidator + :: ValidatorMap -- ^ MapFormat validations + -> String -- ^ Value of the env variable -> EnvType -- ^ Type that the env variable should have - -> Either (ParseError Char Void) () -parseEnvAs envVal envTypeNeeded = - parse dispatch "" envVal - where - errorMsg = "Couldn't parse " ++ envVal ++ " as " ++ showType envTypeNeeded - evalParse parser = parser *> eof *> pure () <|> fail errorMsg - dispatch :: Parsec Void String () - dispatch = - case envTypeNeeded of - EnvInteger -> evalParse (many digitChar) - EnvBool -> evalParse (string "true" <|> string "false") - EnvText -> pure () - -showType :: EnvType -> String -showType EnvInteger = "integer" -showType EnvBool = "boolean" -showType _ = "text" + -> Either String () +typeValidator validatorMap envVal (EnvType type_) = + let errorMsg = "Couldn't parse " ++ envVal ++ " as " ++ T.unpack type_ + in case ML.lookup type_ validatorMap of + Nothing -> Left errorMsg + Just validator -> + if validator (T.pack envVal) + then Right () + else Left errorMsg diff --git a/src/Configuration/Dotenv/Scheme/Types.hs b/src/Configuration/Dotenv/Scheme/Types.hs --- a/src/Configuration/Dotenv/Scheme/Types.hs +++ b/src/Configuration/Dotenv/Scheme/Types.hs @@ -1,3 +1,14 @@ +-- | +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. +-- License : MIT +-- +-- Maintainer : Stack Builders +-- Stability : experimental +-- Portability : portable +-- +-- Types for 'loadSafeFile' (e. g., 'ValidatorMap') + {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} @@ -8,21 +19,33 @@ import Data.Functor ((<$>)) #endif +import Data.Maybe (isJust) + +import Data.Map.Lazy (Map) + import Data.Yaml -data EnvType = - EnvInteger - | EnvBool - | EnvText +import qualified Data.Map.Lazy as ML + +import Data.Text (Text) +import qualified Data.Text as T + +import Text.Read (readMaybe) + + +-- | +-- +newtype EnvType = EnvType Text deriving (Show, Eq, Ord) +-- | +-- instance FromJSON EnvType where - parseJSON (String "integer") = pure EnvInteger - parseJSON (String "bool") = pure EnvBool - parseJSON (String "text") = pure EnvText - parseJSON (String x) = fail ("Don't know how to parse that kind of type: " ++ show x) - parseJSON x = fail ("Not an object: " ++ show x) + parseJSON (String value) = pure (EnvType value) + parseJSON anyOther = fail ("Not an object: " ++ show anyOther) +-- | +-- data Env = Env { envName :: String @@ -30,6 +53,8 @@ , required :: Bool } deriving (Show, Eq, Ord) +-- | +-- instance FromJSON Env where parseJSON (Object m) = Env @@ -37,3 +62,29 @@ <*> m .: "type" <*> m .:? "required" .!= False parseJSON x = fail ("Not an object: " ++ show x) + +-- | Parameters: +-- +-- - __Key:__ Name of the /format/ to check. +-- +-- - __Value:__ Function to check if some text meets the condition. +-- +type ValidatorMap = Map Text (Text -> Bool) + + +-- | Default configuration for 'loadSafeFile'. It currently checks: +-- @bool@, @integer@, and @text@. +-- +defaultValidatorMap :: ValidatorMap +defaultValidatorMap = + let booleanValidator :: Text -> Bool + booleanValidator text = isJust (readMaybe (T.unpack text) :: Maybe Bool) + integerValidator :: Text -> Bool + integerValidator text = isJust (readMaybe (T.unpack text) :: Maybe Integer) + textValidator :: Text -> Bool + textValidator = const True + in ML.fromList + [ ("bool", booleanValidator) + , ("integer", integerValidator) + , ("text", textValidator) + ] diff --git a/src/Configuration/Dotenv/Text.hs b/src/Configuration/Dotenv/Text.hs --- a/src/Configuration/Dotenv/Text.hs +++ b/src/Configuration/Dotenv/Text.hs @@ -1,6 +1,6 @@ -- | --- Module : Configuration.Dotenv.Text --- Copyright : © 2015–2016 Stack Builders Inc. +-- Module : Configuration.Dotenv.Types +-- Copyright : © 2015–2018 Stack Builders Inc. -- License : MIT -- -- Maintainer : Stack Builders diff --git a/src/Configuration/Dotenv/Types.hs b/src/Configuration/Dotenv/Types.hs --- a/src/Configuration/Dotenv/Types.hs +++ b/src/Configuration/Dotenv/Types.hs @@ -1,6 +1,6 @@ -- | -- Module : Configuration.Dotenv.Types --- Copyright : © 2015–2017 Stack Builders Inc. +-- Copyright : © 2015–2018 Stack Builders Inc. -- License : MIT -- -- Maintainer : Stack Builders