From 393b2c8edd247612c52d2422165516342c72c94a Mon Sep 17 00:00:00 2001
From: Don Stewart <dons@galois.com>
Date: Mon, 19 Nov 2007 02:07:59 +0100
Subject: Do our own recompilation checking: only launch ghc if the xmonad.hs
 is newer than its .o file

darcs-hash:20071119010759-cba2c-e9b94827122cb337ddcf93c3aefb62775011707a
---
 Main.hs        |  2 +-
 XMonad/Core.hs | 20 ++++++++++++++------
 2 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/Main.hs b/Main.hs
index 03b2d69..ae31117 100644
--- a/Main.hs
+++ b/Main.hs
@@ -44,7 +44,7 @@ main = do
 buildLaunch ::  IO ()
 buildLaunch = do
     recompile
-    dir <- fmap (++ "/.xmonad") getHomeDirectory
+    dir  <- fmap (++ "/.xmonad") getHomeDirectory
     args <- getArgs
     executeFile (dir ++ "/xmonad") False args Nothing
     return ()
diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index ee5320c..90bfd9a 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -294,14 +294,22 @@ restart mprog resume = do
 
 -- | Recompile ~\/xmonad\/xmonad.hs.
 --
--- Raises an exception if ghc can't be found.
+-- The -i flag is used to restrict recompilation to the xmonad.hs file.
+-- Raises an exception if GHC can't be found, or if anything else goes wrong.
+--
 recompile :: IO ()
 recompile = do
-    dir <- fmap (++ "/.xmonad") getHomeDirectory
-    pid <- runProcess "ghc" ["--make", "xmonad.hs", "-i"] (Just dir)
-        Nothing Nothing Nothing Nothing
-    waitForProcess pid
-    return ()
+    dir     <- liftM (++ "/.xmonad") getHomeDirectory
+    let src = dir ++ "/" ++ "xmonad.hs"
+        obj = dir ++ "/" ++ "xmonad.o"
+    yes     <- doesFileExist src
+    when yes $ do
+        srcT <- getModificationTime src
+        objT <- getModificationTime obj
+        when (srcT > objT) $ do
+            waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i"] (Just dir)
+                                    Nothing Nothing Nothing Nothing
+            return ()
 
 -- | Run a side effecting action with the current workspace. Like 'when' but
 whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
-- 
cgit v1.2.3