From 3b6d00ba91ac7222e0f2fddb289829db2ef19255 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 18:02:08 +0100 Subject: [PATCH 1/9] Refactor 'recompile' to be less of a spaghetti-code This is a preparation for autodetecting stack.yaml and using stack for recompilation. Related: https://github.com/xmonad/xmonad/issues/310 --- src/XMonad/Core.hs | 225 +++++++++++++++++++++------------------ src/XMonad/Main.hs | 9 +- src/XMonad/Operations.hs | 4 +- 3 files changed, 127 insertions(+), 111 deletions(-) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 9c7a280..09e97e3 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -27,7 +27,7 @@ module XMonad.Core ( runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, withDisplay, withWindowSet, isRoot, runOnWorkspaces, getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX, - getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, + 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 @@ -552,19 +552,117 @@ 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, errFileName, stateFileName, srcFileName, libFileName :: Directories -> FilePath +binFileName Directories{ dataDir } = dataDir "xmonad-" <> arch <> "-" <> os +errFileName Directories{ dataDir } = dataDir "xmonad.errors" +stateFileName Directories{ dataDir } = dataDir "xmonad.state" +srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" +libFileName Directories{ cfgDir } = cfgDir "lib" --- | 'recompile force', recompile the xmonad configuration file when --- any of the following apply: +buildScriptFileName :: Directories -> FilePath +buildScriptFileName Directories{ cfgDir } = cfgDir "build" + +-- | Compilation method for xmonad configuration. +data Compile = CompileGhc | CompileScript FilePath + deriving (Show) + +-- | Detect compilation method by looking for known file names in xmonad +-- configuration directory. +detectCompile :: Directories -> IO Compile +detectCompile dirs = tryScript <|> useGhc + where + buildScript = buildScriptFileName 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 + + useGhc = do + trace $ "XMonad will use ghc to recompile, because " <> show buildScript <> " does not exist." + 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 CompileScript{} = + True <$ trace "XMonad recompiling because a custom build script is being used." +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 + getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) + 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 + +-- | Compile the configuration. +compile :: Directories -> Compile -> IO ExitCode +compile dirs method = + bracket_ uninstallSignalHandlers installSignalHandlers $ + bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> + waitForProcess =<< runProcess exe args (Just (cfgDir dirs)) Nothing Nothing Nothing (Just err) + where + (exe, args) = case method of + CompileScript script -> + (script, [binFileName dirs]) + CompileGhc -> + ("ghc", [ "--make" + , "xmonad.hs" + , "-i" -- only look in @lib@ + , "-ilib" + , "-fforce-recomp" + , "-main-is", "main" + , "-v0" + , "-o", binFileName dirs + ]) + +-- | 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 + void $ forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing + where + -- Replace some of the unicode symbols GHC uses in its output + replaceUnicode = map $ \c -> case c of + '\8226' -> '*' -- • + '\8216' -> '`' -- ‘ + '\8217' -> '`' -- ’ + _ -> c + +-- | 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 +674,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) + 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. From aa35ea1856839a01ab29f505c8b7266c0fc3b8b4 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 21:37:50 +0100 Subject: [PATCH 2/9] Make xmessage handle UTF-8 and export it This unfortunately breaks xmonad-contrib as several modules define their own `xmessage` function. Related: https://github.com/xmonad/xmonad/pull/309 --- man/xmonad.hs | 2 +- src/XMonad/Config.hs | 2 +- src/XMonad/Core.hs | 23 ++++++++++++++--------- xmonad.cabal | 2 +- 4 files changed, 17 insertions(+), 12 deletions(-) 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 09e97e3..57d9a66 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -26,7 +26,7 @@ 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, + 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, @@ -54,6 +54,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 +454,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 () @@ -644,14 +656,7 @@ compileFailed dirs status = do -- nb, the ordering of printing, then forking, is crucial due to -- lazy evaluation trace msg - void $ forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing - where - -- Replace some of the unicode symbols GHC uses in its output - replaceUnicode = map $ \c -> case c of - '\8226' -> '*' -- • - '\8216' -> '`' -- ‘ - '\8217' -> '`' -- ’ - _ -> c + xmessage msg -- | Recompile the xmonad configuration file when any of the following apply: -- diff --git a/xmonad.cabal b/xmonad.cabal index 76fce23..53d2bec 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 From 403e4df6245e08c64c5db2d538dd674c1d80d95d Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 22:30:21 +0100 Subject: [PATCH 3/9] Use "stack ghc" for recompilation when stack.yaml exists This makes it unnecessary for users of Stack to use a custom build script, making installation easier. Inspired by a similar feature in dyre: https://github.com/willdonnelly/dyre/commit/a04be85f60cda39b3d57cebb74a25e9508b58160 Fixes: https://github.com/xmonad/xmonad/issues/310 --- src/XMonad/Core.hs | 75 ++++++++++++++++++++++++++++++++-------------- xmonad.cabal | 1 + 2 files changed, 54 insertions(+), 22 deletions(-) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 57d9a66..08b3dce 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -43,6 +43,7 @@ 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 System.FilePath import System.IO @@ -571,19 +572,21 @@ stateFileName Directories{ dataDir } = dataDir "xmonad.state" srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" libFileName Directories{ cfgDir } = cfgDir "lib" -buildScriptFileName :: Directories -> FilePath +buildScriptFileName, stackYamlFileName :: Directories -> FilePath buildScriptFileName Directories{ cfgDir } = cfgDir "build" +stackYamlFileName Directories{ cfgDir } = cfgDir "stack.yaml" -- | Compilation method for xmonad configuration. -data Compile = CompileGhc | CompileScript FilePath +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 <|> useGhc +detectCompile dirs = tryScript <|> tryStack <|> useGhc where buildScript = buildScriptFileName dirs + stackYaml = stackYamlFileName dirs tryScript = do guard =<< doesFileExist buildScript @@ -597,8 +600,15 @@ detectCompile dirs = tryScript <|> useGhc 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 " <> show buildScript <> " does not exist." + 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) @@ -606,8 +616,6 @@ detectCompile dirs = tryScript <|> useGhc -- | Should we recompile xmonad configuration? Is it newer than the compiled -- binary? shouldCompile :: Directories -> Compile -> IO Bool -shouldCompile _dirs CompileScript{} = - True <$ trace "XMonad recompiling because a custom build script is being used." shouldCompile dirs CompileGhc = do libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles (libFileName dirs) srcT <- getModTime (srcFileName dirs) @@ -616,34 +624,57 @@ shouldCompile dirs CompileGhc = do 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 - getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) 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 -> - waitForProcess =<< runProcess exe args (Just (cfgDir dirs)) Nothing Nothing Nothing (Just err) + 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 - (exe, args) = case method of - CompileScript script -> - (script, [binFileName dirs]) - CompileGhc -> - ("ghc", [ "--make" - , "xmonad.hs" - , "-i" -- only look in @lib@ - , "-ilib" - , "-fforce-recomp" - , "-main-is", "main" - , "-v0" - , "-o", binFileName dirs - ]) + ghcArgs = [ "--make" + , "xmonad.hs" + , "-i" -- only look in @lib@ + , "-ilib" + , "-fforce-recomp" + , "-main-is", "main" + , "-v0" + , "-o", binFileName dirs + ] + + -- waitForProcess =<< System.Process.runProcess, but without closing the err handle + runProc cwd err exe args = do + (_, _, _, h) <- createProcess_ "runProc" (proc exe args){ cwd = Just cwd, std_err = UseHandle err } + waitForProcess h + + cmd1 .&&. cmd2 = cmd1 >>= \case + ExitSuccess -> cmd2 + e -> pure e -- | Notify the user that compilation failed and what was wrong. compileFailed :: Directories -> ExitCode -> IO () diff --git a/xmonad.cabal b/xmonad.cabal index 53d2bec..c7778ee 100644 --- a/xmonad.cabal +++ b/xmonad.cabal @@ -78,6 +78,7 @@ library , mtl , process , setlocale + , time , transformers >= 0.3 , unix ghc-options: -funbox-strict-fields -Wall -Wno-unused-do-bind From 9813e218b034009b0b6d09a70650178980e05d54 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 22:45:14 +0100 Subject: [PATCH 4/9] Move config binary and GHC intermediate outputs to cacheDir That's where they belong. As XDG was more or less broken in previous xmonad releases, we can assume few people use it so now's the best time to move files around. For users of `~/.xmonad`, this only causes intermediate outputs (.o, .hi) to go elsewhere. Fixes: https://github.com/xmonad/xmonad/issues/178 --- CHANGES.md | 4 ++++ INSTALL.md | 6 +++--- src/XMonad/Core.hs | 21 ++++++++++++++------- 3 files changed, 21 insertions(+), 10 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index e06e66b..9d4689c 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. diff --git a/INSTALL.md b/INSTALL.md index 83e8c6b..a8dac86 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -356,13 +356,13 @@ 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/ diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 08b3dce..86f0a1a 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -480,8 +480,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@ @@ -489,7 +488,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'. -- @@ -565,12 +566,17 @@ getXMonadDataDir :: X String getXMonadDataDir = asks (dataDir . directories) {-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-} -binFileName, errFileName, stateFileName, srcFileName, libFileName :: Directories -> FilePath -binFileName Directories{ dataDir } = dataDir "xmonad-" <> arch <> "-" <> os +binFileName, buildDirName :: Directories -> FilePath +binFileName Directories{ cacheDir } = cacheDir "xmonad-" <> arch <> "-" <> os +buildDirName Directories{ cacheDir } = cacheDir "build-" <> arch <> "-" <> os + +errFileName, stateFileName :: Directories -> FilePath errFileName Directories{ dataDir } = dataDir "xmonad.errors" stateFileName Directories{ dataDir } = dataDir "xmonad.state" -srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" -libFileName Directories{ cfgDir } = cfgDir "lib" + +srcFileName, libFileName :: Directories -> FilePath +srcFileName Directories{ cfgDir } = cfgDir "xmonad.hs" +libFileName Directories{ cfgDir } = cfgDir "lib" buildScriptFileName, stackYamlFileName :: Directories -> FilePath buildScriptFileName Directories{ cfgDir } = cfgDir "build" @@ -664,6 +670,7 @@ compile dirs method = , "-fforce-recomp" , "-main-is", "main" , "-v0" + , "-outputdir", buildDirName dirs , "-o", binFileName dirs ] From 1f8e5b43e19533c6c1e4356a1ca9bb04499ee79d Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 22:53:23 +0100 Subject: [PATCH 5/9] Fix indent in getDirectories Fixes: 90101613e76d ("Unclobber dirs/Dirs in import XMonad") --- src/XMonad/Core.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 86f0a1a..e702a86 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -527,9 +527,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 From 8aa0d4a3e0556d6e897e381cbfba9a6d5c33d9c7 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 23:43:32 +0100 Subject: [PATCH 6/9] Detect deprecation warnings during recompilation and warn the user Deprecation warnings were suppressed during recompilation, which made it difficult to improve things in the codebase and API as users did not (know they) have a transition period to adapt their configuration. See additional discussions about deprecations: - https://github.com/xmonad/xmonad-contrib/pull/404#issuecomment-731607447 - https://github.com/xmonad/xmonad-contrib/pull/410#issuecomment-732841235 Fixes: https://github.com/xmonad/xmonad/issues/304 Related: https://github.com/xmonad/xmonad-contrib/pull/404 Related: https://github.com/xmonad/xmonad-contrib/pull/410 --- src/XMonad/Core.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index e702a86..6652531 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -45,6 +45,7 @@ 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 @@ -683,6 +684,22 @@ compile dirs method = 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 @@ -726,7 +743,7 @@ recompile dirs force = io $ do then do status <- compile dirs method if status == ExitSuccess - then trace "XMonad recompilation process exited with success!" + then checkCompileWarnings dirs else compileFailed dirs status pure $ status == ExitSuccess else From 782ac25b8e56f65eb831f5b88d46d1939f06b8b2 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 23:13:04 +0100 Subject: [PATCH 7/9] INSTALL: Update after stack.yaml autodetection Related: https://github.com/xmonad/xmonad/issues/310 --- INSTALL.md | 71 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 37 insertions(+), 34 deletions(-) diff --git a/INSTALL.md b/INSTALL.md index a8dac86..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 @@ -369,5 +372,5 @@ executable will also be within that directory and not in [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/ From ae97c1f107e6f50cc56c060ddaebfa10e48965b6 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Sat, 7 Aug 2021 23:55:44 +0100 Subject: [PATCH 8/9] CHANGES: Mention recompilation improvements --- CHANGES.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 9d4689c..1d626dc 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -57,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 From 7bdc7ab9dc8cc03833d55b687c488daee5acbdd0 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Tue, 17 Aug 2021 10:42:09 +0100 Subject: [PATCH 9/9] Print the recompilation command into the error file When `stack build --silent` fails, the output is not helpful at all: Errors detected while compiling xmonad config: /home/slot/.config/xmonad/xmonad.hs ExitFailure 1 Please check the file for errors. And even in other circumstances it's helpful to see the command that was executed, as it makes it easy for the user to diagnose what's wrong. --- src/XMonad/Core.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs index 6652531..11bd353 100644 --- a/src/XMonad/Core.hs +++ b/src/XMonad/Core.hs @@ -677,6 +677,8 @@ compile dirs method = -- 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