seito: Add --vim-config

.gitattributes

@@ -1 +1,2 @@
 *.cabal linguist-generated=true
+/vim/test/assets/*.errors linguist-generated=true

.github/workflows/build.yml

@@ -17,6 +17,7 @@ jobs:
     runs-on: ${{ matrix.os }}
 
     strategy:
+      fail-fast: true
       matrix:
         os:
           - ubuntu-latest
@@ -29,7 +30,8 @@ jobs:
           - os: macos-12
             ghc: system
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
+
       - uses: hspec/setup-haskell@v1
         with:
           ghc-version: ${{ matrix.ghc }}
@@ -58,6 +60,23 @@ jobs:
         env:
           HSPEC_OPTIONS: --color
 
+      - run: vim/test/run.vim
+        if: runner.os == 'Linux'
+
+      - run: vim/test/assets/generate.sh
+        if: ${{ runner.os == 'Linux' && matrix.ghc != '9.4' }}
+
+      - run: git diff --exit-code
+
+      - shell: bash
+        run: |
+          untracked=$(git ls-files --others --exclude-standard)
+          if [ -n "$untracked" ]; then
+            echo "Untracked files:"
+            echo "$untracked"
+            exit 1
+          fi
+
   success:
     needs: build
     runs-on: ubuntu-latest
@@ -67,6 +86,6 @@ jobs:
       - run: false
         if: needs.build.result != 'success'
 
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - name: Check for trailing whitespace
-        run: '! git grep -I "\s\+$"'
+        run: "! git grep -nI '[[:blank:]]$' -- . ':!vim/test/assets'"

README.md

@@ -51,13 +51,14 @@ instead:
 
 ### Vim integration
 
-You can use `sensei` to load the result of the last test run into your quickfix
+You can use `seito` to load the results of the last test run into your quickfix
 list by executing `:make` in Vim.
 
-For this to work, you can either create a `Makefile` or set `makeprg` to a
-custom value.
+For this to work, you can choose one out of three options:
 
-(In both cases, `sed` is used to strip ANSI color sequences.)
+1. Create a `Makefile`
+2. Set `makeprg` to a custom value
+3. Use [`sensei.vim`](vim/sensei.vim)
 
 #### Option 1: Create a `Makefile`
 
@@ -78,6 +79,15 @@ Add the following to your Vim configuration (e.g.
 :set makeprg=seito
 ```
 
+#### Option 3: Use `sensei.vim`:
+
+Add the following to your Vim configuration (e.g.
+`~/.vim/after/ftplugin/haskell.vim`):
+
+```vim
+execute 'source ' . system('seito --vim-config')
+```
+
 ### Emacs integration
 
 Similarly, you can use `sensei` to load the result of the last test run into an

driver/XMonad.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE NoOverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ViewPatterns #-}
+module XMonad where
+
+-- import Control.Exception (IOException, try)
+import System.Process
+import System.Posix.Process (getProcessID)
+-- import Data.Maybe (listToMaybe)
+import Data.Functor
+import System.Exit
+import Data.List
+
+import Imports
+
+newtype PID = PID String
+newtype XWindowId = XWindowId String
+newtype Tag = Tag String
+
+instance IsString Tag where
+  fromString = Tag
+
+-- Get the parent PID of a process
+getParentPid :: PID -> IO (Maybe PID)
+getParentPid (PID pid) = readProcessWithExitCode "ps" ["-o", "ppid=", "-p", pid] "" <&> \ case
+  (_, result, _) -> case strip result of
+    "" -> Nothing
+    ppid -> Just (PID ppid)
+
+getWindowIdForPid :: PID -> IO (Maybe XWindowId)
+getWindowIdForPid (PID pid) = do
+  windowIds <- filter (isPrefixOf "0x") . words <$> readProcess "xprop" ["-root", "_NET_CLIENT_LIST"] ""
+  findWindow windowIds
+  where
+    findWindow :: [String] -> IO (Maybe XWindowId)
+    findWindow = \ case
+      [] -> return Nothing
+      wid : rest -> do
+        (_, wmPidOutput, _) <- readProcessWithExitCode "xprop" ["-id", wid, "_NET_WM_PID"] ""
+        case reverse (words wmPidOutput) of
+          wmPid : _ | wmPid == pid -> return (Just $ XWindowId wid)
+          _ -> findWindow rest
+
+findAncestorWindowId :: PID -> IO (Maybe XWindowId)
+findAncestorWindowId pid = do
+  windowId <- getWindowIdForPid pid
+  case windowId of
+    Just wid -> return (Just wid)
+    Nothing -> do
+      parentPid <- getParentPid pid
+      case parentPid of
+        Just ppid -> findAncestorWindowId ppid
+        Nothing -> return Nothing
+
+addTag :: Tag -> XWindowId -> IO ()
+addTag (Tag name) (XWindowId wid) = do
+  result <- readProcess "xprop" ["-id", wid, "_XMONAD_TAGS"] ""
+
+  let 
+    tags :: String
+    tags = if "not found" `elem` words result then "" else extractTags result
+
+    newTags :: String
+    newTags = if null tags then name else tags <> " " <> name
+
+  callProcess "xprop" ["-id", wid, "-f", "_XMONAD_TAGS", "8s", "-set", "_XMONAD_TAGS", newTags]
+  where
+    extractTags :: String -> String
+    extractTags = unwords . drop 1 . words . last . lines
+
+tagSelfWith :: Tag -> IO ()
+tagSelfWith name = do
+  pid <- PID . show <$> getProcessID
+  result <- findAncestorWindowId pid
+  case result of
+    Just wid -> addTag name wid
+    Nothing -> exitFailure

driver/seito.hs

@@ -5,10 +5,12 @@ import           System.Environment
 import           Control.Monad
 import qualified Data.ByteString.Lazy as L
 
+import           Paths_sensei (getDataFileName)
+
 import           Client
 
 main :: IO ()
 main = do
-  (success, output) <- getArgs >>= client ""
+  (success, output) <- getArgs >>= client getDataFileName ""
   L.putStr output
   unless success exitFailure

driver/sensei.hs

@@ -2,7 +2,10 @@ module Main (main) where
 
 import           System.Environment
 
+import qualified XMonad
 import           Run
 
 main :: IO ()
-main = getArgs >>= run
+main = do
+  XMonad.tagSelfWith "sensei"
+  getArgs >>= run

package.yaml

@@ -17,8 +17,7 @@ default-extensions:
   - RecordWildCards
   - ViewPatterns
 
-other-extensions:
-  - NoFieldSelectors
+data-files: vim/sensei.vim
 
 dependencies:
   - base >= 4.11 && < 5
@@ -63,6 +62,7 @@ executables:
 
   seito:
     source-dirs: driver
+    generated-other-modules: Paths_sensei
     main: seito.hs
 
 tests:

solid.errors

@@ -0,0 +1,6 @@
+src/Command.hs:200:22: error:
+     error: [GHC-21231]
+        lexical error in string/character literal at character 'c'
+
+src/Command.hs:1:1: error:
+    `solid-pp' failed in phase `Haskell pre-processor'. (Exit code: 1)

src/Client.hs

@@ -11,11 +11,12 @@ import qualified Data.ByteString.Lazy as L
 
 import           HTTP (newSocket, socketName)
 
-client :: FilePath -> [String] -> IO (Bool, L.ByteString)
-client dir args = case args of
+client :: (FilePath -> IO FilePath) -> FilePath -> [String] -> IO (Bool, L.ByteString)
+client getDataFileName dir args = case args of
   [] -> hIsTerminalDevice stdout >>= run
   ["--no-color"] -> run False
   ["--color"] -> run True
+  ["--vim-config"] -> (,) True . fromString <$> getDataFileName "vim/sensei.vim"
   _ -> do
     hPutStrLn stderr $ "Usage: seito [ --color | --no-color ]"
     return (False, "")

test/ClientSpec.hs

@@ -24,17 +24,21 @@ spec = do
   describe "client" $ do
     it "accepts --color" $ do
       withSuccess $ \ dir -> do
-        client dir ["--color"] `shouldReturn` (True, fromString $ withColor Green "success")
+        client return dir ["--color"] `shouldReturn` (True, fromString $ withColor Green "success")
 
     it "accepts --no-color" $ do
       withSuccess $ \ dir -> do
-        client dir ["--no-color"] `shouldReturn` (True, "success")
+        client return dir ["--no-color"] `shouldReturn` (True, "success")
 
     it "indicates failure" $ do
       withFailure $ \ dir -> do
-        client dir ["--color"] `shouldReturn` (False, fromString $ withColor Red "failure")
+        client return dir ["--color"] `shouldReturn` (False, fromString $ withColor Red "failure")
 
     context "when server socket is missing" $ do
       it "reports error" $ do
         withTempDirectory $ \ dir -> do
-          client dir [] `shouldReturn` (False, "could not connect to " <> fromString (socketName dir) <> "\n")
+          client return dir [] `shouldReturn` (False, "could not connect to " <> fromString (socketName dir) <> "\n")
+
+    context "with --vim-config" $ do
+      it "returns a path to a Vim support file" $ do
+        client return undefined ["--vim-config"] `shouldReturn` (True, "vim/sensei.vim")