From 80020fc4d86cd28c9e803173496a9bb50416aba6 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 26 Dec 2010 11:06:14 +0200
Subject: [PATCH] Added warp and warpDebug

---
 Yesod.hs    | 27 +++++++++++++++++++++++++++
 yesod.cabal |  1 +
 2 files changed, 28 insertions(+)

diff --git a/Yesod.hs b/Yesod.hs
index 9ff8202c..a0da8aef 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -8,6 +8,9 @@ module Yesod
     , module Yesod.Handler
     , module Yesod.Dispatch
     , module Yesod.Widget
+      -- * Running your application
+    , warp
+    , warpDebug
       -- * Commonly referenced functions/datatypes
     , Application
     , lift
@@ -48,10 +51,14 @@ import Text.Julius
 import Yesod.Request
 import Yesod.Widget
 import Network.Wai (Application)
+import qualified Network.Wai as W
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.IO.Peel (MonadPeelIO)
 
+import Network.Wai.Handler.Warp (run)
+import System.IO (stderr, hPutStrLn)
+
 showIntegral :: Integral a => a -> String
 showIntegral x = show (fromIntegral x :: Integer)
 
@@ -60,3 +67,23 @@ readIntegral s =
     case reads s of
         (i, _):_ -> Just $ fromInteger i
         [] -> 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
diff --git a/yesod.cabal b/yesod.cabal
index 37bc6cf4..acaa9e48 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -27,6 +27,7 @@ library
                    , transformers              >= 0.2      && < 0.3
                    , wai                       >= 0.3      && < 0.4
                    , hamlet                    >= 0.7      && < 0.8
+                   , warp                      >= 0.3      && < 0.4
     exposed-modules: Yesod
     ghc-options:     -Wall