diff options
-rw-r--r-- | src/Main.hs | 3 | ||||
-rw-r--r-- | src/Main/Config.hs | 35 |
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 |