content: {-# LANGUAGE BangPatterns #-}
  module Main where
  
  import Control.Concurrent
  import Foreign.C
  import GHC.Clock
  import GHC.Event
  import System.CPUTime
  import System.Posix.Types
  import Control.Monad
  import System.Exit
  
  foreign import ccall unsafe "socket" c_socket ::
                 CInt -> CInt -> CInt -> IO CInt
  
  makeTestSocketFd :: IO Fd
  makeTestSocketFd = do
      sockNum <-
          c_socket
              1 -- PF_LOCAL
              2 -- SOCK_DGRAM
              0
      return $ (fromIntegral sockNum :: Fd)
  
  callback :: FdKey -> Event -> IO ()
  callback _ _ = return ()
  
  -- Idle CPU usage with 0 for 0% and 10^12 for 100%
  idleCpuUsage :: IO Integer
  idleCpuUsage = do
    -- measure the process time spent in the rts, not in the mutator
    -- make sure to disable idle GC (+RTS -I0)
    !startCPUTime <- getCPUTime
    threadDelay 100000
    !endCPUTime <- getCPUTime
    let !t = endCPUTime - startCPUTime
    return $ t
  
  main :: IO ()
  main = do
    (Just eventMgr) <- getSystemEventManager
    fd <- makeTestSocketFd
  
    let getAvgCpuUsage = do
          let n = 10
          let warmup = 2
          xs <- drop warmup <$> replicateM (warmup+n) idleCpuUsage
          return $! fromIntegral (sum xs) / fromIntegral n
  
    !before <- getAvgCpuUsage
  
    registerFd eventMgr callback fd evtRead OneShot
    registerFd eventMgr callback fd evtWrite OneShot
  
    -- use this to test that this test works
    --forkIO $ forever $ do
    --  putStrLn ""
    --  threadDelay 10000
  
    !after <- getAvgCpuUsage
  
    -- CPU consumption should roughly be the same when just idling vs
    -- when idling after the event has been triggered
    let r = (after-before) / before * 100
  
    let max_percent = 100 -- max difference (in percent)
  
    when (abs r > max_percent) $ do
      putStrLn $ mconcat
        [ "Idle CPU consumption too different after event registration: "
        , if r > 0 then "+" else ""
        , show (round r)
        , "% (> +/- "
        , show (round max_percent)
        , "%)\n"
        , "Before: "
        , show (round before `div` 1000000 :: Integer)
        , "ms\n"
        , "After: "
        , show (round after `div` 1000000 :: Integer)
        , "ms"
        ]
      exitFailure
  