summaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2014-11-06 14:41:35 +0100
committertv <tv@shackspace.de>2014-11-06 14:41:35 +0100
commit64e2f33e7185fe16305cd8852173747281a8c77a (patch)
tree671ad8d157ef4f384ee7d2fb42f1dfba016a8f17 /src
parentc16f813802b246bc4dd9df20930a3bf5d45f3029 (diff)
(Optionally) get configuration from environment.
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs3
-rw-r--r--src/Main/Config.hs35
2 files changed, 32 insertions, 6 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 3a41de4..a2755e0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -69,7 +69,8 @@ data Resource
-- | Run the application with the default configuration.
-- This calls 'start' with 'defaultConfig'.
main :: IO ()
-main = start defaultConfig
+main =
+ start =<< defaultConfig
-- | Run the application with the given configuration.
diff --git a/src/Main/Config.hs b/src/Main/Config.hs
index 47c12ba..45fa50f 100644
--- a/src/Main/Config.hs
+++ b/src/Main/Config.hs
@@ -8,7 +8,14 @@
module Main.Config (Config(..), defaultConfig) where
+import Control.Applicative
+import Control.Exception (tryJust)
+import Control.Monad (guard)
+import Data.Monoid
import Network.Wai.Handler.Warp (Port)
+import System.Environment (getEnv)
+import System.IO.Error (isDoesNotExistError)
+import Text.Read (readEither)
data Config = Config
@@ -18,12 +25,30 @@ data Config = Config
-- |
+-- The default configuration gets read from the environment variables
+-- @cgroupRoot@ and @httpPort@.
+--
+-- If either doesn't exist, then their respective default value gets used:
--
-- > cgroupRoot = "/sys/fs/cgroup"
-- > httpPort = 8001
--
-defaultConfig :: Config
-defaultConfig = Config
- { cgroupRoot = "/sys/fs/cgroup"
- , httpPort = 8001
- }
+defaultConfig :: IO Config
+defaultConfig =
+ Config
+ <$> getEnv' Right "/sys/fs/cgroup" "cgroupRoot"
+ <*> getEnv' readEither 8001 "httpPort"
+
+
+-- | Takes a parse function, a default value, and a variable name.
+getEnv' :: (String -> Either String a) -> a -> String -> IO a
+getEnv' pf def name =
+ either (const def) parse <$>
+ tryJust (guard . isDoesNotExistError) (getEnv name)
+ where
+ parse rawValue =
+ case pf rawValue of
+ Left err ->
+ error $ "Main.Config.getEnv' " <> show name <> ": " <> err
+ Right value ->
+ value