blob: 66f72ea30c7d2ef074ffb4876c9af93b2ef923b7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
-- |
-- Module: Main.Config
-- Copyright: (c) 2014 Tomislav Viljetić
-- License: BSD3
-- Maintainer: Tomislav Viljetić <tomislav@viljetic.de>
--
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
{ cgroupRoot :: FilePath
-- ^ Mount point of the cgroup root.
, httpPort :: Port
-- ^ TCP port number for cgserver to bind to.
, flushLog :: Bool
-- ^ Whether to flush the logging buffer after each request.
}
deriving Show
-- |
-- 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
-- > flushLog = True
--
defaultConfig :: IO Config
defaultConfig =
Config
<$> getEnv' Right "/sys/fs/cgroup" "cgroupRoot"
<*> getEnv' readEither 8001 "httpPort"
<*> getEnv' readBool True "flushLog"
-- | 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
-- | Read a JSON-style boolean ("true", "false").
readBool :: String -> Either String Bool
readBool x = case x of
"true" -> Right True
"false" -> Right False
_ -> Left $ "not a bool: " <> x
|
