Added warp and warpDebug
This commit is contained in:
parent
c88bbfa33e
commit
80020fc4d8
27
Yesod.hs
27
Yesod.hs
@ -8,6 +8,9 @@ module Yesod
|
|||||||
, module Yesod.Handler
|
, module Yesod.Handler
|
||||||
, module Yesod.Dispatch
|
, module Yesod.Dispatch
|
||||||
, module Yesod.Widget
|
, module Yesod.Widget
|
||||||
|
-- * Running your application
|
||||||
|
, warp
|
||||||
|
, warpDebug
|
||||||
-- * Commonly referenced functions/datatypes
|
-- * Commonly referenced functions/datatypes
|
||||||
, Application
|
, Application
|
||||||
, lift
|
, lift
|
||||||
@ -48,10 +51,14 @@ import Text.Julius
|
|||||||
import Yesod.Request
|
import Yesod.Request
|
||||||
import Yesod.Widget
|
import Yesod.Widget
|
||||||
import Network.Wai (Application)
|
import Network.Wai (Application)
|
||||||
|
import qualified Network.Wai as W
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.IO.Peel (MonadPeelIO)
|
import Control.Monad.IO.Peel (MonadPeelIO)
|
||||||
|
|
||||||
|
import Network.Wai.Handler.Warp (run)
|
||||||
|
import System.IO (stderr, hPutStrLn)
|
||||||
|
|
||||||
showIntegral :: Integral a => a -> String
|
showIntegral :: Integral a => a -> String
|
||||||
showIntegral x = show (fromIntegral x :: Integer)
|
showIntegral x = show (fromIntegral x :: Integer)
|
||||||
|
|
||||||
@ -60,3 +67,23 @@ readIntegral s =
|
|||||||
case reads s of
|
case reads s of
|
||||||
(i, _):_ -> Just $ fromInteger i
|
(i, _):_ -> Just $ fromInteger i
|
||||||
[] -> Nothing
|
[] -> Nothing
|
||||||
|
|
||||||
|
-- | A convenience method to run an application using the Warp webserver on the
|
||||||
|
-- specified port. Automatically calls 'toWaiApp'.
|
||||||
|
warp :: (Yesod a, YesodSite a) => Int -> a -> IO ()
|
||||||
|
warp port a = toWaiApp a >>= run port
|
||||||
|
|
||||||
|
-- | Same as 'warp', but also sends a message to stderr for each request, and
|
||||||
|
-- an \"application launched\" message as well. Can be useful for development.
|
||||||
|
warpDebug :: (Yesod a, YesodSite a) => Int -> a -> IO ()
|
||||||
|
warpDebug port a = do
|
||||||
|
hPutStrLn stderr $ "Application launched, listening on port " ++ show port
|
||||||
|
toWaiApp a >>= run port . debugMiddleware
|
||||||
|
where
|
||||||
|
debugMiddleware app req = do
|
||||||
|
hPutStrLn stderr $ concat
|
||||||
|
[ show $ W.requestMethod req
|
||||||
|
, " "
|
||||||
|
, show $ W.pathInfo req
|
||||||
|
]
|
||||||
|
app req
|
||||||
|
|||||||
@ -27,6 +27,7 @@ library
|
|||||||
, transformers >= 0.2 && < 0.3
|
, transformers >= 0.2 && < 0.3
|
||||||
, wai >= 0.3 && < 0.4
|
, wai >= 0.3 && < 0.4
|
||||||
, hamlet >= 0.7 && < 0.8
|
, hamlet >= 0.7 && < 0.8
|
||||||
|
, warp >= 0.3 && < 0.4
|
||||||
exposed-modules: Yesod
|
exposed-modules: Yesod
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user