Merge pull request #330 from colonelpanic8/nixRecompilationSupport

Add nix recompilation support

CHANGES.md

@@ -18,6 +18,9 @@
   will snap to these hints as soon as they're floated (mouse move, keybinding).
   Previously that only happened on mouse resize.
 
+* Recompilation now detects `flake.nix` and `default.nix` (can be a
+  symlink) and switches to using `nix build` as appropriate.
+
 ### Bug Fixes
 
 * Duplicated floats (e.g. from X.A.CopyToAll) no longer escape to inactive

src/XMonad/Core.hs

@@ -33,7 +33,7 @@ module XMonad.Core (
     StateExtension(..), ExtensionClass(..), ConfExtension(..),
     runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
     withDisplay, withWindowSet, isRoot, runOnWorkspaces,
-    getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX,
+    getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM,
     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,
@@ -55,6 +55,7 @@ import Data.Traversable (for)
 import Data.Time.Clock (UTCTime)
 import Data.Default.Class
 import System.Environment (lookupEnv)
+import Data.List (isInfixOf, intercalate, (\\))
 import System.FilePath
 import System.IO
 import System.Info
@@ -69,7 +70,6 @@ import System.Exit
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
 import Data.Typeable
-import Data.List (isInfixOf, (\\))
 import Data.Maybe (isJust,fromMaybe)
 import Data.Monoid (Ap(..))
 
@@ -415,9 +415,13 @@ data StateExtension =
 data ConfExtension = forall a. Typeable a => ConfExtension a
 
 -- ---------------------------------------------------------------------
--- | General utilities
+-- General utilities
---
+
--- Lift an 'IO' action into the 'X' monad
+-- | If-then-else lifted to a 'Monad'.
+ifM :: Monad m => m Bool -> m a -> m a -> m a
+ifM mb t f = mb >>= \b -> if b then t else f
+
+-- | Lift an 'IO' action into the 'X' monad
 io :: MonadIO m => IO a -> m a
 io = liftIO
 
@@ -576,21 +580,31 @@ srcFileName, libFileName :: Directories -> FilePath
 srcFileName Directories{ cfgDir } = cfgDir </> "xmonad.hs"
 libFileName Directories{ cfgDir } = cfgDir </> "lib"
 
-buildScriptFileName, stackYamlFileName :: Directories -> FilePath
+buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath
 buildScriptFileName Directories{ cfgDir } = cfgDir </> "build"
 stackYamlFileName   Directories{ cfgDir } = cfgDir </> "stack.yaml"
+nixFlakeFileName    Directories{ cfgDir } = cfgDir </> "flake.nix"
+nixDefaultFileName  Directories{ cfgDir } = cfgDir </> "default.nix"
 
 -- | Compilation method for xmonad configuration.
-data Compile = CompileGhc | CompileStackGhc FilePath | CompileScript FilePath
+data Compile
+  = CompileGhc
+  | CompileStackGhc FilePath
+  | CompileNixFlake
+  | CompileNixDefault
+  | 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
+detectCompile dirs =
+  tryScript <|> tryStack <|> tryNixFlake <|> tryNixDefault <|> useGhc
   where
     buildScript = buildScriptFileName dirs
     stackYaml = stackYamlFileName dirs
+    flakeNix = nixFlakeFileName dirs
+    defaultNix = nixDefaultFileName dirs
 
     tryScript = do
         guard =<< doesFileExist buildScript
@@ -604,6 +618,18 @@ detectCompile dirs = tryScript <|> tryStack <|> useGhc
             trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript
             empty
 
+    tryNixFlake = do
+      guard =<< doesFileExist flakeNix
+      canonNixFlake <- canonicalizePath flakeNix
+      trace $ "XMonad will use nix flake at " <> show canonNixFlake <> " to recompile"
+      pure CompileNixFlake
+
+    tryNixDefault = do
+      guard =<< doesFileExist defaultNix
+      canonNixDefault <- canonicalizePath defaultNix
+      trace $ "XMonad will use nix file at " <> show canonNixDefault <> " to recompile"
+      pure CompileNixDefault
+
     tryStack = do
         guard =<< doesFileExist stackYaml
         canonStackYaml <- canonicalizePath stackYaml
@@ -611,11 +637,18 @@ detectCompile dirs = tryScript <|> tryStack <|> useGhc
         pure $ CompileStackGhc canonStackYaml
 
     useGhc = do
-        trace $ "XMonad will use ghc to recompile, because neither "
+        trace $ "XMonad will use ghc to recompile, because none of "
-                <> show buildScript <> " nor " <> show stackYaml <> " exists."
+                <> intercalate ", "
+                     [ show buildScript
+                     , show stackYaml
+                     , show flakeNix
+                     , show defaultNix
+                     ] <> " exist."
         pure CompileGhc
 
-    isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
+-- | Determine whether or not the file found at the provided filepath is executable.
+isExecutable :: FilePath -> IO Bool
+isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
 
 -- | Should we recompile xmonad configuration? Is it newer than the compiled
 -- binary?
@@ -640,6 +673,8 @@ shouldCompile dirs CompileStackGhc{} = do
     if binT < stackYamlT
         then True <$ trace "XMonad recompiling because some files have changed."
         else shouldCompile dirs CompileGhc
+shouldCompile _dirs CompileNixFlake{} = True <$ trace "XMonad recompiling because flake recompilation is being used."
+shouldCompile _dirs CompileNixDefault{} = True <$ trace "XMonad recompiling because nix recompilation is being used."
 shouldCompile _dirs CompileScript{} =
     True <$ trace "XMonad recompiling because a custom build script is being used."
 
@@ -659,6 +694,10 @@ compile dirs method =
                 CompileStackGhc stackYaml ->
                     run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
                     run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)
+                CompileNixFlake ->
+                    run "nix" ["build"] >>= andCopyFromResultDir
+                CompileNixDefault ->
+                    run "nix-build" [] >>= andCopyFromResultDir
                 CompileScript script ->
                     run script [binFileName dirs]
   where
@@ -672,6 +711,18 @@ compile dirs method =
               , "-outputdir", buildDirName dirs
               , "-o", binFileName dirs
               ]
+    andCopyFromResultDir exitCode = do
+      if exitCode == ExitSuccess then copyFromResultDir else return exitCode
+    findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
+    catchAny :: IO a -> (SomeException -> IO a) -> IO a
+    catchAny = E.catch
+    copyFromResultDir = do
+      let binaryDirectory = cfgDir dirs </> "result" </> "bin"
+      binFiles <- map (binaryDirectory </>) <$> catchAny (listDirectory binaryDirectory) (\_ -> return [])
+      mfilepath <- findM isExecutable binFiles
+      case mfilepath of
+        Just filepath -> copyFile filepath (binFileName dirs) >> return ExitSuccess
+        Nothing -> return $ ExitFailure 1
 
     -- waitForProcess =<< System.Process.runProcess, but without closing the err handle
     runProc cwd err exe args = do

src/XMonad/ManageHook.hs

@@ -64,10 +64,6 @@ x <&&> y = ifM x y (pure False)
 (<||>) :: Monad m => m Bool -> m Bool -> m Bool
 x <||> y = ifM x (pure True) y
 
--- | If-then-else lifted to a 'Monad'.
-ifM :: Monad m => m Bool -> m a -> m a -> m a
-ifM mb t f = mb >>= \b -> if b then t else f
-
 -- | Return the window title.
 title :: Query String
 title = ask >>= \w -> liftX $ do