Merge pull request #318 from liskin/stack-recompile

Recompilation overhaul: stack.yaml detection, deprecation warnings
This commit is contained in:
Tomáš Janoušek
2021-08-17 10:55:38 +01:00
committed by GitHub
8 changed files with 253 additions and 159 deletions

View File

@@ -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

View File

@@ -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/

View File

@@ -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)
]
++

View File

@@ -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 ())

View File

@@ -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 ()

View File

@@ -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

View File

@@ -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.

View File

@@ -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