module Happstack.Server.Helpers
( smartserver, exactdir, smartserver'
) where
import Happstack.Server
import Happstack.State
import System.Environment
import Control.Concurrent
import System.Time
import Happstack.Server.CookieFixer
import Control.Monad
-- run the happs server on some port
-- include cookie fix, various other enhancements that make things simpler
smartserver' :: (Methods st, Component st, ToMessage b, Monad m) =>
(m (Maybe (Either Response a, FilterFun Response)) ->
IO (Maybe (Either Response b, FilterFun Response))) ->
Conf -> String -> ServerPartT m a -> Proxy st -> IO ()
smartserver' f conf progName handler stateProxy = withProgName progName $ do
putStrLn . ( "starting happs server" ++ ) =<< time
control <- startSystemState stateProxy -- start the HAppS state system
putStrLn . ( "happs state started" ++ ) =<< time
tid <- forkIO $ simpleHTTP' f conf (cookieFixer handler)
putStrLn . ( ( "simpleHttp started on port " ++ (show . port $ conf) ++ "\n" ++
"shut down with ctrl-c" ) ++) =<< time
waitForTermination
killThread tid
putStrLn . ( "creating checkpoint: " ++ ) =<< time
createCheckpoint control
putStrLn . ( "shutting down system: " ++ ) =<< time
shutdownSystem control
putStrLn . ( "exiting: " ++ ) =<< time
where time = return . ("\ntime: " ++ ) . show =<< getClockTime
smartserver :: (Methods st, Component st, ToMessage a) =>
Conf -> String -> ServerPartT IO a -> Proxy st -> IO ()
smartserver = smartserver' id
exactdir :: (Monad m) => String -> ServerPartT m a -> ServerPartT m a
exactdir staticPath = spsIf (\rq -> rqURL rq == staticPath)
spsIf :: (Monad m) => (Request -> Bool) -> ServerPartT m a -> ServerPartT m a
spsIf p sps = do
rq <- askRq
if p rq
then sps
else mzero