Seq.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import           Control.Monad             (replicateM, void)
import           Prelude                   hiding (log)
import           System.Log.Formatter
import           System.Log.Handler        (setFormatter)
import           System.Log.Handler.Simple
import           System.Log.Logger
import           System.Timeout            (timeout)

main :: IO ()
main = do
  setUpLogging
  void (replicateM 2000 logger)

logger :: IO ()
logger = tm $ do
    debugM "" (concat (replicate 1024 "ooooo"))
  where
    tm f = do
      res <- timeout (200000) f
      case res of
        Just _ -> return ()
        Nothing -> debugM "" "Timeout while logging"

logFilePath :: String
logFilePath = "log/timeoutbug.log"

setUpLogging :: IO ()
setUpLogging = do
    h <- fileHandler logFilePath DEBUG >>= \lh -> return $
        setFormatter lh (simpleLogFormatter
            "[$time : $loggername : $prio] $msg")
    updateGlobalLogger rootLoggerName (addHandler h)
    updateGlobalLogger rootLoggerName (setLevel DEBUG)