diff --git a/CHANGES.md b/CHANGES.md index e06e66b..1d626dc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -29,6 +29,10 @@ In the cases of 1. and 3., the build script or executable is expected to be in the config dir. + Additionally, the xmonad config binary and intermediate object files were + moved to the cache directory (only relevant if using XDG or + `XMONAD_CACHE_DIR`). + * Change `ScreenDetail` to a newtype and make `RationalRect` strict in its contents. @@ -53,6 +57,14 @@ * `DestroyWindowEvent` is now broadcasted to layouts to let them know window-specific resources can be discarded. + * Recompilation now detects `stack.yaml` (can be a symlink) alongside + `xmonad.hs` and switches to using `stack ghc`. We also updated INSTALL.md + with instructions for cabal-install that lead to correct recompilation. + + Deprecation warnings during recompilation are no longer suppressed to make + it easier for us to clean up the codebase. These can still be suppressed + manually using an `OPTIONS_GHC` pragma with `-Wno-deprecations`. + ## 0.15 (September 30, 2018) * Reimplement `sendMessage` to deal properly with windowset changes made diff --git a/INSTALL.md b/INSTALL.md index 83e8c6b..cea8dcf 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -20,7 +20,7 @@ Those who install from distro can skip this and go straight to - [Build using Stack](#build-using-stack) - [Build using cabal-install](#build-using-cabal-install) - [Make XMonad your window manager](#make-xmonad-your-window-manager) -- [Don't Recompile on Every Startup](#dont-recompile-on-every-startup) +- [Custom Build Script](#custom-build-script) @@ -187,6 +187,12 @@ packages: - xmonad-contrib ``` +With `stack.yaml` alongside `xmonad.hs`, xmonad now knows that it needs to use +`stack ghc` instead of just `ghc` when (re)compiling its configuration. +If you want to keep xmonad sources and the stack project elsewhere, but still +use `xmonad --recompile`, symlink your real `stack.yaml` into the xmonad +configuration directory, or [use a custom build script](#custom-build-script). + #### Install Everything Installing things is as easy as typing `stack install`. This will @@ -199,37 +205,6 @@ If you're getting build failures while building the `X11` package it may be that you don't have the required C libraries installed. See [above](#dependencies). -#### Tell XMonad How to Recompile Itself - -In order to tell xmonad to invoke `stack build` when we issue `xmonad ---recompile` (bound to `M-q` by default), we need to create a so-called -`build` file. This is quite literally just a shell script called -`build` in your xmonad directory (which is `~/.config/xmonad` for us) -that tells xmonad how it should build its executable. - -A good starting point (this is essentially [what xmonad would do] -without a build file, with the exception that we are invoking `stack -ghc` instead of plain `ghc`) would be - -``` shell -#!/bin/sh - -exec stack ghc -- \ - --make xmonad.hs \ - -i \ - -ilib \ - -fforce-recomp \ - -main-is main \ - -v0 \ - -o "$1" -``` - -Don't forget to mark the file as `+x`: `chmod +x build`! - -And that's it! Recompilation should work normally now, though you will -potentially need to restart your computer, or at least the running X -session, first. - ### Build using cabal-install #### Install cabal-install @@ -340,7 +315,35 @@ provides one. * * [FAQ: How can I use xmonad with a display manager? (xdm, kdm, gdm)](https://wiki.haskell.org/Xmonad/Frequently_asked_questions#How_can_I_use_xmonad_with_a_display_manager.3F_.28xdm.2C_kdm.2C_gdm.29) -## Don't Recompile on Every Startup +## Custom Build Script + +If you need to customize what happens during `xmonad --recompile` (bound to +`M-q` by default), perhaps because your xmonad configuration is a whole +separate Haskell package, you need to create a so-called `build` file. This +is quite literally just a shell script called `build` in your xmonad directory +(which is `~/.config/xmonad` for us) that tells xmonad how it should build its +executable. + +A good starting point (this is essentially [what xmonad would do][] +without a build file, with the exception that we are invoking `stack +ghc` instead of plain `ghc`) would be + +``` shell +#!/bin/sh + +exec stack ghc -- \ + --make xmonad.hs \ + -i \ + -ilib \ + -fforce-recomp \ + -main-is main \ + -v0 \ + -o "$1" +``` + +Don't forget to mark the file as `+x`: `chmod +x build`! + +#### Don't Recompile on Every Startup By default, xmonad always recompiles itself when a build script is used (because the build script could contain arbitrary code, so a simple @@ -356,18 +359,18 @@ exec xmonad in your `~/.xinitrc`, you would write ``` shell -exec $HOME/.local/share/xmonad/xmonad-x86_64-linux +exec $HOME/.cache/xmonad/xmonad-x86_64-linux ``` -The `~/.local/share` prefix is the `$XDG_DATA_DIR` directory. Note that +The `~/.cache` prefix is the `$XDG_CACHE_HOME` directory. Note that if your xmonad configuration resides within `~/.xmonad`, then the executable will also be within that directory and not in -`$XDG_DATA_DIR`. +`$XDG_CACHE_HOME`. [XDG]: https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html [git]: https://git-scm.com/ [stack]: https://docs.haskellstack.org/en/stable/README/ [cabal-install]: https://www.haskell.org/cabal/ [ghcup]: https://www.haskell.org/ghcup/ -[what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L657-L665 +[what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667 [Hackage]: https://hackage.haskell.org/ diff --git a/man/xmonad.hs b/man/xmonad.hs index 57c8b46..e63d91a 100644 --- a/man/xmonad.hs +++ b/man/xmonad.hs @@ -129,7 +129,7 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $ , ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart") -- Run xmessage with a summary of the default keybindings (useful for beginners) - , ((modm .|. shiftMask, xK_slash ), spawn ("printf " ++ show help ++ " | xmessage -file -")) + , ((modm .|. shiftMask, xK_slash ), xmessage help) ] ++ diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs index 8d50092..a450fbc 100644 --- a/src/XMonad/Config.hs +++ b/src/XMonad/Config.hs @@ -239,7 +239,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $ , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] where helpCommand :: X () - helpCommand = spawn ("printf " ++ show help ++ " | xmessage -file -") + helpCommand = xmessage help -- | Mouse bindings: default actions bound to mouse events mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 9c7a280..11bd353 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -26,8 +26,8 @@ module XMonad.Core ( StateExtension(..), ExtensionClass(..), ConfExtension(..), runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, - getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX, - getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, + getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, + getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes, ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories, ) where @@ -35,7 +35,7 @@ module XMonad.Core ( import XMonad.StackSet hiding (modify) import Prelude -import Control.Exception (fromException, try, bracket, throw, finally, SomeException(..)) +import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..)) import qualified Control.Exception as E import Control.Applicative ((<|>), empty) import Control.Monad.Fail @@ -43,7 +43,9 @@ import Control.Monad.State import Control.Monad.Reader import Data.Semigroup import Data.Traversable (for) +import Data.Time.Clock (UTCTime) import Data.Default.Class +import Data.List (isInfixOf) import System.FilePath import System.IO import System.Info @@ -54,6 +56,7 @@ import System.Posix.IO import System.Posix.Types (ProcessID) import System.Process import System.Directory +import System.Environment (setEnv) import System.Exit import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event) @@ -453,6 +456,17 @@ xfork x = io . forkProcess . finally nullStdin $ do dupTo fd stdInput closeFd fd +-- | Use @xmessage@ to show information to the user. +xmessage :: MonadIO m => String -> m () +xmessage msg = void . xfork $ do + setEnv "LC_ALL" "C.UTF-8" + executeFile "xmessage" True + [ "-default", "okay" + , "-xrm", "*international:true" + , "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*" + , msg + ] Nothing + -- | This is basically a map function, running a function in the 'X' monad on -- each workspace with the output of that function being the modified workspace. runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X () @@ -467,8 +481,7 @@ runOnWorkspaces job = do -- the following purposes: -- -- * @dataDir@: This directory is used by XMonad to store data files --- such as the run-time state file and the configuration binary --- generated by GHC. +-- such as the run-time state file. -- -- * @cfgDir@: This directory is where user configuration files are -- stored (e.g, the xmonad.hs file). You may also create a @lib@ @@ -476,7 +489,9 @@ runOnWorkspaces job = do -- command will add it to the GHC include path. -- -- * @cacheDir@: This directory is used to store temporary files that --- can easily be recreated. For example, the XPrompt history file. +-- can easily be recreated such as the configuration binary and any +-- intermediate object files generated by GHC. +-- Also, the XPrompt history file goes here. -- -- For how these directories are chosen, see 'getDirectories'. -- @@ -513,9 +528,9 @@ getDirectories = xmEnvDirs <|> xmDirs <|> xdgDirs xmEnvDirs :: IO Directories xmEnvDirs = do let xmEnvs = Directories{ dataDir = "XMONAD_DATA_DIR" - , cfgDir = "XMONAD_CONFIG_DIR" - , cacheDir = "XMONAD_CACHE_DIR" - } + , cfgDir = "XMONAD_CONFIG_DIR" + , cacheDir = "XMONAD_CACHE_DIR" + } maybe empty pure . sequenceA =<< traverse getEnv xmEnvs -- | Check whether the config file or a build script is in the @@ -552,19 +567,164 @@ getXMonadDataDir :: X String getXMonadDataDir = asks (dataDir . directories) {-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-} --- | Get the name of the file used to store the xmonad window state. -stateFileName :: X FilePath -stateFileName = ( "xmonad.state") <$> getXMonadDataDir +binFileName, buildDirName :: Directories -> FilePath +binFileName Directories{ cacheDir } = cacheDir "xmonad-" <> arch <> "-" <> os +buildDirName Directories{ cacheDir } = cacheDir "build-" <> arch <> "-" <> os --- | 'recompile force', recompile the xmonad configuration file when --- any of the following apply: +errFileName, stateFileName :: Directories -> FilePath +errFileName Directories{ dataDir } = dataDir "xmonad.errors" +stateFileName Directories{ dataDir } = dataDir "xmonad.state" + +srcFileName, libFileName :: Directories -> FilePath +srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" +libFileName Directories{ cfgDir } = cfgDir "lib" + +buildScriptFileName, stackYamlFileName :: Directories -> FilePath +buildScriptFileName Directories{ cfgDir } = cfgDir "build" +stackYamlFileName Directories{ cfgDir } = cfgDir "stack.yaml" + +-- | Compilation method for xmonad configuration. +data Compile = CompileGhc | CompileStackGhc FilePath | CompileScript FilePath + deriving (Show) + +-- | Detect compilation method by looking for known file names in xmonad +-- configuration directory. +detectCompile :: Directories -> IO Compile +detectCompile dirs = tryScript <|> tryStack <|> useGhc + where + buildScript = buildScriptFileName dirs + stackYaml = stackYamlFileName dirs + + tryScript = do + guard =<< doesFileExist buildScript + isExe <- isExecutable buildScript + if isExe + then do + trace $ "XMonad will use build script at " <> show buildScript <> " to recompile." + pure $ CompileScript buildScript + else do + trace $ "XMonad will not use build script, because " <> show buildScript <> " is not executable." + trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript + empty + + tryStack = do + guard =<< doesFileExist stackYaml + canonStackYaml <- canonicalizePath stackYaml + trace $ "XMonad will use stack ghc --stack-yaml " <> show canonStackYaml <> " to recompile." + pure $ CompileStackGhc canonStackYaml + + useGhc = do + trace $ "XMonad will use ghc to recompile, because neither " + <> show buildScript <> " nor " <> show stackYaml <> " exists." + pure CompileGhc + + isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False) + +-- | Should we recompile xmonad configuration? Is it newer than the compiled +-- binary? +shouldCompile :: Directories -> Compile -> IO Bool +shouldCompile dirs CompileGhc = do + libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles (libFileName dirs) + srcT <- getModTime (srcFileName dirs) + binT <- getModTime (binFileName dirs) + if any (binT <) (srcT : libTs) + then True <$ trace "XMonad recompiling because some files have changed." + else False <$ trace "XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed." + where + isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension + allFiles t = do + let prep = map (t) . Prelude.filter (`notElem` [".",".."]) + cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return []) + ds <- filterM doesDirectoryExist cs + concat . ((cs \\ ds):) <$> mapM allFiles ds +shouldCompile dirs CompileStackGhc{} = do + stackYamlT <- getModTime (stackYamlFileName dirs) + binT <- getModTime (binFileName dirs) + if binT < stackYamlT + then True <$ trace "XMonad recompiling because some files have changed." + else shouldCompile dirs CompileGhc +shouldCompile _dirs CompileScript{} = + True <$ trace "XMonad recompiling because a custom build script is being used." + +getModTime :: FilePath -> IO (Maybe UTCTime) +getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) + +-- | Compile the configuration. +compile :: Directories -> Compile -> IO ExitCode +compile dirs method = + bracket_ uninstallSignalHandlers installSignalHandlers $ + bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do + let run = runProc (cfgDir dirs) err + case method of + CompileGhc -> + run "ghc" ghcArgs + CompileStackGhc stackYaml -> + run "stack" ["build", "--silent"] .&&. + run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs) + CompileScript script -> + run script [binFileName dirs] + where + ghcArgs = [ "--make" + , "xmonad.hs" + , "-i" -- only look in @lib@ + , "-ilib" + , "-fforce-recomp" + , "-main-is", "main" + , "-v0" + , "-outputdir", buildDirName dirs + , "-o", binFileName dirs + ] + + -- waitForProcess =<< System.Process.runProcess, but without closing the err handle + runProc cwd err exe args = do + hPutStrLn err $ unwords $ "$" : exe : args + hFlush err + (_, _, _, h) <- createProcess_ "runProc" (proc exe args){ cwd = Just cwd, std_err = UseHandle err } + waitForProcess h + + cmd1 .&&. cmd2 = cmd1 >>= \case + ExitSuccess -> cmd2 + e -> pure e + +-- | Check GHC output for deprecation warnings and notify the user if there +-- were any. Report success otherwise. +checkCompileWarnings :: Directories -> IO () +checkCompileWarnings dirs = do + ghcErr <- readFile (errFileName dirs) + if "-Wdeprecations" `isInfixOf` ghcErr + then do + let msg = unlines $ + ["Deprecations detected while compiling xmonad config: " <> srcFileName dirs] + ++ lines ghcErr + ++ ["","Please correct them or silence using {-# OPTIONS_GHC -Wno-deprecations #-}."] + trace msg + xmessage msg + else + trace "XMonad recompilation process exited with success!" + +-- | Notify the user that compilation failed and what was wrong. +compileFailed :: Directories -> ExitCode -> IO () +compileFailed dirs status = do + ghcErr <- readFile (errFileName dirs) + let msg = unlines $ + ["Errors detected while compiling xmonad config: " <> srcFileName dirs] + ++ lines (if null ghcErr then show status else ghcErr) + ++ ["","Please check the file for errors."] + -- nb, the ordering of printing, then forking, is crucial due to + -- lazy evaluation + trace msg + xmessage msg + +-- | Recompile the xmonad configuration file when any of the following apply: -- --- * force is 'True' +-- * force is 'True' -- --- * the xmonad executable does not exist +-- * the xmonad executable does not exist -- --- * the xmonad executable is older than xmonad.hs or any file in --- the @lib@ directory (under the configuration directory). +-- * the xmonad executable is older than @xmonad.hs@ or any file in +-- the @lib@ directory (under the configuration directory) +-- +-- * custom @build@ script is being used -- -- The -i flag is used to restrict recompilation to the xmonad.hs file only, -- and any files in the aforementioned @lib@ directory. @@ -576,103 +736,20 @@ stateFileName = ( "xmonad.state") <$> getXMonadDataDir -- 'False' is returned if there are compilation errors. -- recompile :: MonadIO m => Directories -> Bool -> m Bool -recompile Directories{ cfgDir, dataDir } force = io $ do - let binn = "xmonad-"++arch++"-"++os - bin = dataDir binn - err = dataDir "xmonad.errors" - src = cfgDir "xmonad.hs" - lib = cfgDir "lib" - buildscript = cfgDir "build" - - libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib - srcT <- getModTime src - binT <- getModTime bin - - useBuildscript <- do - exists <- doesFileExist buildscript - if exists - then do - isExe <- isExecutable buildscript - if isExe - then do - trace $ "XMonad will use build script at " ++ show buildscript ++ " to recompile." - return True - else do - trace $ unlines - [ "XMonad will not use build script, because " ++ show buildscript ++ " is not executable." - , "Suggested resolution to use it: chmod u+x " ++ show buildscript - ] - return False - else do - trace $ - "XMonad will use ghc to recompile, because " ++ show buildscript ++ " does not exist." - return False - - shouldRecompile <- - if useBuildscript || force - then return True - else if any (binT <) (srcT : libTs) - then do - trace "XMonad doing recompile because some files have changed." - return True - else do - trace "XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed." - return False - - if shouldRecompile +recompile dirs force = io $ do + method <- detectCompile dirs + willCompile <- if force + then True <$ trace "XMonad recompiling (forced)." + else shouldCompile dirs method + if willCompile then do - -- temporarily disable SIGCHLD ignoring: - uninstallSignalHandlers - status <- bracket (openFile err WriteMode) hClose $ \errHandle -> - waitForProcess =<< if useBuildscript - then compileScript bin cfgDir buildscript errHandle - else compileGHC bin cfgDir errHandle - - -- re-enable SIGCHLD: - installSignalHandlers - - -- now, if it fails, run xmessage to let the user know: + status <- compile dirs method if status == ExitSuccess - then trace "XMonad recompilation process exited with success!" - else do - ghcErr <- readFile err - let msg = unlines $ - ["Error detected while loading xmonad configuration file: " ++ src] - ++ lines (if null ghcErr then show status else ghcErr) - ++ ["","Please check the file for errors."] - -- nb, the ordering of printing, then forking, is crucial due to - -- lazy evaluation - hPutStrLn stderr msg - forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing - return () - return (status == ExitSuccess) - else return True - where getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) - isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension - isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False) - allFiles t = do - let prep = map (t) . Prelude.filter (`notElem` [".",".."]) - cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return []) - ds <- filterM doesDirectoryExist cs - concat . ((cs \\ ds):) <$> mapM allFiles ds - -- Replace some of the unicode symbols GHC uses in its output - replaceUnicode = map $ \c -> case c of - '\8226' -> '*' -- • - '\8216' -> '`' -- ‘ - '\8217' -> '`' -- ’ - _ -> c - compileGHC bin dir errHandle = - runProcess "ghc" ["--make" - , "xmonad.hs" - , "-i" - , "-ilib" - , "-fforce-recomp" - , "-main-is", "main" - , "-v0" - , "-o", bin - ] (Just dir) Nothing Nothing Nothing (Just errHandle) - compileScript bin dir script errHandle = - runProcess script [bin] (Just dir) Nothing Nothing Nothing (Just errHandle) + then checkCompileWarnings dirs + else compileFailed dirs status + pure $ status == ExitSuccess + else + pure True -- | Conditionally run an action, using a @Maybe a@ to decide. whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs index 117c17e..75a388d 100644 --- a/src/XMonad/Main.hs +++ b/src/XMonad/Main.hs @@ -113,9 +113,10 @@ usage = do -- * Missing XMonad\/XMonadContrib modules due to ghc upgrade -- buildLaunch :: Directories -> IO () -buildLaunch dirs@Directories{ dataDir } = do +buildLaunch dirs = do whoami <- getProgName - let compiledConfig = "xmonad-"++arch++"-"++os + let bin = binFileName dirs + let compiledConfig = takeFileName bin unless (whoami == compiledConfig) $ do trace $ concat [ "XMonad is recompiling and replacing itself with another XMonad process because the current process is called " @@ -125,7 +126,7 @@ buildLaunch dirs@Directories{ dataDir } = do ] recompile dirs False args <- getArgs - executeFile (dataDir compiledConfig) False args Nothing + executeFile bin False args Nothing sendRestart :: IO () sendRestart = do @@ -233,7 +234,7 @@ launch initxmc drs = do runX cf st $ do -- check for serialized state in a file. serializedSt <- do - path <- stateFileName + path <- asks $ stateFileName . directories exists <- io (doesFileExist path) if exists then readStateFile initxmc else return Nothing diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs index d30246a..f87330a 100644 --- a/src/XMonad/Operations.hs +++ b/src/XMonad/Operations.hs @@ -480,7 +480,7 @@ writeStateToFile = do wsData = W.mapLayout show . windowset extState = catMaybes . map maybeShow . M.toList . extensibleState - path <- stateFileName + path <- asks $ stateFileName . directories stateData <- gets (\s -> StateFile (wsData s) (extState s)) catchIO (writeFile path $ show stateData) @@ -488,7 +488,7 @@ writeStateToFile = do -- return that state. The state file is removed after reading it. readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState) readStateFile xmc = do - path <- stateFileName + path <- asks $ stateFileName . directories -- I'm trying really hard here to make sure we read the entire -- contents of the file before it is removed from the file system. diff --git a/xmonad.cabal b/xmonad.cabal index 76fce23..c7778ee 100644 --- a/xmonad.cabal +++ b/xmonad.cabal @@ -1,5 +1,5 @@ name: xmonad -version: 0.16.9999 +version: 0.16.99999 synopsis: A tiling window manager description: xmonad is a tiling window manager for X. Windows are arranged automatically to tile the screen without gaps or overlap, maximising @@ -78,6 +78,7 @@ library , mtl , process , setlocale + , time , transformers >= 0.3 , unix ghc-options: -funbox-strict-fields -Wall -Wno-unused-do-bind