develServer

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)

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
+

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~"
 

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