Flush log after each request.

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