event_benchmark.hs

-- To benchmark, make sure to expose the GHC.Event.* in /libraries/base/base.cabal,
-- otherwise GHC will complain that they are hidden modules.
import GHC.Event.Manager hiding (closeFd)
import GHC.Event.Internal
import GHC.Event.IoUring as IoUring
import GHC.Event.EPoll as Epoll

import Control.Monad
import Data.Time
import System.Posix.IO

repetitions = 500000

main = do
  uring <- IoUring.new
  epoll <- Epoll.new

  putStrLn "Register and unregister a single fd when no others are present"
  (readFd, writeFd) <- createPipe
  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)
  closeFd readFd
  closeFd writeFd

  putStrLn "Poll when no fds are monitored"

  start <- getCurrentTime
  replicateM_ repetitions $ poll uring Nothing (\_ _ -> return ())
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ poll epoll Nothing (\_ _ -> return ())
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)

  putStrLn "Monitor 512 fds with no events on them"
  fds <- replicateM 512 createPipe
  let  readFds = map fst fds
  let writeFds = map snd fds

  forM_ readFds $ \readFd -> modifyFdOnce uring readFd evtRead
  forM_ readFds $ \readFd -> modifyFdOnce epoll readFd evtRead

  start <- getCurrentTime
  replicateM_ repetitions $ poll uring Nothing (\_ _ -> return ())
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ poll epoll Nothing (\_ _ -> return ())
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)

  putStrLn "Register and unregister a single fd with 512 poll requests already outstanding"
  (readFd, writeFd) <- createPipe
  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)
  closeFd readFd
  closeFd writeFd

  putStrLn "Register a fd that will trigger immediately and poll for it, waiting until it is ready, with 512 poll requests already outstanding"
  (readFd, writeFd) <- createPipe
  fdWrite writeFd "foo"

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> poll uring (Just Forever) (\_ _ -> return ())
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> poll epoll (Just Forever) (\_ _ -> return ())
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)
  closeFd readFd
  closeFd writeFd

  -- cause all fds to be readable and run all callbacks
  forM_ writeFds $ \writeFd -> fdWrite writeFd "foo"
  poll uring Nothing (\_ _ -> return ())
  poll epoll Nothing (\_ _ -> return ())


  putStrLn "Register and unregister a single fd after cleaning up all events"
  (readFd, writeFd) <- createPipe
  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> modifyFd uring readFd evtRead mempty
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> modifyFd epoll readFd evtRead mempty
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)
  closeFd readFd
  closeFd writeFd

  putStrLn "Register a fd that will trigger immediately and poll for it, waiting until it is ready"
  (readFd, writeFd) <- createPipe
  fdWrite writeFd "foo"

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce uring readFd evtRead >> poll uring (Just Forever) (\_ _ -> return ())
  end <- getCurrentTime
  print $ "uring: " ++ (show $ diffUTCTime end start)

  start <- getCurrentTime
  replicateM_ repetitions $ modifyFdOnce epoll readFd evtRead >> poll epoll (Just Forever) (\_ _ -> return ())
  end <- getCurrentTime
  print $ "epoll: " ++ (show $ diffUTCTime end start)
  closeFd readFd
  closeFd writeFd