From e1d584cf1fa0668dbc59bd4de8cecd476261071b Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Thu, 16 Feb 2012 19:03:37 -0800
Subject: [PATCH] pass through args to yesod devel

---
 yesod/Devel.hs | 91 +++++++++++++++++++++++++-------------------------
 yesod/main.hs  |  2 +-
 2 files changed, 46 insertions(+), 47 deletions(-)

diff --git a/yesod/Devel.hs b/yesod/Devel.hs
index c8fcdced..e6033f30 100644
--- a/yesod/Devel.hs
+++ b/yesod/Devel.hs
@@ -28,7 +28,7 @@ import           System.Exit (exitFailure, exitSuccess, ExitCode (..))
 import           System.FilePath (splitDirectories, dropExtension, takeExtension)
 import           System.Posix.Types (EpochTime)
 import           System.PosixCompat.Files (modificationTime, getFileStatus)
-import           System.Process (runCommand, terminateProcess, readProcess,
+import           System.Process (createProcess, proc, terminateProcess, readProcess,
                                            waitForProcess, rawSystem)
 
 import Build (recompDeps, getDeps,findHaskellFiles)
@@ -44,8 +44,8 @@ writeLock = do
 removeLock :: IO ()
 removeLock = try_ (removeFile lockFile)
 
-devel :: Bool -> IO ()
-devel isCabalDev = do
+devel :: Bool -> [String] -> IO ()
+devel isCabalDev passThroughArgs = do
 
     checkDevelFile
 
@@ -58,58 +58,57 @@ devel isCabalDev = do
 
       checkCabalFile gpd
 
-      _ <- if isCabalDev
-        then rawSystem "cabal-dev"
-            [ "configure"
-            , "--cabal-install-arg=-fdevel" -- legacy
-            , "--cabal-install-arg=-flibrary-only"
-            , "--disable-library-profiling"
-            ]
-        else rawSystem "cabal"
-            [ "configure"
-            , "-fdevel" -- legacy
-            , "-flibrary-only"
-            , "--disable-library-profiling"
-            ]
+      _<- rawSystem cmd args
 
-      mainLoop isCabalDev
+      mainLoop
 
     _ <- getLine
     writeLock
     exitSuccess
+  where
+    cmd | isCabalDev == True = "cabal-dev"
+        | otherwise  = "cabal"
 
-mainLoop :: Bool -> IO ()
-mainLoop isCabalDev = do
-   ghcVer <- ghcVersion
-   forever $ do
-       putStrLn "Rebuilding application..."
+    diffArgs | isCabalDev == True = [
+              "--cabal-install-arg=-fdevel" -- legacy
+            , "--cabal-install-arg=-flibrary-only"
+            ]
+             | otherwise  = [
+              "-fdevel" -- legacy
+            , "-flibrary-only"
+            ]
+    args = "configure":diffArgs ++ ["--disable-library-profiling" ]
 
-       recompDeps
+    mainLoop :: IO ()
+    mainLoop = do
+       ghcVer <- ghcVersion
+       forever $ do
+           putStrLn "Rebuilding application..."
 
-       list <- getFileList
-       exit <- if isCabalDev
-               then rawSystem "cabal-dev" ["build"]
-               else rawSystem "cabal"     ["build"]
+           recompDeps
 
-       case exit of
-         ExitFailure _ -> putStrLn "Build failure, pausing..."
-         _ -> do
-               removeLock
-               let pkg = pkgConfigs isCabalDev ghcVer
-               let start = concat ["runghc ", pkg, " devel.hs"]
-               putStrLn $ "Starting development server: " ++ start
-               ph <- runCommand start
-               watchTid <- forkIO . try_ $ do
-                     watchForChanges list
-                     putStrLn "Stopping development server..."
-                     writeLock
-                     threadDelay 1000000
-                     putStrLn "Terminating development server..."
-                     terminateProcess ph
-               ec <- waitForProcess ph
-               putStrLn $ "Exit code: " ++ show ec
-               Ex.throwTo watchTid (userError "process finished")
-       watchForChanges list
+           list <- getFileList
+           exit <- rawSystem cmd ["build"]
+
+           case exit of
+             ExitFailure _ -> putStrLn "Build failure, pausing..."
+             _ -> do
+                   removeLock
+                   let pkg = pkgConfigs isCabalDev ghcVer
+                   let dev_args = ([pkg, "devel.hs"] ++ passThroughArgs)
+                   putStrLn $ "Starting development server: runghc " ++ L.intercalate " " dev_args
+                   (_,_,_,ph) <- createProcess $ proc "runghc" dev_args
+                   watchTid <- forkIO . try_ $ do
+                         watchForChanges list
+                         putStrLn "Stopping development server..."
+                         writeLock
+                         threadDelay 1000000
+                         putStrLn "Terminating development server..."
+                         terminateProcess ph
+                   ec <- waitForProcess ph
+                   putStrLn $ "Exit code: " ++ show ec
+                   Ex.throwTo watchTid (userError "process finished")
+           watchForChanges list
 
 try_ :: forall a. IO a -> IO ()
 try_ x = (Ex.try x :: IO (Either Ex.SomeException a)) >> return ()
diff --git a/yesod/main.hs b/yesod/main.hs
index dcf20cfa..72a7c9b1 100755
--- a/yesod/main.hs
+++ b/yesod/main.hs
@@ -35,7 +35,7 @@ main = do
         "build":rest -> touch >> build rest >>= exitWith
         ["touch"] -> touch
 #endif
-        ["devel"] -> devel isDev
+        "devel":rest -> devel isDev rest
         ["version"] -> putStrLn yesodVersion
         "configure":rest -> rawSystem cmd ("configure":rest) >>= exitWith
         _ -> do