From 3afd3cff39539e1906494d1c76ae288d4b326303 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 1 Feb 2011 08:13:26 +0200
Subject: [PATCH] develServer

---
 Yesod.hs                    | 57 ++++++++++++++++++++++++++++++++++++-
 scaffold/cabal.cg           |  8 ++++++
 scaffold/devel-server_hs.cg | 19 ++-----------
 yesod.cabal                 |  2 ++
 4 files changed, 68 insertions(+), 18 deletions(-)

diff --git a/Yesod.hs b/Yesod.hs
index d73cc3e6..6230a186 100644
--- a/Yesod.hs
+++ b/Yesod.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
 -- | This module simply re-exports from other modules for your convenience.
 module Yesod
     ( -- * Re-exports from yesod-core
@@ -14,6 +14,7 @@ module Yesod
       -- * Running your application
     , warp
     , warpDebug
+    , develServer
       -- * Commonly referenced functions/datatypes
     , Application
     , lift
@@ -58,6 +59,7 @@ import Yesod.Json
 import Yesod.Persist
 import Network.Wai (Application)
 import Network.Wai.Middleware.Debug
+import Network.Wai.Handler.DevelServer (runQuit)
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.IO.Peel (MonadPeelIO)
@@ -65,6 +67,12 @@ import Control.Monad.IO.Peel (MonadPeelIO)
 import Network.Wai.Handler.Warp (run)
 import System.IO (stderr, hPutStrLn)
 
+import qualified Data.Text.Lazy.IO as TIO
+import qualified Data.Attoparsec.Text.Lazy as A
+import Control.Applicative ((<|>))
+import Data.Maybe (mapMaybe)
+import Data.Char (isSpace)
+
 showIntegral :: Integral a => a -> String
 showIntegral x = show (fromIntegral x :: Integer)
 
@@ -85,3 +93,50 @@ warpDebug :: (Yesod a, YesodDispatch a a) => Int -> a -> IO ()
 warpDebug port a = do
     hPutStrLn stderr $ "Application launched, listening on port " ++ show port
     toWaiApp a >>= run port . debug
+
+-- | Run a development server, where your code changes are automatically
+-- reloaded.
+develServer :: Int -- ^ port number
+            -> String -- ^ module name holding the code
+            -> String -- ^ name of function providing a with-application
+            -> IO ()
+develServer port modu func = do
+    mapM_ putStrLn
+        [ "Starting your server process. Code changes will be automatically"
+        , "loaded as you save your files. Type \"quit\" to exit."
+        , "You can view your app at http://localhost:" ++ show port ++ "/"
+        , ""
+        ]
+    runQuit port modu func determineHamletDeps
+
+data TempType = Hamlet | Cassius | Julius | Widget
+    deriving Show
+
+-- | Determine which Hamlet files a Haskell file depends upon.
+determineHamletDeps :: FilePath -> IO [FilePath]
+determineHamletDeps x = do
+    y <- TIO.readFile x
+    let z = A.parse (A.many $ (parser <|> (A.anyChar >> return Nothing))) y
+    case z of
+        A.Fail{} -> return []
+        A.Done _ r -> return $ mapMaybe go r
+  where
+    go (Just (Hamlet, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"
+    go (Just (Widget, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"
+    go _ = Nothing
+    parser = do
+        typ <- (A.string "$(hamletFile " >> return Hamlet)
+           <|> (A.string "$(cassiusFile " >> return Cassius)
+           <|> (A.string "$(juliusFile " >> return Julius)
+           <|> (A.string "$(widgetFile " >> return Widget)
+           <|> (A.string "$(Settings.hamletFile " >> return Hamlet)
+           <|> (A.string "$(Settings.cassiusFile " >> return Cassius)
+           <|> (A.string "$(Settings.juliusFile " >> return Julius)
+           <|> (A.string "$(Settings.widgetFile " >> return Widget)
+        A.skipWhile isSpace
+        _ <- A.char '"'
+        y <- A.many1 $ A.satisfy (/= '"')
+        _ <- A.char '"'
+        A.skipWhile isSpace
+        _ <- A.char ')'
+        return $ Just (typ, y)
diff --git a/scaffold/cabal.cg b/scaffold/cabal.cg
index f8707e93..db4f82fe 100644
--- a/scaffold/cabal.cg
+++ b/scaffold/cabal.cg
@@ -48,3 +48,11 @@ executable         ~project~-production
     main-is:       production.hs
     ghc-options:   -Wall -threaded
 
+executable         ~project~-devel
+    if flag(production)
+        Buildable: False
+    else
+        build-depends: wai-handler-devel >= 0.2 && < 0.3
+    main-is:       devel-server.hs
+    ghc-options:   -Wall -O2
+
diff --git a/scaffold/devel-server_hs.cg b/scaffold/devel-server_hs.cg
index 9235a5c6..c0dfa02b 100644
--- a/scaffold/devel-server_hs.cg
+++ b/scaffold/devel-server_hs.cg
@@ -1,20 +1,5 @@
-import Network.Wai.Handler.DevelServer (run)
-import Control.Concurrent (forkIO)
+import Yesod (develServer)
 
 main :: IO ()
-main = do
-    mapM_ putStrLn
-        [ "Starting your server process. Code changes will be automatically"
-        , "loaded as you save your files. Type \"quit\" to exit."
-        , "You can view your app at http://localhost:3000/"
-        , ""
-        ]
-    _ <- forkIO $ run 3000 "Controller" "with~sitearg~" ["hamlet"]
-    go
-  where
-    go = do
-        x <- getLine
-        case x of
-            'q':_ -> putStrLn "Quitting, goodbye!"
-            _ -> go
+main = develServer 3000 "Controller" "with~sitearg~"
 
diff --git a/yesod.cabal b/yesod.cabal
index 618397ed..20c8c2d5 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -36,6 +36,8 @@ library
                    , warp                      >= 0.3      && < 0.4
                    , mime-mail                 >= 0.1      && < 0.2
                    , hjsmin                    >= 0.0.12   && < 0.1
+                   , wai-handler-devel         >= 0.2      && < 0.3
+                   , attoparsec-text           >= 0.8      && < 0.9
     exposed-modules: Yesod
     ghc-options:     -Wall