diff options
| -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 |