twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 08:30:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Add lib to ghc searchpath with recompilation check

Browse Source
This commit is contained in:
Adam Vogt 2009-03-21 23:29:07 +00:00
parent e944a6c8d3
commit ccb6ff92f2
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
XMonad/Core.hs
View File

@ -37,6 +37,7 @@ import Control.Exception (catch, try, bracket, throw, finally, Exception(ExitExc
import Control.Applicative import Control.Applicative
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import System.FilePath
import System.IO import System.IO
import System.Info import System.Info
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession) import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
@ -49,6 +50,7 @@ import System.Exit
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (Event) import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable import Data.Typeable
import Data.List ((\\))
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Monoid import Data.Monoid
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
@ -405,18 +407,20 @@ recompile :: MonadIO m => Bool -> m Bool
recompile force = io $ do recompile force = io $ do
dir <- getXMonadDir dir <- getXMonadDir
let binn = "xmonad-"++arch++"-"++os let binn = "xmonad-"++arch++"-"++os
bin = dir ++ "/" ++ binn bin = dir </> binn
base = dir ++ "/" ++ "xmonad" base = dir </> "xmonad"
err = base ++ ".errors" err = base ++ ".errors"
src = base ++ ".hs" src = base ++ ".hs"
lib = dir </> "lib"
libTs <- mapM getModTime =<< allFiles lib
srcT <- getModTime src srcT <- getModTime src
binT <- getModTime bin binT <- getModTime bin
if (force || srcT > binT) if (force || srcT > binT || any (binT<) libTs)
then do then do
-- temporarily disable SIGCHLD ignoring: -- temporarily disable SIGCHLD ignoring:
uninstallSignalHandlers uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $ \h -> do status <- bracket (openFile err WriteMode) hClose $ \h -> do
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-fforce-recomp", "-v0", "-o",binn] (Just dir) waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-v0", "-o",binn] (Just dir)
Nothing Nothing Nothing (Just h) Nothing Nothing Nothing (Just h)
-- re-enable SIGCHLD: -- re-enable SIGCHLD:
@ -436,6 +440,11 @@ recompile force = io $ do
return (status == ExitSuccess) return (status == ExitSuccess)
else return True else return True
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing) where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)
allFiles t = do
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
cs <- prep <$> catch (getDirectoryContents t) (\_ -> return [])
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
-- | Conditionally run an action, using a @Maybe a@ to decide. -- | Conditionally run an action, using a @Maybe a@ to decide.
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()

2
xmonad.cabal
View File

@ -41,7 +41,7 @@ library
XMonad.StackSet XMonad.StackSet
if flag(small_base) if flag(small_base)
build-depends: base < 4 && >=3, containers, directory, process build-depends: base < 4 && >=3, containers, directory, process, filepath
else else
build-depends: base < 3 build-depends: base < 3
build-depends: X11>=1.4.3, mtl, unix build-depends: X11>=1.4.3, mtl, unix