├── .github └── workflows │ ├── release.yml │ └── test.yml ├── .gitignore ├── .travis.yml ├── ChangeLog.md ├── LICENSE ├── README.md ├── Setup.hs ├── app ├── CLICommands.hs ├── Main.hs └── Options.hs ├── default.nix ├── development.dhall ├── package.yaml ├── samples ├── MissingTitle.dhall ├── MissingWindowTitle.dhall ├── NoWindowPanes.dhall ├── Sample1.dhall ├── Sample2.dhall └── Schema.dhall ├── src ├── TmuxMate.hs └── TmuxMate │ ├── Commands.hs │ ├── Init.hs │ ├── Logger.hs │ ├── Running.hs │ ├── TmuxCommands.hs │ ├── Types.hs │ └── Validate.hs ├── stack.yaml ├── stack.yaml.lock ├── test ├── Spec.hs └── Tests │ └── TmuxMate │ ├── TmuxCommands.hs │ ├── Types.hs │ └── Validate.hs └── tools ├── attach-binary.sh ├── install-ghr.sh └── install-stack.sh /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: New release 2 | on: 3 | push: 4 | tags: 5 | - v[0-9]* 6 | 7 | jobs: 8 | build: 9 | name: Build 10 | runs-on: ${{ matrix.os }} 11 | strategy: 12 | matrix: 13 | os: [ubuntu-18.04, macos-latest] 14 | 15 | steps: 16 | - name: Clone project 17 | uses: actions/checkout@v2 18 | 19 | - name: Cache stack global package db 20 | id: stack-global 21 | uses: actions/cache@v2 22 | with: 23 | path: ~/.stack 24 | key: ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 25 | restore-keys: | 26 | ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }} 27 | 28 | - name: Cache stack-installed programs in ~/.local/bin 29 | id: stack-programs 30 | uses: actions/cache@v2 31 | with: 32 | path: ~/.local/bin 33 | key: ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 34 | restore-keys: | 35 | ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }} 36 | 37 | - name: Cache .stack-work 38 | uses: actions/cache@v2 39 | with: 40 | path: .stack-work 41 | key: ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 42 | restore-keys: | 43 | ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }} 44 | 45 | # Fetch all history so git describe works 46 | - run: | 47 | git fetch --prune --unshallow 48 | 49 | - name: Build compiler and generate zip 50 | run: "stack build" 51 | 52 | - name: Install binary 53 | run: "stack install" 54 | 55 | - name: Output binary file 56 | run: echo "BINARY_PATH=$(stack path --local-install-root)/bin/tmux-mate" >> $GITHUB_ENV 57 | 58 | - name: Upload dist directory artifacts 59 | uses: actions/upload-artifact@v1 60 | with: 61 | name: dist-${{ runner.os }} 62 | path: ${{ env.BINARY_PATH }} 63 | 64 | release: 65 | name: Create Github Release 66 | needs: [build] 67 | runs-on: ubuntu-latest 68 | steps: 69 | 70 | - name: Determine version 71 | id: version 72 | run: "echo ::set-output name=version::${GITHUB_REF:11}" 73 | 74 | - name: Create Release 75 | id: create_release 76 | uses: actions/create-release@v1.0.0 77 | env: 78 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 79 | with: 80 | tag_name: ${{ github.ref }} 81 | release_name: Release ${{ github.ref }} 82 | draft: true 83 | prerelease: false 84 | 85 | - name: Fetch macOS build 86 | uses: actions/download-artifact@v1 87 | with: 88 | name: dist-macOS 89 | path: macOS-bin 90 | 91 | - name: Fetch linux build 92 | uses: actions/download-artifact@v1 93 | with: 94 | name: dist-linux 95 | path: linux-bin 96 | 97 | - name: Upload macOS build 98 | uses: actions/upload-release-asset@v1.0.1 99 | env: 100 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 101 | with: 102 | upload_url: ${{ steps.create_release.outputs.upload_url }} 103 | asset_path: macOS-bin/tmux-mate 104 | asset_name: tmux-mate-${{ steps.version.outputs.version }}-osx 105 | asset_content_type: application/zip 106 | 107 | - name: Upload linux build 108 | uses: actions/upload-release-asset@v1.0.1 109 | env: 110 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 111 | with: 112 | upload_url: ${{ steps.create_release.outputs.upload_url }} 113 | asset_path: linux-bin/tmux-mate 114 | asset_name: tmux-mate-${{ steps.version.outputs.version }}-linux 115 | asset_content_type: application/zip 116 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | build: 7 | 8 | runs-on: ubuntu-latest 9 | 10 | steps: 11 | - uses: actions/checkout@v1 12 | 13 | - name: Cache stack global package db 14 | id: stack-global 15 | uses: actions/cache@v2 16 | with: 17 | path: ~/.stack 18 | key: ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 19 | restore-keys: | 20 | ${{ runner.os }}-stack-global-${{ matrix.plan.ghc }} 21 | 22 | - name: Cache stack-installed programs in ~/.local/bin 23 | id: stack-programs 24 | uses: actions/cache@v2 25 | with: 26 | path: ~/.local/bin 27 | key: ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 28 | restore-keys: | 29 | ${{ runner.os }}-stack-programs-${{ matrix.plan.ghc }} 30 | 31 | - name: Cache .stack-work 32 | uses: actions/cache@v2 33 | with: 34 | path: .stack-work 35 | key: ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }}-${{ hashFiles('**.yaml') }} 36 | restore-keys: | 37 | ${{ runner.os }}-stack-work-${{ matrix.plan.ghc }} 38 | 39 | - name: Run stack build 40 | run: stack build 41 | 42 | - name: Run stack test 43 | run: stack test 44 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | .stack-work/ 3 | tmux-mate.cabal 4 | *~ 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | addons: 2 | apt: 3 | packages: 4 | - libgmp-dev 5 | language: c 6 | sudo: false 7 | cache: 8 | directories: 9 | - $HOME/.local/bin 10 | - $HOME/.stack 11 | os: 12 | - linux 13 | - osx 14 | before_install: 15 | - sh tools/install-stack.sh 16 | - sh tools/install-ghr.sh 17 | script: 18 | - stack setup 19 | - stack test 20 | - stack build --ghc-options -O2 --pedantic 21 | after_success: 22 | - sh tools/attach-binary.sh 23 | -------------------------------------------------------------------------------- /ChangeLog.md: -------------------------------------------------------------------------------- 1 | # Changelog for tmux-mate 2 | 3 | ## Unreleased changes 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Author name here (c) 2020 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Author name here nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # tmux-mate 2 | 3 | Manage your tmux sessions with the delicious power of Dhall. 4 | 5 | ### Motivation 6 | 7 | Working on modern microservice architectures usually means spinning up various combinations of 5 or more different services. Remembering what they are is a totally `1x` use of your time, let's automate it! 8 | 9 | ### Installation 10 | 11 | #### MacOS 12 | 13 | ```bash 14 | brew update && brew install danieljharvey/tools/tmux-mate 15 | ``` 16 | 17 | #### Ubuntu 18 | 19 | Binaries available on the [releases](https://github.com/danieljharvey/tmux-mate/releases) page. 20 | 21 | ### Getting started 22 | 23 | ```bash 24 | # create a default tmux-mate.dhall 25 | tmux-mate init 26 | # Start running everything 27 | tmux-mate start 28 | ``` 29 | 30 | ### Tutorial 31 | 32 | Let's grab a couple of sample config files... 33 | 34 | ```bash 35 | curl https://raw.githubusercontent.com/danieljharvey/tmux-mate/master/samples/Sample1.dhall > Sample1.dhall 36 | curl https://raw.githubusercontent.com/danieljharvey/tmux-mate/master/samples/Sample2.dhall > Sample2.dhall 37 | ``` 38 | 39 | Let's open the first config file in `tmux-mate`. 40 | 41 | ``` 42 | # Run tmux-mate with the first sample script 43 | tmux-mate ./Sample1.dhall 44 | ``` 45 | 46 | You should now see a `tmux` window running two infinite loops (that will soon wear your battery down, apologies). What if it turns out we need more things in our development environment? 47 | 48 | ```bash 49 | # Run tmux-mate with the second sample script 50 | tmux-mate ./Sample2.dhall 51 | ``` 52 | 53 | You will now see your same session with an extra window added. `tmux-mate` has diffed the two sessions and added/removed the changes. This might seem like a useless optimization when running a trivial process like `yes`, but when running multiple build environments this saves loads of time. 54 | 55 | ### Configuration 56 | 57 | This project uses [Dhall](https://dhall-lang.org/) files for configuration. There are some examples in the `/samples/` folders that demonstrate how to put one together. This is the schema: 58 | 59 | ``` 60 | { sessionTitle : Text 61 | , sessionWindows : 62 | List 63 | { windowTitle : Text 64 | , windowPanes : List { paneCommand : Text } 65 | , windowArrangement : Text 66 | } 67 | } 68 | ``` 69 | 70 | A few rules 71 | 72 | - All of the `sessionTitle` and `windowTitle` entries must be non-empty - they are used to manage the sessions internally. 73 | - The session must contain at least one window, and each window must contain at least one pane. 74 | - `windowArrangement` is one of `tmux`'s options `tiled`, `even-horizontal`, 75 | `even-vertical`, `main-horizontal` and `main-vertical`. Info on what those 76 | mean in the [man page](http://man7.org/linux/man-pages/man1/tmux.1.html) - 77 | search for `select-layout` for info. 78 | 79 | ### Options 80 | 81 | Sometimes if what you expect to happen is not happening, pop in the `-v` 82 | (or `--verbose`) flag to see what `tmux-mate` is thinking. 83 | 84 | Alternatively, to see what it's thinking without actually running the commands, 85 | then instead use `-d` (or `--dry-run`). 86 | 87 | ### Requirements 88 | 89 | You will need a recent version of `tmux` installed. I tested on version 3, but I'm pretty sure the commands I am using are pretty basic so should work backwards too. 90 | 91 | ### Development 92 | 93 | Run `stack install` to install `tmux-mate` and then run `tmux-mate 94 | development.dhall` to launch an environment with everything you need. 95 | 96 | If `ghcid` is missing, add it with `stack install ghcid`. 97 | 98 | ### Prior art 99 | 100 | Very much inspired by [Tmuxinator](https://github.com/tmuxinator/tmuxinator), a 101 | great project that doesn't _quite_ do what I needed. 102 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/CLICommands.hs: -------------------------------------------------------------------------------- 1 | module CLICommands where 2 | 3 | import TmuxMate (CLIOptions (..)) 4 | 5 | data CLICommand 6 | = CLIRun CLIOptions 7 | | CLIInit 8 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CLICommands 4 | import Options (command) 5 | import qualified Options.Applicative as Opt 6 | import System.Exit 7 | import TmuxMate 8 | 9 | main :: IO () 10 | main = do 11 | command' <- Opt.execParser (Opt.info command Opt.fullDesc) 12 | case command' of 13 | CLIInit -> do 14 | createTmuxMateDhall 15 | putStrLn "Initial tmux-mate.dhall created!" 16 | CLIRun options' -> do 17 | didItWork <- loadTestSession options' 18 | case didItWork of 19 | Yeah -> exitWith ExitSuccess 20 | Nah i -> exitWith (ExitFailure i) 21 | -------------------------------------------------------------------------------- /app/Options.hs: -------------------------------------------------------------------------------- 1 | module Options (command) where 2 | 3 | import CLICommands 4 | import Options.Applicative ((<|>)) 5 | import qualified Options.Applicative as Opt 6 | import TmuxMate 7 | 8 | command :: Opt.Parser CLICommand 9 | command = 10 | otherCommands 11 | <|> (CLIRun <$> options) 12 | 13 | configFilePathParser :: Opt.Parser (Maybe ConfigFilePath) 14 | configFilePathParser = 15 | ( Just <$> ConfigFilePath 16 | <$> Opt.argument Opt.str (Opt.metavar "") 17 | ) 18 | <|> pure Nothing 19 | 20 | verbosityParser :: Opt.Parser Verbosity 21 | verbosityParser = 22 | Opt.flag' Chatty (Opt.short 'v' <> Opt.long "verbose") 23 | <|> Opt.flag' DryRun (Opt.short 'd' <> Opt.long "dry-run") 24 | <|> pure Silent 25 | 26 | options :: Opt.Parser CLIOptions 27 | options = 28 | CLIOptions 29 | <$> configFilePathParser <*> verbosityParser 30 | 31 | otherCommands :: Opt.Parser CLICommand 32 | otherCommands = 33 | Opt.subparser 34 | ( Opt.command 35 | "init" 36 | ( Opt.info 37 | (pure CLIInit) 38 | (Opt.progDesc "Initialise a new tmux-mate.dhall file") 39 | ) 40 | <> Opt.command 41 | "start" 42 | ( Opt.info 43 | (CLIRun <$> options) 44 | (Opt.progDesc "Start running everything in the selected config file") 45 | ) 46 | ) 47 | -------------------------------------------------------------------------------- /default.nix: -------------------------------------------------------------------------------- 1 | let 2 | pkgs = 3 | let 4 | # 2020-02-17T09:51:51+00:00", 5 | rev = "fc592a52cacfbf5f22e6479a22263983f5346ea6"; 6 | sha256 = "0ma4jxxjdp1pnc1nz0b1h13kh49z4na4rjixg5sbdi8iz5fmq4iy"; 7 | in 8 | import (builtins.fetchTarball { 9 | name = "nixpkgs-${rev}"; 10 | url = "https://github.com/nixos/nixpkgs/archive/${rev}.tar.gz"; 11 | inherit sha256; 12 | }) {}; 13 | in 14 | { ghc ? null }: # passed in by `stack build --nix` 15 | if ghc == null then throw "build with stack!" else 16 | pkgs.haskell.lib.buildStackProject { 17 | name = "tmux-mate"; 18 | inherit ghc; 19 | buildInputs = [ pkgs.zlib ]; 20 | } 21 | -------------------------------------------------------------------------------- /development.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle = "tmux-mate" 2 | , sessionWindows = 3 | [ { windowTitle = "development" 4 | , windowPanes = 5 | [ { paneCommand = "vim ." } 6 | , { paneCommand = "stack test --file-watch" } 7 | , { paneCommand = "ghcid -c 'stack repl'" } 8 | , { paneCommand = "ghcid -c 'stack repl test/Spec.hs'" } 9 | , { paneCommand = "watch --color -n 2 git -c color.status=always status" } 10 | , { paneCommand = "$SHELL" } 11 | ] 12 | , windowArrangement = "main-vertical" 13 | } 14 | ] 15 | } 16 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: tmux-mate 2 | version: 0.1.0.0 3 | github: "githubuser/tmux-mate" 4 | license: BSD3 5 | author: "Author name here" 6 | maintainer: "example@example.com" 7 | copyright: "2020 Author name here" 8 | 9 | extra-source-files: 10 | - README.md 11 | - ChangeLog.md 12 | 13 | # Metadata used when publishing your package 14 | # synopsis: Short description of your package 15 | # category: Web 16 | 17 | # To avoid duplicated efforts in documentation and dealing with the 18 | # complications of embedding Haddock markup inside cabal files, it is 19 | # common to point users to the README.md file. 20 | description: Please see the README on GitHub at 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | 25 | library: 26 | source-dirs: src 27 | dependencies: 28 | - process 29 | - text 30 | - dhall 31 | - colourista 32 | 33 | executables: 34 | tmux-mate: 35 | main: Main.hs 36 | source-dirs: app 37 | ghc-options: 38 | - -threaded 39 | - -rtsopts 40 | - -with-rtsopts=-N 41 | dependencies: 42 | - tmux-mate 43 | - optparse-applicative 44 | 45 | tests: 46 | tmux-mate-test: 47 | main: Spec.hs 48 | source-dirs: test 49 | ghc-options: 50 | - -threaded 51 | - -rtsopts 52 | - -with-rtsopts=-N 53 | dependencies: 54 | - tmux-mate 55 | - QuickCheck 56 | - generic-arbitrary 57 | - dhall 58 | - hspec 59 | - text 60 | -------------------------------------------------------------------------------- /samples/MissingTitle.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle = "" 2 | , sessionWindows = 3 | [ { windowTitle = "first-window" 4 | , windowArrangement = "tiled" 5 | , windowPanes = 6 | [ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ] 7 | } 8 | ] 9 | } 10 | -------------------------------------------------------------------------------- /samples/MissingWindowTitle.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle = "foo" 2 | , sessionWindows = 3 | [ { windowTitle = "" 4 | , windowArrangement = "tiled" 5 | , windowPanes = 6 | [ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ] 7 | } 8 | ] 9 | } 10 | -------------------------------------------------------------------------------- /samples/NoWindowPanes.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle = "foo" 2 | , sessionWindows = 3 | [ { windowTitle = "first-window" 4 | , windowArrangement = "even-horizontal" 5 | , windowPanes = [] : List { paneCommand : Text } 6 | } 7 | ] 8 | } 9 | -------------------------------------------------------------------------------- /samples/Sample1.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle = "foo" 2 | , sessionWindows = 3 | [ { windowTitle = "first-window" 4 | , windowPanes = 5 | [ { paneCommand = "yes 'Pane 0'" } 6 | , { paneCommand = "yes 'Pane 1'" } 7 | , { paneCommand = "yes 'Pane 2'" } 8 | ] 9 | , windowArrangement = "even-horizontal" 10 | } 11 | ] 12 | } 13 | -------------------------------------------------------------------------------- /samples/Sample2.dhall: -------------------------------------------------------------------------------- 1 | -- here we are taking our first Dhall file and adding another window to it 2 | let sample1 = ./Sample1.dhall 3 | 4 | in { sessionTitle = sample1.sessionTitle 5 | , sessionWindows = 6 | sample1.sessionWindows 7 | # [ { windowTitle = "second-window" 8 | , windowArrangement = "tiled" 9 | , windowPanes = 10 | [ { paneCommand = "yes 'Pane 3'" } 11 | , { paneCommand = "yes 'Pane 4'" } 12 | , { paneCommand = "yes 'Pane 5'" } 13 | , { paneCommand = "yes 'Pane 6'" } 14 | ] 15 | } 16 | ] 17 | } 18 | -------------------------------------------------------------------------------- /samples/Schema.dhall: -------------------------------------------------------------------------------- 1 | { sessionTitle : Text 2 | , sessionWindows : 3 | List 4 | { windowTitle : Text 5 | , windowPanes : List { paneCommand : Text } 6 | , windowArrangement : Text 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /src/TmuxMate.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module TmuxMate 5 | ( loadTestSession, 6 | DidItWork (..), 7 | CLIOptions (..), 8 | ConfigFilePath (..), 9 | Verbosity (..), 10 | createTmuxMateDhall, 11 | ) 12 | where 13 | 14 | import Data.Maybe (fromMaybe) 15 | import qualified Dhall as Dhall 16 | import System.Process 17 | import TmuxMate.Commands 18 | import TmuxMate.Init 19 | import TmuxMate.Logger 20 | import TmuxMate.Running 21 | import TmuxMate.TmuxCommands 22 | import TmuxMate.Types 23 | import TmuxMate.Validate 24 | 25 | getCommands :: [TmuxCommand] -> [Command] 26 | getCommands = 27 | concatMap createActualCommand 28 | 29 | runCommands :: [Command] -> IO () 30 | runCommands = 31 | mapM_ 32 | ( \(Command a) -> callCommand a 33 | ) 34 | 35 | data DidItWork 36 | = Yeah 37 | | Nah Int 38 | 39 | loadTestSession :: CLIOptions -> IO DidItWork 40 | loadTestSession options = do 41 | let (decoder :: Dhall.Decoder Session) = Dhall.auto 42 | let path = fromMaybe "tmux-mate.dhall" (getConfigFilePath <$> configFilePath options) 43 | myLog = logger (verbosity options) 44 | config <- Dhall.detailed (Dhall.inputFile decoder path) 45 | case parseSession config of 46 | Left e -> do 47 | myLog Highlight ("Error parsing config at " <> path) 48 | myLog Error (show e) 49 | pure (Nah 1) 50 | Right config' -> do 51 | case verbosity options of 52 | DryRun -> myLog Highlight "Dry run mode - will not execute" 53 | _ -> pure () 54 | tmuxState <- askTmuxState 55 | myLog Highlight "Current tmux state" 56 | myLog Info (show tmuxState) 57 | let tmuxCommands = getTmuxCommands config' tmuxState 58 | myLog Highlight "Tmux Commands" 59 | _ <- traverse (myLog Info . show) tmuxCommands 60 | let commands = getCommands tmuxCommands 61 | myLog Highlight "Shell commands" 62 | _ <- traverse (myLog Info . getCommand) commands 63 | case verbosity options of 64 | DryRun -> pure Yeah 65 | _ -> do 66 | runCommands commands 67 | pure Yeah 68 | -------------------------------------------------------------------------------- /src/TmuxMate/Commands.hs: -------------------------------------------------------------------------------- 1 | module TmuxMate.Commands where 2 | 3 | import qualified Data.List.NonEmpty as NE 4 | import TmuxMate.Types 5 | 6 | sendKeys :: VSessionName -> String -> Command 7 | sendKeys (VSessionName name) str = 8 | Command $ 9 | "tmux send-keys -t " <> (quoteAndEscape . NE.toList) name <> " " 10 | <> quoteAndEscape str 11 | <> " ENTER" 12 | 13 | adminPaneName :: String 14 | adminPaneName = quoteAndEscape "tmux-mate-admin" 15 | 16 | -- turns our DSL into actual tmux commands 17 | createActualCommand :: TmuxCommand -> [Command] 18 | createActualCommand (CreateAdminPane (VSessionName seshName)) = 19 | pure $ Command $ 20 | "tmux split-window -v -t " 21 | <> (quoteAndEscape . NE.toList) seshName 22 | createActualCommand (KillAdminPane seshName) = 23 | [ Command $ "tmux select-window -t " <> adminPaneName, 24 | sendKeys seshName "exit" 25 | ] 26 | createActualCommand (CreatePane _ (VWindowName winName) arrangement newCmd) = 27 | let windowName' = (quoteAndEscape . NE.toList) winName 28 | in [ Command $ "tmux select-window -t " <> windowName', 29 | Command $ 30 | "tmux split-window " 31 | <> (quoteAndEscape . getCommand) newCmd, 32 | Command $ 33 | "tmux select-layout -t " <> windowName' <> " " 34 | <> (showPaneArrangement arrangement) 35 | ] 36 | createActualCommand (KillPane seshName paneIndex) = 37 | pure $ 38 | sendKeys 39 | seshName 40 | ( "tmux kill-pane -t " 41 | <> show paneIndex 42 | ) 43 | createActualCommand (AttachToSession (VSessionName seshName)) = 44 | pure $ Command $ 45 | "tmux attach-session -t " 46 | <> (quoteAndEscape . NE.toList) seshName 47 | createActualCommand (KillSession (VSessionName seshName)) = 48 | pure $ Command $ 49 | "tmux kill-session -t " 50 | <> (quoteAndEscape . NE.toList) seshName 51 | createActualCommand (NewSession (VSessionName seshName)) = 52 | pure $ Command $ 53 | "tmux new-session -d -s " 54 | <> (quoteAndEscape . NE.toList) seshName 55 | <> " -n " 56 | <> adminPaneName 57 | createActualCommand (CreateWindow _ (VWindowName winName) (Command newCmd)) = 58 | [ Command $ 59 | "tmux new-window -n " 60 | <> (quoteAndEscape . NE.toList) winName 61 | <> " " 62 | <> quoteAndEscape newCmd 63 | ] 64 | createActualCommand (KillWindow _ (VWindowName winName)) = 65 | [ Command $ 66 | "tmux kill-window -t " 67 | <> (quoteAndEscape . NE.toList) winName 68 | ] 69 | 70 | showPaneArrangement :: VPaneArrangement -> String 71 | showPaneArrangement Tiled = "tiled" 72 | showPaneArrangement EvenHorizontal = "even-horizontal" 73 | showPaneArrangement EvenVertical = "even-vertical" 74 | showPaneArrangement MainHorizontal = "main-horizontal" 75 | showPaneArrangement MainVertical = "main-vertical" 76 | 77 | quote :: String -> String 78 | quote s = "\"" <> s <> "\"" 79 | 80 | escape :: String -> String 81 | escape "" = "" 82 | escape ('\"' : t) = "\\\"" <> escape t 83 | escape (x : xs) = x : escape xs 84 | 85 | quoteAndEscape :: String -> String 86 | quoteAndEscape = quote . escape 87 | -------------------------------------------------------------------------------- /src/TmuxMate/Init.hs: -------------------------------------------------------------------------------- 1 | module TmuxMate.Init (createTmuxMateDhall) where 2 | 3 | -- where we make a new empty session file 4 | 5 | import Data.Text.IO 6 | import Dhall 7 | import Dhall.Core (pretty) 8 | import TmuxMate.Types 9 | ( Pane (..), 10 | PaneArrangement (..), 11 | PaneCommand (..), 12 | Session (..), 13 | SessionName (..), 14 | Window (..), 15 | WindowName (..), 16 | ) 17 | 18 | createTmuxMateDhall :: IO () 19 | createTmuxMateDhall = do 20 | let dhallVal = pretty (embed inject defaultSession) 21 | Data.Text.IO.writeFile "./tmux-mate.dhall" dhallVal 22 | 23 | defaultSession :: Session 24 | defaultSession = 25 | Session 26 | (SessionName "tmux-mate") 27 | [ Window 28 | (WindowName "first") 29 | [ Pane 30 | ( PaneCommand "watch echo \"hello from tmux-mate\"" 31 | ), 32 | Pane 33 | ( PaneCommand "watch echo \"hello again from tmux-mate\"" 34 | ) 35 | ] 36 | (PaneArrangement "tiled") 37 | ] 38 | -------------------------------------------------------------------------------- /src/TmuxMate/Logger.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExplicitForAll #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | 5 | module TmuxMate.Logger 6 | ( logger, 7 | Colour (..), 8 | ) 9 | where 10 | 11 | import Colourista.IO 12 | import qualified Data.Text as T 13 | import TmuxMate.Types 14 | 15 | data Colour 16 | = Error 17 | | Info 18 | | Highlight 19 | 20 | outputMsg :: Colour -> String -> IO () 21 | outputMsg colour msg = 22 | case colour of 23 | Highlight -> whiteMessage (T.pack msg) 24 | Error -> redMessage (T.pack msg) 25 | Info -> magentaMessage (T.pack msg) 26 | 27 | logger :: Verbosity -> Colour -> String -> IO () 28 | logger _ Error msg = redMessage (T.pack msg) 29 | logger Silent _ _ = pure () 30 | logger DryRun c m = outputMsg c m 31 | logger Chatty c m = outputMsg c m 32 | -------------------------------------------------------------------------------- /src/TmuxMate/Running.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module TmuxMate.Running where 4 | 5 | import Control.Exception 6 | import Data.List (intercalate) 7 | import Data.Maybe (catMaybes) 8 | import System.Environment 9 | import System.Process 10 | import Text.Read 11 | import TmuxMate.Types 12 | import TmuxMate.Validate 13 | 14 | buildTmuxState :: IO TmuxState 15 | buildTmuxState = do 16 | sessions' <- askRunningSessions 17 | running' <- askRunning 18 | inTmux <- askIfWeAreInTmux 19 | pure $ TmuxState inTmux running' sessions' 20 | 21 | askTmuxState :: IO TmuxState 22 | askTmuxState = 23 | catch 24 | (buildTmuxState) 25 | (\(_ :: IOError) -> pure def) 26 | where 27 | def = TmuxState 28 | { inSession = NotInTmuxSession, 29 | running = mempty, 30 | sessions = mempty 31 | } 32 | 33 | -- "foo:yes Pane 2\nfoo:yes Pane 1\n" 34 | 35 | askRunning :: IO [Running] 36 | askRunning = do 37 | str <- catch readTmuxProcess (\(_ :: IOError) -> pure "") 38 | pure $ parseRunning str 39 | 40 | -- ask Tmux what's cooking 41 | readTmuxProcess :: IO String 42 | readTmuxProcess = 43 | readCreateProcess 44 | (shell "tmux list-pane -as -F '#{session_name}:#{window_name}:#{pane_index}:#{pane_start_command}'") 45 | "" 46 | 47 | -- "foo/npoo/n0/n" 48 | askRunningSessions :: IO [VSessionName] 49 | askRunningSessions = do 50 | str <- catch readTmuxSessions (\(_ :: IOError) -> pure "") 51 | pure $ catMaybes $ 52 | ( hush 53 | . parseSessionName 54 | . SessionName 55 | ) 56 | <$> lines str 57 | 58 | readTmuxSessions :: IO String 59 | readTmuxSessions = 60 | readCreateProcess 61 | (shell "tmux list-sessions -F '#{session_name}'") 62 | "" 63 | 64 | -- are we currently in a tmux session? (if so, don't nest) 65 | 66 | askIfWeAreInTmux :: IO InTmuxSession 67 | askIfWeAreInTmux = do 68 | tmuxEnv <- lookupEnv "TMUX" 69 | seshName <- askCurrentSessionName 70 | case tmuxEnv of 71 | Nothing -> pure NotInTmuxSession 72 | Just "" -> pure NotInTmuxSession 73 | Just _ -> do 74 | case (parseSessionName seshName) of 75 | Right seshName' -> pure $ InTmuxSession seshName' 76 | _ -> pure NotInTmuxSession 77 | 78 | askCurrentSessionName :: IO SessionName 79 | askCurrentSessionName = 80 | SessionName 81 | <$> readCreateProcess 82 | (shell "tmux display-message -p '#S'") 83 | "" 84 | 85 | -- stop unrequired 86 | 87 | removeQuotes :: PaneCommand -> PaneCommand 88 | removeQuotes (PaneCommand s) = 89 | PaneCommand $ (filter ((/=) '\'')) s 90 | 91 | wordsWhen :: (Char -> Bool) -> String -> [String] 92 | wordsWhen p s = case dropWhile p s of 93 | "" -> [] 94 | s' -> w : wordsWhen p s'' 95 | where 96 | (w, s'') = break p s' 97 | 98 | myLookup :: Int -> [a] -> Maybe a 99 | myLookup _ [] = Nothing 100 | myLookup 0 (x : _) = Just x 101 | myLookup i (_ : xs) = myLookup (i - 1) xs 102 | 103 | parseSingle :: String -> Maybe Running 104 | parseSingle str = 105 | Running 106 | <$> seshName 107 | <*> windowName' 108 | <*> cmd' 109 | <*> index' 110 | where 111 | seshName = 112 | (SessionName <$> myLookup 0 subStrs) 113 | >>= (hush . parseSessionName) 114 | windowName' = 115 | (WindowName <$> myLookup 1 subStrs) 116 | >>= (hush . parseWindowName) 117 | index' = 118 | myLookup 2 subStrs 119 | >>= readMaybe 120 | cmd' = case intercalate ":" (drop 3 subStrs) of 121 | "" -> Nothing 122 | a -> Just (PaneCommand a) 123 | subStrs = wordsWhen (== ':') str 124 | 125 | parseRunning :: String -> [Running] 126 | parseRunning as = 127 | catMaybes (parseSingle <$> (lines as)) 128 | 129 | hush :: Either e a -> Maybe a 130 | hush (Left _) = Nothing 131 | hush (Right a) = Just a 132 | -------------------------------------------------------------------------------- /src/TmuxMate/TmuxCommands.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE ScopedTypeVariables #-} 3 | 4 | module TmuxMate.TmuxCommands 5 | ( createSession, 6 | createWindow, 7 | removeWindowPanes, 8 | removeWindows, 9 | attachToSession, 10 | getTmuxCommands, 11 | ) 12 | where 13 | 14 | import Data.List (nub) 15 | import qualified Data.List.NonEmpty as NE 16 | import Data.Monoid (Any (..)) 17 | import TmuxMate.Running 18 | import TmuxMate.Types 19 | 20 | getTmuxCommands :: ValidatedSession -> TmuxState -> [TmuxCommand] 21 | getTmuxCommands sesh tmuxState = 22 | let runningPanes = 23 | running tmuxState 24 | runningSessions = 25 | sessions tmuxState 26 | runningInTmux = 27 | inSession tmuxState 28 | sTitle = 29 | case runningInTmux of 30 | NotInTmuxSession -> vSessionTitle sesh 31 | InTmuxSession sesh' -> sesh' 32 | sWindows = 33 | NE.toList (vSessionWindows sesh) 34 | in (createSession runningInTmux sesh runningSessions) 35 | <> ( concatMap 36 | (createWindow sTitle runningPanes) 37 | sWindows 38 | ) 39 | <> (removeWindowPanes runningInTmux sTitle runningPanes sWindows) 40 | <> (removeWindows runningInTmux sTitle runningPanes sWindows) 41 | <> ( if needsNewSession runningInTmux sTitle runningSessions 42 | then removeAdminPane sTitle 43 | else [] 44 | ) 45 | <> (attachToSession sTitle runningInTmux) 46 | 47 | -- create a new session if required 48 | createSession :: InTmuxSession -> ValidatedSession -> [VSessionName] -> [TmuxCommand] 49 | createSession inTmux session runningSesh = 50 | if needsNewSession inTmux (vSessionTitle session) runningSesh 51 | then [NewSession (vSessionTitle session)] 52 | else [] 53 | 54 | needsNewSession :: InTmuxSession -> VSessionName -> [VSessionName] -> Bool 55 | needsNewSession NotInTmuxSession seshName runningSesh = not (elem seshName runningSesh) 56 | needsNewSession _ _ _ = False 57 | 58 | -- do we need to create this window? 59 | createWindow :: VSessionName -> [Running] -> VWindow -> [TmuxCommand] 60 | createWindow seshName running' window = 61 | if windowExists seshName (vWindowTitle window) running' 62 | then 63 | createWindowPanes 64 | seshName 65 | (vWindowTitle window) 66 | (vWindowArrangement window) 67 | (NE.toList $ vWindowPanes window) 68 | running' 69 | else 70 | pure 71 | ( CreateWindow 72 | seshName 73 | (vWindowTitle window) 74 | (paneCmdToCmd (NE.head (vWindowPanes window))) 75 | ) 76 | <> createWindowPanes 77 | seshName 78 | (vWindowTitle window) 79 | (vWindowArrangement window) 80 | (NE.tail $ vWindowPanes window) 81 | running' 82 | 83 | windowExists :: VSessionName -> VWindowName -> [Running] -> Bool 84 | windowExists seshName winName running' = 85 | length 86 | ( filter 87 | ( \a -> 88 | windowName a == winName 89 | && sessionName a == seshName 90 | ) 91 | running' 92 | ) 93 | > 0 94 | 95 | -- create panes we need for a given window 96 | createWindowPanes :: 97 | VSessionName -> VWindowName -> VPaneArrangement -> [Pane] -> [Running] -> [TmuxCommand] 98 | createWindowPanes seshName windowName' arrange panes running' = 99 | ( \pane -> 100 | CreatePane 101 | seshName 102 | windowName' 103 | arrange 104 | (paneCmdToCmd pane) 105 | ) 106 | <$> filterPanes 107 | seshName 108 | windowName' 109 | running' 110 | panes 111 | 112 | paneCmdToCmd :: Pane -> Command 113 | paneCmdToCmd = 114 | Command . getPaneCommand . paneCommand 115 | 116 | -- work out what panes we need to create 117 | filterPanes :: VSessionName -> VWindowName -> [Running] -> [Pane] -> [Pane] 118 | filterPanes seshName winName running' panes = 119 | filter (\pane -> not $ matchCommand (removeQuotes (paneCommand pane))) panes 120 | where 121 | matchCommand str = 122 | length 123 | ( filter 124 | ( \(Running seshName' winName' run _) -> 125 | removeQuotes run == str 126 | && seshName == seshName' 127 | && winName == winName' 128 | ) 129 | running' 130 | ) 131 | > 0 132 | 133 | -------------------------- 134 | -- removing stuff again 135 | 136 | removeWindowPanes :: InTmuxSession -> VSessionName -> [Running] -> [VWindow] -> [TmuxCommand] 137 | removeWindowPanes inTmux seshName running' windows = 138 | (\(Running _ _ _ i) -> KillPane seshName i) 139 | <$> (filterRunning inTmux seshName windows running') 140 | 141 | filterRunning :: InTmuxSession -> VSessionName -> [VWindow] -> [Running] -> [Running] 142 | filterRunning inTmux seshName windows running' = 143 | filter 144 | ( \(Running seshName' winName' run _) -> 145 | windowMatch winName' 146 | && ( not $ 147 | anyMatch (removeQuotes run) windows 148 | && seshName == seshName' 149 | ) 150 | ) 151 | running' 152 | where 153 | -- is this even in a window relevant to us? 154 | windowMatch :: VWindowName -> Bool 155 | windowMatch winName' = case inTmux of 156 | NotInTmuxSession -> True 157 | InTmuxSession _ -> elem winName' (vWindowTitle <$> windows) 158 | anyMatch :: PaneCommand -> [VWindow] -> Bool 159 | anyMatch str windows' = 160 | getAny (foldMap (matchCommand str) windows') 161 | matchCommand :: PaneCommand -> VWindow -> Any 162 | matchCommand str window = 163 | Any $ 164 | length 165 | ( NE.filter 166 | ( \pane -> 167 | removeQuotes (paneCommand pane) == str 168 | ) 169 | (vWindowPanes window) 170 | ) 171 | > 0 172 | 173 | -- important thing here is whether this is actually our session to run 174 | -- if we're running in tmux we're a guest in another session and we should only 175 | -- edit windows that are in our config file, and leave the rest be. 176 | removeWindows :: 177 | InTmuxSession -> 178 | VSessionName -> 179 | [Running] -> 180 | [VWindow] -> 181 | [TmuxCommand] 182 | removeWindows inTmux seshName running' windows = 183 | case inTmux of 184 | NotInTmuxSession -> 185 | ( ( \winTitle' -> 186 | KillWindow 187 | seshName 188 | winTitle' 189 | ) 190 | <$> filter 191 | ( \win' -> 192 | notElem win' requiredWindowNames 193 | ) 194 | runningWindowNames 195 | ) 196 | _ -> [] 197 | where 198 | requiredWindowNames = 199 | vWindowTitle <$> windows 200 | runningWindowNames = 201 | nub $ 202 | windowName 203 | <$> filter 204 | ( \(Running sesh' _ _ _) -> 205 | sesh' 206 | == seshName 207 | ) 208 | running' 209 | 210 | -- remove admin window (always) 211 | 212 | removeAdminPane :: VSessionName -> [TmuxCommand] 213 | removeAdminPane seshName = pure (KillAdminPane seshName) 214 | 215 | -- don't attach to session if we're in a session 216 | attachToSession :: VSessionName -> InTmuxSession -> [TmuxCommand] 217 | attachToSession _ (InTmuxSession _) = [] 218 | attachToSession sTitle _ = [AttachToSession sTitle] 219 | -------------------------------------------------------------------------------- /src/TmuxMate/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE DerivingStrategies #-} 4 | {-# LANGUAGE DerivingVia #-} 5 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 6 | 7 | module TmuxMate.Types where 8 | 9 | import Data.List.NonEmpty 10 | import Dhall (FromDhall, ToDhall) 11 | import GHC.Generics 12 | 13 | data InTmuxSession 14 | = InTmuxSession VSessionName 15 | | NotInTmuxSession 16 | deriving (Eq, Ord, Show) 17 | 18 | data TmuxState 19 | = TmuxState 20 | { inSession :: InTmuxSession, 21 | running :: [Running], 22 | sessions :: [VSessionName] 23 | } 24 | deriving (Eq, Ord, Show) 25 | 26 | data IsNewSession 27 | = IsNewSession 28 | | IsOldSession 29 | 30 | newtype PaneArrangement 31 | = PaneArrangement {getPaneArrangement :: String} 32 | deriving stock (Eq, Ord, Generic) 33 | deriving newtype (Show, ToDhall, FromDhall) 34 | 35 | data Session 36 | = Session 37 | { sessionTitle :: SessionName, 38 | sessionWindows :: [Window] 39 | } 40 | deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall) 41 | 42 | data Window 43 | = Window 44 | { windowTitle :: WindowName, 45 | windowPanes :: [Pane], 46 | windowArrangement :: PaneArrangement 47 | } 48 | deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall) 49 | 50 | newtype PaneCommand 51 | = PaneCommand {getPaneCommand :: String} 52 | deriving stock (Eq, Ord, Generic) 53 | deriving newtype (Show, ToDhall, FromDhall) 54 | 55 | data Pane 56 | = Pane 57 | { paneCommand :: PaneCommand 58 | } 59 | deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall) 60 | 61 | newtype SessionName 62 | = SessionName {getSessionName :: String} 63 | deriving stock (Eq, Ord, Generic) 64 | deriving newtype (Show, FromDhall, ToDhall) 65 | 66 | newtype WindowName 67 | = WindowName {getWindowName :: String} 68 | deriving stock (Eq, Ord, Generic) 69 | deriving newtype (Show, FromDhall, ToDhall) 70 | 71 | data TmuxCommand 72 | = CreateAdminPane VSessionName 73 | | KillAdminPane VSessionName 74 | | CreatePane VSessionName VWindowName VPaneArrangement Command 75 | | KillPane VSessionName Int 76 | | CreateWindow VSessionName VWindowName Command 77 | | KillWindow VSessionName VWindowName 78 | | AttachToSession VSessionName 79 | | KillSession VSessionName 80 | | NewSession VSessionName 81 | deriving (Eq, Ord, Show, Generic) 82 | 83 | newtype Command 84 | = Command {getCommand :: String} 85 | deriving stock (Eq, Ord, Generic) 86 | deriving newtype (Show, FromDhall, ToDhall) 87 | 88 | data Running 89 | = Running 90 | { sessionName :: VSessionName, 91 | windowName :: VWindowName, 92 | cmd :: PaneCommand, 93 | index :: Int 94 | } 95 | deriving (Eq, Ord, Show) 96 | 97 | data ValidationError 98 | = EmptySessionName 99 | | NoWindows 100 | | EmptyWindowName 101 | | WindowWithNoPanes VWindowName 102 | deriving (Eq, Ord) 103 | 104 | instance Show ValidationError where 105 | show EmptySessionName = "Session title must not be an empty string." 106 | show NoWindows = "Session must contain at least one window." 107 | show EmptyWindowName = "All windows must have a non-empty title." 108 | show (WindowWithNoPanes (VWindowName name)) = 109 | "Window '" 110 | <> toList name 111 | <> "' does not have any panes! All windows must contain at least one pane." 112 | 113 | -- helper for nice Show instance 114 | newtype NicelyPrintedNonEmpty 115 | = NicelyPrintedNonEmpty (NonEmpty Char) 116 | 117 | instance Show NicelyPrintedNonEmpty where 118 | show (NicelyPrintedNonEmpty nec) = toList nec 119 | 120 | -- Validated datatypes 121 | 122 | newtype VSessionName 123 | = VSessionName {getVSessionName :: NonEmpty Char} 124 | deriving stock (Eq, Ord, Generic) 125 | deriving (Show) via NicelyPrintedNonEmpty 126 | 127 | data VPaneArrangement 128 | = EvenHorizontal 129 | | EvenVertical 130 | | MainHorizontal 131 | | MainVertical 132 | | Tiled 133 | deriving (Eq, Ord, Show, Generic) 134 | 135 | data ValidatedSession 136 | = ValidatedSession 137 | { vSessionTitle :: VSessionName, 138 | vSessionWindows :: NonEmpty VWindow 139 | } 140 | deriving (Eq, Ord, Show, Generic) 141 | 142 | newtype VWindowName 143 | = VWindowName {getVWindowName :: NonEmpty Char} 144 | deriving stock (Eq, Ord, Generic) 145 | deriving (Show) via NicelyPrintedNonEmpty 146 | 147 | data VWindow 148 | = VWindow 149 | { vWindowTitle :: VWindowName, 150 | vWindowPanes :: NonEmpty Pane, 151 | vWindowArrangement :: VPaneArrangement 152 | } 153 | deriving (Eq, Ord, Show, Generic) 154 | 155 | ------- 156 | 157 | data Verbosity 158 | = Silent 159 | | Chatty 160 | | DryRun 161 | deriving (Eq, Ord, Show) 162 | 163 | newtype ConfigFilePath 164 | = ConfigFilePath {getConfigFilePath :: String} 165 | deriving (Eq, Ord, Show) 166 | 167 | data CLIOptions 168 | = CLIOptions 169 | { configFilePath :: Maybe ConfigFilePath, 170 | verbosity :: Verbosity 171 | } 172 | deriving (Eq, Ord, Show) 173 | -------------------------------------------------------------------------------- /src/TmuxMate/Validate.hs: -------------------------------------------------------------------------------- 1 | module TmuxMate.Validate where 2 | 3 | import Data.Char (toLower) 4 | import qualified Data.List as L 5 | import Data.List.NonEmpty 6 | import TmuxMate.Types 7 | 8 | strip :: String -> String 9 | strip = L.reverse . L.dropWhile (== '\n') . L.reverse 10 | 11 | parseSession :: Session -> Either ValidationError ValidatedSession 12 | parseSession sesh = do 13 | windows <- parseSessionWindows (sessionWindows sesh) 14 | seshTitle <- parseSessionName (sessionTitle sesh) 15 | pure $ 16 | ValidatedSession 17 | { vSessionTitle = seshTitle, 18 | vSessionWindows = windows 19 | } 20 | 21 | parseSessionName :: SessionName -> Either ValidationError VSessionName 22 | parseSessionName (SessionName str) = 23 | case nonEmpty (strip str) of 24 | Just neStr -> Right (VSessionName neStr) 25 | _ -> Left EmptySessionName 26 | 27 | parseSessionWindows :: [Window] -> Either ValidationError (NonEmpty VWindow) 28 | parseSessionWindows as = do 29 | vWindows <- sequence (parseWindow <$> as) 30 | case nonEmpty vWindows of 31 | Just as' -> Right as' 32 | _ -> Left NoWindows 33 | 34 | parseWindowName :: WindowName -> Either ValidationError VWindowName 35 | parseWindowName (WindowName str) = 36 | case nonEmpty (strip str) of 37 | Just neStr -> Right (VWindowName neStr) 38 | _ -> Left EmptyWindowName 39 | 40 | parseWindowPanes :: VWindowName -> [Pane] -> Either ValidationError (NonEmpty Pane) 41 | parseWindowPanes wName as = 42 | case nonEmpty as of 43 | Just as' -> Right as' 44 | _ -> Left $ WindowWithNoPanes wName 45 | 46 | parseWindow :: Window -> Either ValidationError VWindow 47 | parseWindow window = do 48 | name <- parseWindowName (windowTitle window) 49 | panes <- parseWindowPanes name (windowPanes window) 50 | pure $ 51 | VWindow 52 | { vWindowTitle = name, 53 | vWindowPanes = panes, 54 | vWindowArrangement = case (fmap toLower) 55 | . getPaneArrangement 56 | . windowArrangement 57 | $ window of 58 | "even-horizontal" -> EvenHorizontal 59 | "even-vertical" -> EvenVertical 60 | "main-horizontal" -> MainHorizontal 61 | "main-vertical" -> MainVertical 62 | _ -> Tiled 63 | } 64 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-14.27 # ghc 8.6.5 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # subdirs: 29 | # - auto-update 30 | # - wai 31 | packages: 32 | - . 33 | # Dependency packages to be pulled from upstream that are not in the resolver. 34 | # These entries can reference officially published versions as well as 35 | # forks / in-progress versions pinned to a git hash. For example: 36 | # 37 | # extra-deps: 38 | # - acme-missiles-0.3 39 | # - git: https://github.com/commercialhaskell/stack.git 40 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 41 | # 42 | extra-deps: 43 | - dhall-1.29.0 44 | # newer dhall requires... 45 | - prettyprinter-1.6.1@sha256:11876ec94a79048e1d2942a99bfaa6f2be5222eafeedac6a9545673a79465009,5459 46 | # colourful output! 47 | - colourista-0.0.0.0 48 | - ansi-terminal-0.10 49 | 50 | # Override default flag values for local packages and extra-deps 51 | # flags: {} 52 | 53 | ghc-options: 54 | # All packages 55 | "$locals": -Wall 56 | 57 | # Extra package databases containing global packages 58 | # extra-package-dbs: [] 59 | 60 | # Control whether we use the GHC we find on the path 61 | # system-ghc: true 62 | # 63 | # Require a specific version of stack, using version ranges 64 | # require-stack-version: -any # Default 65 | # require-stack-version: ">=2.1" 66 | # 67 | # Override the architecture used by stack, especially useful on Windows 68 | # arch: i386 69 | # arch: x86_64 70 | # 71 | # Extra directories used by stack for building 72 | # extra-include-dirs: [/path/to/dir] 73 | # extra-lib-dirs: [/path/to/dir] 74 | # 75 | # Allow a newer minor version of GHC than the snapshot specifies 76 | # compiler-check: newer-minor 77 | nix: 78 | enable: false # pass `--nix` to `stack build` if you need 79 | shell-file: default.nix 80 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: dhall-1.29.0@sha256:48e9c106ac611cc14f2f68d2a2df6358bfc371654a2b981ac3d7d73dccdc7ae2,32755 9 | pantry-tree: 10 | size: 244291 11 | sha256: ca99d89b077c2c536179f3b1751dfd5da70cb6eb3e052e408f0841c1c9582a01 12 | original: 13 | hackage: dhall-1.29.0 14 | - completed: 15 | hackage: prettyprinter-1.6.1@sha256:11876ec94a79048e1d2942a99bfaa6f2be5222eafeedac6a9545673a79465009,5459 16 | pantry-tree: 17 | size: 2194 18 | sha256: b8ddc48e267da0bc8da3082929b478df80c3c986865394f93e7bc7631c0031cf 19 | original: 20 | hackage: prettyprinter-1.6.1@sha256:11876ec94a79048e1d2942a99bfaa6f2be5222eafeedac6a9545673a79465009,5459 21 | - completed: 22 | hackage: colourista-0.0.0.0@sha256:700efa51ad616af88fb708e23688935bb5fbdb7bfa5d8f350969a9049554c690,2288 23 | pantry-tree: 24 | size: 391 25 | sha256: 29579ae8520345fe82844fcdfc7a4825ae3e376985bcad1aae3c7ca60247a40f 26 | original: 27 | hackage: colourista-0.0.0.0 28 | - completed: 29 | hackage: ansi-terminal-0.10@sha256:69d3fc72208f2d8830c18636182e342fabee4859bc091a89a77fe84d5674156b,3224 30 | pantry-tree: 31 | size: 1461 32 | sha256: f1b526e610cb98a75c4c2161c689e85613bba3651ea75a2c110d930a4b47e21e 33 | original: 34 | hackage: ansi-terminal-0.10 35 | snapshots: 36 | - completed: 37 | size: 524996 38 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml 39 | sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0 40 | original: lts-14.27 41 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | import Control.Monad (when) 5 | import qualified Data.List.NonEmpty as NE 6 | import qualified Data.Text as Text 7 | import qualified Data.Text.IO as Text.IO 8 | import Dhall 9 | import Dhall.Core (pretty) 10 | import Test.Hspec 11 | import Test.QuickCheck 12 | import Test.QuickCheck.Monadic 13 | import qualified Tests.TmuxMate.TmuxCommands as TmuxCommands 14 | import Tests.TmuxMate.Types (Session) 15 | import qualified Tests.TmuxMate.Validate as Validate 16 | import TmuxMate.Running 17 | import TmuxMate.Types 18 | 19 | main :: IO () 20 | main = hspec $ do 21 | Validate.spec 22 | TmuxCommands.spec 23 | describe "ParseRunning" $ do 24 | it "Rejects nonsense" $ do 25 | parseSingle "sdfdsf" `shouldBe` Nothing 26 | it "Accepts goodness" $ do 27 | parseSingle "foo:bar:1:yes Pane 1" 28 | `shouldBe` Just 29 | ( Running 30 | (VSessionName (NE.fromList "foo")) 31 | (VWindowName (NE.fromList "bar")) 32 | (PaneCommand "yes Pane 1") 33 | 1 34 | ) 35 | it "Accepts goodness with double colons inside" $ do 36 | parseSingle "foo:bar:1:yes Pane 1:2" 37 | `shouldBe` Just 38 | ( Running 39 | (VSessionName (NE.fromList "foo")) 40 | (VWindowName (NE.fromList "bar")) 41 | (PaneCommand "yes Pane 1:2") 42 | 1 43 | ) 44 | it "returns the original number when given a positive input" $ 45 | parseRunning 46 | "0:0:\nfoo:bar:0:yes Pane 2\nfoo:bar:1:yes Pane 1\n" 47 | `shouldBe` [ Running 48 | (VSessionName (NE.fromList "foo")) 49 | (VWindowName (NE.fromList "bar")) 50 | (PaneCommand "yes Pane 2") 51 | 0, 52 | Running 53 | (VSessionName (NE.fromList "foo")) 54 | (VWindowName (NE.fromList "bar")) 55 | (PaneCommand "yes Pane 1") 56 | 1 57 | ] 58 | describe "Dhall" $ do 59 | it "Round trips Dhall encoding" $ do 60 | property dhallSessionRoundtrip 61 | it "Generates a Dhall schema that matches our advertised one" $ do 62 | let schema = (Dhall.Core.pretty (Dhall.expected (Dhall.auto @Session))) 63 | savedSchema <- Text.IO.readFile "./samples/Schema.dhall" 64 | when 65 | (Text.stripEnd schema /= Text.stripEnd savedSchema) 66 | ( do 67 | putStrLn "Generated schema:" 68 | Text.IO.putStrLn schema 69 | ) 70 | Text.stripEnd schema `shouldBe` Text.stripEnd savedSchema 71 | 72 | dhallSessionRoundtrip :: Property 73 | dhallSessionRoundtrip = 74 | monadicIO $ do 75 | (sesh :: Session) <- pick arbitrary 76 | let dhallVal = pretty (embed inject sesh) 77 | let (decoder :: Decoder Session) = auto 78 | decoded <- run $ input decoder dhallVal 79 | assert $ decoded == sesh 80 | -------------------------------------------------------------------------------- /test/Tests/TmuxMate/TmuxCommands.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ScopedTypeVariables #-} 2 | 3 | module Tests.TmuxMate.TmuxCommands where 4 | 5 | import qualified Data.List.NonEmpty as NE 6 | import Test.Hspec 7 | import TmuxMate.TmuxCommands 8 | import TmuxMate.Types 9 | 10 | sampleSession :: ValidatedSession 11 | sampleSession = 12 | ValidatedSession 13 | { vSessionTitle = VSessionName $ NE.fromList "horses", 14 | vSessionWindows = 15 | NE.fromList 16 | [ VWindow 17 | { vWindowTitle = VWindowName $ NE.fromList "window", 18 | vWindowArrangement = Tiled, 19 | vWindowPanes = undefined 20 | } 21 | ] 22 | } 23 | 24 | spec :: Spec 25 | spec = do 26 | describe "createSession" $ do 27 | it "Does nothing if we're already attached" $ do 28 | createSession 29 | ( InTmuxSession 30 | (VSessionName $ NE.fromList "dogs") 31 | ) 32 | sampleSession 33 | [] 34 | `shouldBe` [] 35 | it "Does nothing if session already exists" $ do 36 | createSession 37 | NotInTmuxSession 38 | sampleSession 39 | [VSessionName $ NE.fromList "horses"] 40 | `shouldBe` [] -- AttachToSession (VSessionName $ NE.fromList "horses")] 41 | it "Creates a session if we are not in tmux and session is not running" $ do 42 | createSession NotInTmuxSession sampleSession [] 43 | `shouldBe` [NewSession (VSessionName $ NE.fromList "horses")] 44 | describe "createWindow" $ do 45 | it "Creates a window if needed" $ do 46 | createWindow 47 | (VSessionName $ NE.fromList "horses") 48 | [] 49 | ( VWindow 50 | { vWindowTitle = VWindowName (NE.fromList "window"), 51 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 52 | vWindowArrangement = Tiled 53 | } 54 | ) 55 | `shouldBe` pure 56 | ( CreateWindow 57 | (VSessionName $ NE.fromList "horses") 58 | (VWindowName $ NE.fromList "window") 59 | (Command "go") 60 | ) 61 | it "Creates a window if there is matching one but it's in another session" $ do 62 | createWindow 63 | (VSessionName $ NE.fromList "horses") 64 | [ Running 65 | (VSessionName $ NE.fromList "other") 66 | (VWindowName $ NE.fromList "window") 67 | (PaneCommand "go") 68 | 0 69 | ] 70 | ( VWindow 71 | { vWindowTitle = VWindowName (NE.fromList "window"), 72 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 73 | vWindowArrangement = Tiled 74 | } 75 | ) 76 | `shouldBe` [ ( CreateWindow 77 | (VSessionName $ NE.fromList "horses") 78 | (VWindowName $ NE.fromList "window") 79 | (Command "go") 80 | ) 81 | ] 82 | it "Does nothing if one already exists" $ do 83 | createWindow 84 | (VSessionName $ NE.fromList "horses") 85 | [ Running 86 | (VSessionName $ NE.fromList "horses") 87 | (VWindowName $ NE.fromList "window") 88 | (PaneCommand "go") 89 | 0 90 | ] 91 | ( VWindow 92 | { vWindowTitle = VWindowName (NE.fromList "window"), 93 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 94 | vWindowArrangement = Tiled 95 | } 96 | ) 97 | `shouldBe` [] 98 | it "Adds second pane to existing window" $ do 99 | createWindow 100 | (VSessionName $ NE.fromList "horses") 101 | [ Running 102 | (VSessionName $ NE.fromList "horses") 103 | (VWindowName $ NE.fromList "window") 104 | (PaneCommand "go") 105 | 0 106 | ] 107 | ( VWindow 108 | { vWindowTitle = VWindowName (NE.fromList "window"), 109 | vWindowPanes = NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "whoa")], 110 | vWindowArrangement = Tiled 111 | } 112 | ) 113 | `shouldBe` [ CreatePane 114 | (VSessionName $ NE.fromList "horses") 115 | (VWindowName $ NE.fromList "window") 116 | Tiled 117 | (Command "whoa") 118 | ] 119 | it "Creates a pane if something matches, but it's in another window" $ do 120 | createWindow 121 | (VSessionName $ NE.fromList "horses") 122 | [ Running 123 | (VSessionName $ NE.fromList "horses") 124 | (VWindowName $ NE.fromList "different-window") 125 | (PaneCommand "go") 126 | 0, 127 | Running 128 | (VSessionName $ NE.fromList "horses") 129 | (VWindowName $ NE.fromList "window") 130 | (PaneCommand "no") 131 | 0 132 | ] 133 | ( VWindow 134 | { vWindowTitle = VWindowName (NE.fromList "window"), 135 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 136 | vWindowArrangement = Tiled 137 | } 138 | ) 139 | `shouldBe` [ CreatePane 140 | (VSessionName $ NE.fromList "horses") 141 | (VWindowName $ NE.fromList "window") 142 | Tiled 143 | (Command "go") 144 | ] 145 | it "Ignores panes that already exist" $ do 146 | createWindow 147 | (VSessionName (NE.fromList "horses")) 148 | [ Running 149 | (VSessionName (NE.fromList "horses")) 150 | (VWindowName (NE.fromList "window")) 151 | (PaneCommand "go") 152 | 0, 153 | Running 154 | (VSessionName (NE.fromList "horses")) 155 | (VWindowName (NE.fromList "window")) 156 | (PaneCommand "yo") 157 | 0 158 | ] 159 | ( VWindow 160 | { vWindowTitle = VWindowName (NE.fromList "window"), 161 | vWindowPanes = NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "yo")], 162 | vWindowArrangement = Tiled 163 | } 164 | ) 165 | `shouldBe` [] 166 | describe "removeWindowPanes" $ do 167 | it "Does nothing if nothing running" $ do 168 | removeWindowPanes 169 | NotInTmuxSession 170 | (VSessionName (NE.fromList "horses")) 171 | [] 172 | [ ( VWindow 173 | { vWindowTitle = VWindowName (NE.fromList "window"), 174 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 175 | vWindowArrangement = Tiled 176 | } 177 | ) 178 | ] 179 | `shouldBe` [] 180 | it "Does nothing if running pane is still needed" $ do 181 | removeWindowPanes 182 | NotInTmuxSession 183 | (VSessionName (NE.fromList "horses")) 184 | [ Running 185 | (VSessionName (NE.fromList "horses")) 186 | (VWindowName (NE.fromList "window")) 187 | (PaneCommand "go") 188 | 0 189 | ] 190 | [ ( VWindow 191 | { vWindowTitle = VWindowName (NE.fromList "window"), 192 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 193 | vWindowArrangement = Tiled 194 | } 195 | ) 196 | ] 197 | `shouldBe` [] 198 | it "Creates a remove events if pane is no longer needed" $ do 199 | removeWindowPanes 200 | NotInTmuxSession 201 | (VSessionName (NE.fromList "horses")) 202 | [ Running 203 | (VSessionName (NE.fromList "horses")) 204 | (VWindowName (NE.fromList "window")) 205 | (PaneCommand "go") 206 | 24 207 | ] 208 | [ ( VWindow 209 | { vWindowTitle = VWindowName (NE.fromList "window"), 210 | vWindowPanes = NE.fromList [Pane (PaneCommand "whoa-no")], 211 | vWindowArrangement = Tiled 212 | } 213 | ) 214 | ] 215 | `shouldBe` [KillPane (VSessionName (NE.fromList "horses")) 24] 216 | it "Does not remove panes from windows that are nothing to do with us if we do not control the session" $ do 217 | removeWindowPanes 218 | (InTmuxSession (VSessionName $ NE.fromList "horses")) 219 | (VSessionName (NE.fromList "horses")) 220 | [ Running 221 | (VSessionName (NE.fromList "horses")) 222 | (VWindowName (NE.fromList "different-window")) 223 | (PaneCommand "leave me") 224 | 27, 225 | Running 226 | (VSessionName (NE.fromList "horses")) 227 | (VWindowName (NE.fromList "window")) 228 | (PaneCommand "get rid of me") 229 | 24 230 | ] 231 | [ ( VWindow 232 | { vWindowTitle = VWindowName (NE.fromList "window"), 233 | vWindowPanes = NE.fromList [Pane (PaneCommand "whoa-no")], 234 | vWindowArrangement = Tiled 235 | } 236 | ) 237 | ] 238 | `shouldBe` [KillPane (VSessionName (NE.fromList "horses")) 24] 239 | describe "removeWindows" $ do 240 | it "Does nothing if no window to remove" $ do 241 | removeWindows 242 | NotInTmuxSession 243 | (VSessionName (NE.fromList "horses")) 244 | [] 245 | [ ( VWindow 246 | { vWindowTitle = VWindowName (NE.fromList "window"), 247 | vWindowPanes = NE.fromList [Pane (PaneCommand "go")], 248 | vWindowArrangement = Tiled 249 | } 250 | ) 251 | ] 252 | `shouldBe` [] 253 | it "Should remove a window if it's no longer needed in a hosted session" $ do 254 | removeWindows 255 | NotInTmuxSession 256 | (VSessionName (NE.fromList "horses")) 257 | [ Running 258 | (VSessionName (NE.fromList "horses")) 259 | (VWindowName (NE.fromList "window2")) 260 | (PaneCommand "no") 261 | 10 262 | ] 263 | [ ( VWindow 264 | { vWindowTitle = VWindowName (NE.fromList "window"), 265 | vWindowPanes = 266 | NE.fromList 267 | [Pane (PaneCommand "go")], 268 | vWindowArrangement = Tiled 269 | } 270 | ) 271 | ] 272 | `shouldBe` [ KillWindow 273 | (VSessionName (NE.fromList "horses")) 274 | (VWindowName (NE.fromList "window2")) 275 | ] 276 | it "Should leave a window that's no longer needed if we are not the session host" $ do 277 | removeWindows 278 | (InTmuxSession (VSessionName $ NE.fromList "bruce")) 279 | (VSessionName (NE.fromList "bruce")) 280 | [ Running 281 | (VSessionName (NE.fromList "bruce")) 282 | (VWindowName (NE.fromList "window")) 283 | (PaneCommand "go") 284 | 10, 285 | Running -- this one should be deleted really 286 | (VSessionName (NE.fromList "bruce")) 287 | (VWindowName (NE.fromList "window2")) 288 | (PaneCommand "no") 289 | 10 290 | ] 291 | [ ( VWindow 292 | { vWindowTitle = VWindowName (NE.fromList "window"), 293 | vWindowPanes = 294 | NE.fromList 295 | [Pane (PaneCommand "go")], 296 | vWindowArrangement = Tiled 297 | } 298 | ) 299 | ] 300 | `shouldBe` [] 301 | describe "Attach to session" $ do 302 | it "Should attach to session if we're not in one" $ do 303 | let sessionName' = VSessionName (NE.fromList "session") 304 | attachToSession sessionName' NotInTmuxSession 305 | `shouldBe` [AttachToSession sessionName'] 306 | it "Should not attach to session if we're already in one" $ do 307 | let sessionName' = VSessionName (NE.fromList "session") 308 | attachToSession sessionName' (InTmuxSession sessionName') 309 | `shouldBe` [] 310 | -------------------------------------------------------------------------------- /test/Tests/TmuxMate/Types.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE ScopedTypeVariables #-} 4 | {-# LANGUAGE StandaloneDeriving #-} 5 | {-# OPTIONS_GHC -fno-warn-orphans #-} 6 | 7 | module Tests.TmuxMate.Types 8 | ( Session, 9 | ) 10 | where 11 | 12 | -- add arbitary types 13 | 14 | import GHC.Generics 15 | import Test.QuickCheck 16 | import Test.QuickCheck.Arbitrary.Generic 17 | import TmuxMate.Types 18 | 19 | -- helper 20 | 21 | newtype GenericArb a 22 | = GenericArb {getGenericArb :: a} 23 | deriving (Generic) 24 | 25 | instance (Generic a, Arbitrary a) => Arbitrary (GenericArb a) where 26 | arbitrary = genericArbitrary 27 | 28 | -- helper 29 | 30 | instance Arbitrary Session where 31 | arbitrary = genericArbitrary 32 | 33 | instance Arbitrary Window where 34 | arbitrary = genericArbitrary 35 | 36 | instance Arbitrary VPaneArrangement where 37 | arbitrary = genericArbitrary 38 | 39 | instance Arbitrary PaneArrangement where 40 | arbitrary = 41 | oneof 42 | [ pure (PaneArrangement "tiled"), 43 | pure (PaneArrangement "even-vertical"), 44 | pure (PaneArrangement "even-horizontal"), 45 | pure (PaneArrangement "main-vertical"), 46 | pure (PaneArrangement "main-horizontal") 47 | ] 48 | 49 | instance Arbitrary WindowName where 50 | arbitrary = oneof [pure (WindowName "window-name")] 51 | 52 | instance Arbitrary SessionName where 53 | arbitrary = oneof [pure (SessionName "session-name")] 54 | 55 | instance Arbitrary Pane where 56 | arbitrary = genericArbitrary 57 | 58 | instance Arbitrary PaneCommand where 59 | arbitrary = oneof [pure (PaneCommand "pane-command")] 60 | -------------------------------------------------------------------------------- /test/Tests/TmuxMate/Validate.hs: -------------------------------------------------------------------------------- 1 | module Tests.TmuxMate.Validate where 2 | 3 | import qualified Data.List.NonEmpty as NE 4 | import Test.Hspec 5 | import TmuxMate.Types 6 | import TmuxMate.Validate 7 | 8 | spec :: Spec 9 | spec = do 10 | describe "Validating Session to VSession" $ do 11 | it "Fails on an empty name" $ do 12 | let sesh = 13 | Session 14 | { sessionTitle = SessionName "", 15 | sessionWindows = 16 | [ Window 17 | { windowTitle = WindowName "OK", 18 | windowPanes = [Pane {paneCommand = PaneCommand ""}], 19 | windowArrangement = PaneArrangement "Tiled" 20 | } 21 | ] 22 | } 23 | parseSession sesh 24 | `shouldBe` Left EmptySessionName 25 | it "Fails on just a newline" $ do 26 | let sesh = 27 | Session 28 | { sessionTitle = SessionName "\n", 29 | sessionWindows = 30 | [ Window 31 | { windowTitle = WindowName "OK", 32 | windowPanes = [Pane {paneCommand = PaneCommand ""}], 33 | windowArrangement = PaneArrangement "Tiled" 34 | } 35 | ] 36 | } 37 | parseSession sesh 38 | `shouldBe` Left EmptySessionName 39 | it "Fails with no windows" $ do 40 | let sesh = 41 | Session 42 | { sessionTitle = SessionName "Whoa", 43 | sessionWindows = [] 44 | } 45 | parseSession sesh 46 | `shouldBe` Left NoWindows 47 | it "Fails with empty window name" $ do 48 | let sesh = 49 | Session 50 | { sessionTitle = SessionName "Whoa", 51 | sessionWindows = 52 | [ Window 53 | { windowTitle = WindowName "", 54 | windowPanes = [Pane {paneCommand = PaneCommand ""}], 55 | windowArrangement = PaneArrangement "Tiled" 56 | } 57 | ] 58 | } 59 | parseSession sesh 60 | `shouldBe` Left EmptyWindowName 61 | it "Fails on a newline" $ do 62 | let sesh = 63 | Session 64 | { sessionTitle = SessionName "Whoa", 65 | sessionWindows = 66 | [ Window 67 | { windowTitle = WindowName "\n", 68 | windowPanes = [Pane {paneCommand = PaneCommand ""}], 69 | windowArrangement = PaneArrangement "Tiled" 70 | } 71 | ] 72 | } 73 | parseSession sesh 74 | `shouldBe` Left EmptyWindowName 75 | it "Fails with no window panes" $ do 76 | let sesh = 77 | Session 78 | { sessionTitle = SessionName "Whoa", 79 | sessionWindows = 80 | [ Window 81 | { windowTitle = 82 | WindowName "empty-boy", 83 | windowPanes = [], 84 | windowArrangement = PaneArrangement "Tiled" 85 | } 86 | ] 87 | } 88 | parseSession sesh 89 | `shouldBe` Left 90 | ( WindowWithNoPanes 91 | (VWindowName $ NE.fromList "empty-boy") 92 | ) 93 | -------------------------------------------------------------------------------- /tools/attach-binary.sh: -------------------------------------------------------------------------------- 1 | set -o errexit -o verbose 2 | 3 | if test ! "$TRAVIS_TAG" 4 | then 5 | echo 'This is not a release build.' 6 | elif test ! "$GITHUB_TOKEN" 7 | then 8 | echo 'The GITHUB_TOKEN environment variable is not set!' 9 | exit 1 10 | else 11 | echo "Attaching binary for $TRAVIS_OS_NAME to $TRAVIS_TAG..." 12 | OWNER="$(echo "$TRAVIS_REPO_SLUG" | cut -f1 -d/)" 13 | REPO="$(echo "$TRAVIS_REPO_SLUG" | cut -f2 -d/)" 14 | BIN="$(stack path --local-install-root)/bin/$REPO" 15 | BUNDLE_NAME="$REPO-$TRAVIS_TAG-$TRAVIS_OS_NAME.tar.gz" 16 | cp "$BIN" "./$REPO" 17 | chmod +x "./$REPO" 18 | tar -czf "$BUNDLE_NAME" "$REPO" 19 | echo "SHA256:" 20 | shasum -a 256 "$BUNDLE_NAME" 21 | ghr -t "$GITHUB_TOKEN" -u "$OWNER" -r "$REPO" --replace "$(git describe --tags)" "$BUNDLE_NAME" 22 | fi 23 | -------------------------------------------------------------------------------- /tools/install-ghr.sh: -------------------------------------------------------------------------------- 1 | set -o errexit -o verbose 2 | 3 | if test ! "$TRAVIS_TAG" 4 | then 5 | echo 'This is not a release build.' 6 | else 7 | if [ "$TRAVIS_OS_NAME" = "linux" ] 8 | then 9 | ARCH="linux" 10 | else 11 | ARCH="darwin" 12 | fi 13 | echo "Installing ghr" 14 | URL="https://github.com/tcnksm/ghr/releases/download/v0.5.4/ghr_v0.5.4_${ARCH}_386.zip" 15 | curl -L ${URL} > ghr.zip 16 | mkdir -p "$HOME/bin" 17 | export PATH="$HOME/bin:$PATH" 18 | unzip ghr.zip -d "$HOME/bin" 19 | rm ghr.zip 20 | fi 21 | -------------------------------------------------------------------------------- /tools/install-stack.sh: -------------------------------------------------------------------------------- 1 | set -o errexit -o verbose 2 | 3 | if test -f "$HOME/.local/bin/stack" 4 | then 5 | echo 'Stack is already installed.' 6 | else 7 | echo "Installing Stack for $TRAVIS_OS_NAME..." 8 | URL="https://www.stackage.org/stack/$TRAVIS_OS_NAME-x86_64" 9 | curl --location "$URL" > stack.tar.gz 10 | gunzip stack.tar.gz 11 | tar -x -f stack.tar --strip-components 1 12 | mkdir -p "$HOME/.local/bin" 13 | mv stack "$HOME/.local/bin/" 14 | rm stack.tar 15 | fi 16 | 17 | stack --version 18 | --------------------------------------------------------------------------------