(Optionally) get configuration from environment.

1 files changed, 30 insertions, 5 deletions

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