diff options
author | tv <tv@shackspace.de> | 2014-11-06 16:10:43 +0100 |
---|---|---|
committer | tv <tv@shackspace.de> | 2014-11-06 16:10:43 +0100 |
commit | 9b2bea53c6bc87be639964aaca87c09ab16df486 (patch) | |
tree | 5bd768ccc901a357fbbf77ab337b2015eb486646 | |
parent | 781e26234dd1854c51895fa4fcc31f26f209c52f (diff) |
Flush log after each request.
-rw-r--r-- | src/Main.hs | 14 | ||||
-rw-r--r-- | src/Main/Config.hs | 14 |
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 |