pass through args to yesod devel

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 :: Bool -> [String] -> IO ()
-devel isCabalDev = do
+devel isCabalDev passThroughArgs = do
 
     checkDevelFile
 
@@ -58,58 +58,57 @@ devel isCabalDev = do
 
       checkCabalFile gpd
 
-      _ <- if isCabalDev
+      _<- rawSystem cmd args
-        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"
-            ]
 
-      mainLoop isCabalDev
+      mainLoop
 
     _ <- getLine
     writeLock
     exitSuccess
+  where
+    cmd | isCabalDev == True = "cabal-dev"
+        | otherwise  = "cabal"
 
-mainLoop :: Bool -> IO ()
+    diffArgs | isCabalDev == True = [
-mainLoop isCabalDev = do
+              "--cabal-install-arg=-fdevel" -- legacy
-   ghcVer <- ghcVersion
+            , "--cabal-install-arg=-flibrary-only"
-   forever $ do
+            ]
-       putStrLn "Rebuilding application..."
+             | 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
+           recompDeps
-       exit <- if isCabalDev
-               then rawSystem "cabal-dev" ["build"]
-               else rawSystem "cabal"     ["build"]
 
-       case exit of
+           list <- getFileList
-         ExitFailure _ -> putStrLn "Build failure, pausing..."
+           exit <- rawSystem cmd ["build"]
-         _ -> do
+
-               removeLock
+           case exit of
-               let pkg = pkgConfigs isCabalDev ghcVer
+             ExitFailure _ -> putStrLn "Build failure, pausing..."
-               let start = concat ["runghc ", pkg, " devel.hs"]
+             _ -> do
-               putStrLn $ "Starting development server: " ++ start
+                   removeLock
-               ph <- runCommand start
+                   let pkg = pkgConfigs isCabalDev ghcVer
-               watchTid <- forkIO . try_ $ do
+                   let dev_args = ([pkg, "devel.hs"] ++ passThroughArgs)
-                     watchForChanges list
+                   putStrLn $ "Starting development server: runghc " ++ L.intercalate " " dev_args
-                     putStrLn "Stopping development server..."
+                   (_,_,_,ph) <- createProcess $ proc "runghc" dev_args
-                     writeLock
+                   watchTid <- forkIO . try_ $ do
-                     threadDelay 1000000
+                         watchForChanges list
-                     putStrLn "Terminating development server..."
+                         putStrLn "Stopping development server..."
-                     terminateProcess ph
+                         writeLock
-               ec <- waitForProcess ph
+                         threadDelay 1000000
-               putStrLn $ "Exit code: " ++ show ec
+                         putStrLn "Terminating development server..."
-               Ex.throwTo watchTid (userError "process finished")
+                         terminateProcess ph
-       watchForChanges list
+                   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 ()

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