git.iko.soy/typeable/yaml
on de41665 help sign in
typeable/yaml/Data/Yaml/Config.hs
212 lines 7.3 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE OverloadedStrings #-}
3-- | Functionality for using YAML as configuration files
4--
5-- In particular, merging environment variables with yaml values
6--
7-- 'loadYamlSettings' is a high-level API for loading YAML and merging environment variables.
8-- A yaml value of @_env:ENV_VAR:default@ will lookup the environment variable @ENV_VAR@.
9--
10-- On a historical note, this code was taken directly from the yesod web framework's configuration module.
11module Data.Yaml.Config
12 ( -- * High-level
13 loadYamlSettings
14 , loadYamlSettingsArgs
15 -- ** EnvUsage
16 , EnvUsage
17 , ignoreEnv
18 , useEnv
19 , requireEnv
20 , useCustomEnv
21 , requireCustomEnv
22 -- * Lower level
23 , applyCurrentEnv
24 , getCurrentEnv
25 , applyEnvValue
26 ) where
29#if __GLASGOW_HASKELL__ < 710
30import Control.Applicative ((<$>))
31import Data.Monoid
32#endif
33import Data.Semigroup
34import Data.List.NonEmpty (nonEmpty)
35import Data.Aeson
36import qualified Data.HashMap.Strict as H
37import Data.Text (Text, pack)
38import System.Environment (getArgs, getEnvironment)
39import Control.Arrow ((***))
40import Control.Monad (forM)
41import Control.Exception (throwIO)
42import Data.Text.Encoding (encodeUtf8)
43import qualified Data.Yaml as Y
44import qualified Data.Yaml.Include as YI
45import Data.Maybe (fromMaybe)
46import qualified Data.Text as T
48newtype MergedValue = MergedValue { getMergedValue :: Value }
50instance Semigroup MergedValue where
51 MergedValue x <> MergedValue y = MergedValue $ mergeValues x y
53-- | Left biased
54mergeValues :: Value -> Value -> Value
55mergeValues (Object x) (Object y) = Object $ H.unionWith mergeValues x y
56mergeValues x _ = x
58-- | Override environment variable placeholders in the given @Value@ with
59-- values from the environment.
60--
61-- If the first argument is @True@, then all placeholders _must_ be provided by
62-- the actual environment. Otherwise, default values from the @Value@ will be
63-- used.
64--
65-- @since 0.8.16
66applyEnvValue :: Bool -- ^ require an environment variable to be present?
67 -> H.HashMap Text Text -> Value -> Value
68applyEnvValue requireEnv' env =
69 goV
70 where
71 goV (Object o) = Object $ goV <$> o
72 goV (Array a) = Array (goV <$> a)
73 goV (String t1) = fromMaybe (String t1) $ do
74 t2 <- T.stripPrefix "_env:" t1
75 let (name, t3) = T.break (== ':') t2
76 mdef = fmap parseValue $ T.stripPrefix ":" t3
77 Just $ case H.lookup name env of
78 Just val ->
79 -- If the default value parses as a String, we treat the
80 -- environment variable as a raw value and do not parse it.
81 -- This means that things like numeric passwords just work.
82 -- However, for originally numerical or boolean values (e.g.,
83 -- port numbers), we still perform a normal YAML parse.
84 --
85 -- For details, see:
86 -- https://github.com/yesodweb/yesod/issues/1061
87 case mdef of
88 Just (String _) -> String val
89 _ -> parseValue val
90 Nothing ->
91 case mdef of
92 Just val | not requireEnv' -> val
93 _ -> Null
94 goV v = v
96 parseValue val = fromMaybe (String val) $ Y.decode $ encodeUtf8 val
98-- | Get the actual environment as a @HashMap@ from @Text@ to @Text@.
99--
100-- @since 0.8.16
101getCurrentEnv :: IO (H.HashMap Text Text)
102getCurrentEnv = fmap (H.fromList . map (pack *** pack)) getEnvironment
104-- | A convenience wrapper around 'applyEnvValue' and 'getCurrentEnv'
105--
106-- @since 0.8.16
107applyCurrentEnv :: Bool -- ^ require an environment variable to be present?
108 -> Value -> IO Value
109applyCurrentEnv requireEnv' orig = flip (applyEnvValue requireEnv') orig <$> getCurrentEnv
111-- | Defines how we want to use the environment variables when loading a config
112-- file. Use the smart constructors provided by this module.
113--
114-- @since 0.8.16
115data EnvUsage = IgnoreEnv
116 | UseEnv
117 | RequireEnv
118 | UseCustomEnv (H.HashMap Text Text)
119 | RequireCustomEnv (H.HashMap Text Text)
121-- | Do not use any environment variables, instead relying on defaults values
122-- in the config file.
123--
124-- @since 0.8.16
125ignoreEnv :: EnvUsage
126ignoreEnv = IgnoreEnv
128-- | Use environment variables when available, otherwise use defaults.
129--
130-- @since 0.8.16
131useEnv :: EnvUsage
132useEnv = UseEnv
134-- | Do not use default values from the config file, but instead take all
135-- overrides from the environment. If a value is missing, loading the file will
136-- throw an exception.
137--
138-- @since 0.8.16
139requireEnv :: EnvUsage
140requireEnv = RequireEnv
142-- | Same as 'useEnv', but instead of the actual environment, use the provided
143-- @HashMap@ as the environment.
144--
145-- @since 0.8.16
146useCustomEnv :: H.HashMap Text Text -> EnvUsage
147useCustomEnv = UseCustomEnv
149-- | Same as 'requireEnv', but instead of the actual environment, use the
150-- provided @HashMap@ as the environment.
151--
152-- @since 0.8.16
153requireCustomEnv :: H.HashMap Text Text -> EnvUsage
154requireCustomEnv = RequireCustomEnv
156-- | Load the settings from the following three sources:
157--
158-- * Run time config files
159--
160-- * Run time environment variables
161--
162-- * The default compile time config file
163--
164-- For example, to load up settings from @config/foo.yaml@ and allow overriding
165-- from the actual environment, you can use:
166--
167-- > loadYamlSettings ["config/foo.yaml"] [] useEnv
168--
169-- @since 0.8.16
170loadYamlSettings
171 :: FromJSON settings
172 => [FilePath] -- ^ run time config files to use, earlier files have precedence
173 -> [Value] -- ^ any other values to use, usually from compile time config. overridden by files
174 -> EnvUsage
175 -> IO settings
176loadYamlSettings runTimeFiles compileValues envUsage = do
177 runValues <- forM runTimeFiles $ \fp -> do
178 eres <- YI.decodeFileEither fp
179 case eres of
180 Left e -> do
181 putStrLn $ "loadYamlSettings: Could not parse file as YAML: " ++ fp
182 throwIO e
183 Right value -> return value
185 value' <-
186 case nonEmpty $ map MergedValue $ runValues ++ compileValues of
187 Nothing -> error "loadYamlSettings: No configuration provided"
188 Just ne -> return $ getMergedValue $ sconcat ne
189 value <-
190 case envUsage of
191 IgnoreEnv -> return $ applyEnvValue False mempty value'
192 UseEnv -> applyCurrentEnv False value'
193 RequireEnv -> applyCurrentEnv True value'
194 UseCustomEnv env -> return $ applyEnvValue False env value'
195 RequireCustomEnv env -> return $ applyEnvValue True env value'
197 case fromJSON value of
198 Error s -> error $ "Could not convert to AppSettings: " ++ s
199 Success settings -> return settings
201-- | Same as @loadYamlSettings@, but get the list of runtime config files from
202-- the command line arguments.
203--
204-- @since 0.8.17
205loadYamlSettingsArgs
206 :: FromJSON settings
207 => [Value] -- ^ any other values to use, usually from compile time config. overridden by files
208 -> EnvUsage -- ^ use environment variables
209 -> IO settings
210loadYamlSettingsArgs values env = do
211 args <- getArgs
212 loadYamlSettings args values env