Merge pull request #334 from hirschenberger/develbuildghcapi

Develbuildghcapi

yesod/Devel.hs

@@ -41,7 +41,8 @@ import           System.FilePath (splitDirectories, dropExtension, takeExtension
 import           System.Posix.Types (EpochTime)
 import           System.PosixCompat.Files (modificationTime, getFileStatus)
 import           System.Process (createProcess, proc, terminateProcess, readProcess, ProcessHandle,
-                                       getProcessExitCode,waitForProcess, rawSystem, runInteractiveProcess)
+                                 getProcessExitCode,waitForProcess, rawSystem, 
+                                 runInteractiveProcess, system)
 import           System.IO (hClose, hIsEOF, hGetLine, stdout, stderr, hPutStrLn)
 import           System.IO.Error (isDoesNotExistError)
 
@@ -63,16 +64,18 @@ removeLock :: IO ()
 removeLock = removeFileIfExists lockFile
 
 data DevelOpts = DevelOpts
-      { isCabalDev :: Bool
-      , forceCabal :: Bool
-      , verbose    :: Bool
+      { isCabalDev  :: Bool
+      , forceCabal  :: Bool
+      , verbose     :: Bool
+      , successHook :: Maybe String
+      , failHook    :: Maybe String
       } deriving (Show, Eq)
 
 cabalCommand :: DevelOpts -> FilePath
 cabalCommand opts | isCabalDev opts = "cabal-dev"
                   | otherwise       = "cabal"
 
-defaultDevelOpts = DevelOpts False False False
+defaultDevelOpts = DevelOpts False False False Nothing Nothing
 
 devel :: DevelOpts -> [String] -> IO ()
 devel opts passThroughArgs = do
@@ -109,8 +112,11 @@ devel opts passThroughArgs = do
            pkgArgs <- ghcPackageArgs opts ghcVer (D.packageDescription gpd) lib
            let devArgs = pkgArgs ++ ["devel.hs"] ++ passThroughArgs
            if not success
-             then putStrLn "Build failure, pausing..."
+             then do 
+                   putStrLn "Build failure, pausing..."
+                   runBuildHook $ failHook opts 
              else do
+                   runBuildHook $ successHook opts
                    removeLock
                    putStrLn $ if verbose opts then "Starting development server: runghc " ++ L.unwords devArgs
                                               else "Starting development server..."
@@ -127,6 +133,13 @@ devel opts passThroughArgs = do
                    Ex.throwTo watchTid (userError "process finished")
            watchForChanges hsSourceDirs [cabal] list
 
+runBuildHook :: Maybe String -> IO ()
+runBuildHook (Just s) = do 
+                        ret <- system s
+                        case ret of
+                            ExitFailure f -> putStrLn $ "Error executing hook: " ++ s
+                            otherwise     -> return ()
+runBuildHook Nothing = return ()
 
 {-
   configure with the built-in Cabal lib for non-cabal-dev, since

yesod/Types.hs

@@ -28,6 +28,22 @@ mkOptApi name = option name (\o -> o
   , optionDescription  = "use the GHC API to build (faster, but experimental)"
   })
 
+mkOptSuccessHook name = option name (\o -> o
+  { optionLongFlags    = ["success-hook"]
+  , optionShortFlags   = ['s']
+  , optionType         = optionTypeMaybe optionTypeString
+  , optionDefault      = ""
+  , optionDescription  = "Shell command to run when compilation succeeds (e.g. 'beep')"
+  })
+
+mkOptFailHook name = option name (\o -> o
+  { optionLongFlags    = ["fail-hook"]
+  , optionShortFlags   = ['f']
+  , optionType         = optionTypeMaybe optionTypeString
+  , optionDefault      = ""
+  , optionDescription  = "Shell command to run when compilation fails (e.g. 'beep')"
+  })
+
 mkOptVerbose name = option name (\o -> o
   { optionLongFlags    = ["verbose"]
   , optionShortFlags   = ['v']

yesod/main.hs

@@ -20,10 +20,12 @@ defineOptions "NoOptions" (return ())
 defineOptions "DevelOptions" $ do
   mkOptApi        "develOptApi"
 --  mkOptNoApi    "develOptNoApi"  -- use this later when flag is enabled by default
+  mkOptSuccessHook "optSuccessHook"
+  mkOptFailHook    "optFailHook" 
 
 defineOptions "MainOptions" $ do
-  mkOptCabalDev "optCabalDev"
-  mkOptVerbose  "optVerbose"
+  mkOptCabalDev    "optCabalDev"
+  mkOptVerbose     "optVerbose"
 
 type InitOptions      = NoOptions
 type ConfigureOptions = NoOptions
@@ -65,8 +67,10 @@ cmdTouch _ _ _ = touch
 cmdDevel :: MainOptions -> DevelOptions -> [String] -> IO ()
 cmdDevel mopt opts args = devel dopts args
     where
-      dopts      = DevelOpts (optCabalDev mopt) forceCabal (optVerbose mopt)
-      forceCabal = not (develOptApi opts)
+      dopts       = DevelOpts (optCabalDev mopt) forceCabal (optVerbose mopt) successHook failHook 
+      successHook = optSuccessHook opts
+      failHook    = optFailHook opts
+      forceCabal  = not (develOptApi opts)
 --      forceCabal = develOptNoApi opts
 
 cmdVersion :: MainOptions -> VersionOptions -> [String] -> IO ()