Async.hs

module Web.Scotty.Async
  where

import Control.Concurrent (ThreadId, forkIO, newEmptyMVar, putMVar, takeMVar)
import Control.Concurrent.Async (async, Async(..))
import Data.Default (def)
import Network.Wai.Handler.Warp (Port, defaultSettings, setBeforeMainLoop,
                                 setPort)
import Web.Scotty (Options(..), ScottyM, scottyOpts)

-- |
-- Start a scotty server with 'Options' and return an 'Async' with the
-- 'ThreadId' it's running on, which resolves when the server starts listening.
scottyOptsAsync :: Options -> ScottyM () -> IO (Async ThreadId)
scottyOptsAsync o s = do
    started <- newEmptyMVar
    tid <- forkIO $ scottyOpts (o { settings = set (settings o) started }) s
    async $ do
         _ <- takeMVar started
         return tid
  where
    set d started = setBeforeMainLoop (putMVar started ()) d

-- |
-- Start a scotty server at 'Port' and return an 'Async' with the 'ThreadId'
-- it's running on, which resolves when the server starts listening.
scottyAsync :: Port -> ScottyM () -> IO (Async ThreadId)
scottyAsync p = scottyOptsAsync $ def { settings = setPort p defaultSettings
                                      , verbose = 0
                                      }