mirror of
https://github.com/xmonad/xmonad.git
synced 2025-07-25 17:21:52 -07:00
Merge pull request #318 from liskin/stack-recompile
Recompilation overhaul: stack.yaml detection, deprecation warnings
This commit is contained in:
12
CHANGES.md
12
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
|
||||
|
77
INSTALL.md
77
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)
|
||||
|
||||
<!--TOC-->
|
||||
|
||||
@@ -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.
|
||||
* <https://xmonad.org/documentation.html#in-your-environment>
|
||||
* [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/
|
||||
|
@@ -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)
|
||||
]
|
||||
++
|
||||
|
||||
|
@@ -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 ())
|
||||
|
@@ -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 ()
|
||||
|
@@ -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
|
||||
|
||||
|
@@ -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.
|
||||
|
@@ -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
|
||||
|
Reference in New Issue
Block a user