diff options
| -rw-r--r-- | .gitignore | 1 | ||||
| -rw-r--r-- | Main.hs | 25 | ||||
| -rwxr-xr-x | repro.sh | 10 | ||||
| -rwxr-xr-x | sleep.sh | 2 | ||||
| -rw-r--r-- | snap-efault.cabal | 19 |
5 files changed, 57 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c33954f --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +dist-newstyle/ @@ -0,0 +1,25 @@ +module Main (main) where + +import Control.Concurrent +import Control.Monad (replicateM_) +import Snap.Http.Server +import qualified System.Process as Pr + + +makeWorker :: IO () +makeWorker = do + _ <- forkIO $ do + Pr.withCreateProcess (Pr.proc "./sleep.sh" []) $ \_ _ _ _ -> do + threadDelay 1000000 + return () + +makePool :: Int -> IO () +makePool numWorkers = replicateM_ numWorkers makeWorker + +main :: IO () +main = do + nprocs <- getNumCapabilities + putStrLn $ "Starting worker with " ++ show nprocs ++ " threads (use +RTS -N<n> to set)" + _ <- makePool nprocs + + httpServe defaultConfig (return ()) diff --git a/repro.sh b/repro.sh new file mode 100755 index 0000000..747601d --- /dev/null +++ b/repro.sh @@ -0,0 +1,10 @@ +#!/usr/bin/env bash +exe=$(cabal list-bin snap-efault) +echo "Program: <$exe>" + +echo "Be ready to 'kill $$', because ^C tends to not work with 'timeout'" + +while true; do + echo -n "*" + timeout 0.4 "$exe" +RTS -N 2>&1 | grep spawnp +done diff --git a/sleep.sh b/sleep.sh new file mode 100755 index 0000000..ffd1820 --- /dev/null +++ b/sleep.sh @@ -0,0 +1,2 @@ +#!/bin/sh +sleep 10 diff --git a/snap-efault.cabal b/snap-efault.cabal new file mode 100644 index 0000000..5bb005c --- /dev/null +++ b/snap-efault.cabal @@ -0,0 +1,19 @@ +cabal-version: 2.0 +name: snap-efault +synopsis: Stuff +version: 0.1.0.0 +license: MIT +author: Tom Smeding +maintainer: tom@tomsmeding.com +build-type: Simple + +executable snap-efault + main-is: + Main.hs + build-depends: + base >= 4.13 && < 4.15, + process >= 1.6.13.2 && < 1.7, + snap-server >= 1.1.1.2 && < 1.2 + hs-source-dirs: . + default-language: Haskell2010 + ghc-options: -Wall -O2 -threaded |