summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/Main.hs14
-rw-r--r--src/Main/Config.hs14
2 files changed, 27 insertions, 1 deletions
diff --git a/src/Main.hs b/src/Main.hs
index ef7710f..66b4df6 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -56,6 +56,7 @@ import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.RequestLogger (logStdout)
import System.FilePath
import System.IO.Error
+import System.IO (hFlush, stdout)
-- | The sum of all resources known by the application.
@@ -79,10 +80,21 @@ main =
start :: Config -> IO ()
start c = do
putStrLn $ "run cgserver with " <> show c
+ hFlush stdout
run (httpPort c)
- $ logStdout
+ $ logger
$ \req ->
resourceHandler (requestResource c req) req
+ where
+ logger =
+ if flushLog c
+ then flush stdout . logStdout
+ else logStdout
+
+ -- This middleware flushes the given handle after each request.
+ flush h app req respond = app req $ \res -> do
+ hFlush h
+ respond res
-- | Determine which request is requested.
diff --git a/src/Main/Config.hs b/src/Main/Config.hs
index 9639faa..66f72ea 100644
--- a/src/Main/Config.hs
+++ b/src/Main/Config.hs
@@ -20,7 +20,11 @@ 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
@@ -33,12 +37,14 @@ data Config = Config
--
-- > 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.
@@ -53,3 +59,11 @@ getEnv' pf def name =
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