MVP

.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+tmux-mate.cabal
+*~

ChangeLog.md

@@ -0,0 +1,3 @@
+# Changelog for tmux-mate
+
+## Unreleased changes

LICENSE

@@ -0,0 +1,30 @@
+Copyright Author name here (c) 2020
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Author name here nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -0,0 +1,25 @@
+# tmux-mate
+
+Manage your tmux sessions with the delicious power of Dhall.
+
+### Trying it
+
+To use:
+
+`git clone https://github.com/danieljharvey/tmux-mate`
+
+`cd tmux-mate`
+
+`stack install`
+
+`export TMUX_MATE_PATH='./test/samples/Sample1.dhall && tmux-mate`
+
+You should now see some garbage and your session.
+
+### Making your own dhall files
+
+Look in `test/samples` for ideas.
+
+### Requirements
+
+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.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

app/Main.hs

@@ -0,0 +1,11 @@
+module Main where
+
+import Lib
+import System.Environment
+
+main :: IO ()
+main = do
+  path <- lookupEnv "TMUX_MATE_PATH"
+  case path of
+    Just dhallPath -> loadTestSession dhallPath
+    Nothing -> putStrLn "Pass a valid path to TMUX_MATE_PATH pls"

package.yaml

@@ -0,0 +1,56 @@
+name: tmux-mate
+version: 0.1.0.0
+github: "githubuser/tmux-mate"
+license: BSD3
+author: "Author name here"
+maintainer: "example@example.com"
+copyright: "2020 Author name here"
+
+extra-source-files:
+  - README.md
+  - ChangeLog.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Web
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description: Please see the README on GitHub at <https://github.com/githubuser/tmux-mate#readme>
+
+dependencies:
+  - base >= 4.7 && < 5
+
+library:
+  source-dirs: src
+  dependencies:
+    - process
+    - text
+    - dhall
+
+executables:
+  tmux-mate-exe:
+    main: Main.hs
+    source-dirs: app
+    ghc-options:
+      - -threaded
+      - -rtsopts
+      - -with-rtsopts=-N
+    dependencies:
+      - tmux-mate
+
+tests:
+  tmux-mate-test:
+    main: Spec.hs
+    source-dirs: test
+    ghc-options:
+      - -threaded
+      - -rtsopts
+      - -with-rtsopts=-N
+    dependencies:
+      - tmux-mate
+      - QuickCheck
+      - generic-arbitrary
+      - dhall
+      - hspec

src/Lib.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Lib
+  ( loadTestSession,
+  )
+where
+
+import Control.Exception
+import qualified Dhall as Dhall
+import System.Process
+import TmuxMate.Commands
+import TmuxMate.Running
+import TmuxMate.Types
+
+getCommands :: Session -> [Running] -> [Command]
+getCommands sesh running =
+  startSession isNewSession (title sesh)
+    <> concatMap (addPane (title sesh)) filteredPanes
+    <> concatMap (removePane (title sesh)) filteredRunning
+    <> attach isNewSession (title sesh)
+  where
+    filteredPanes =
+      filterPanes (title sesh) running (panes sesh)
+    filteredRunning =
+      filterRunning (title sesh) (panes sesh) running
+    isNewSession =
+      if length running > 0
+        then OldSession
+        else NewSession
+
+runCommands :: [Command] -> IO ()
+runCommands =
+  mapM_
+    ( \(a) -> case a of
+        Required a -> callCommand a
+        Optional a -> do
+          res <- (system a)
+          pure ()
+    )
+
+testSession :: Session
+testSession =
+  Session
+    { title = SessionName "foo",
+      panes =
+        [ Pane (PaneCommand "yes 'Pane 1'") (PaneTitle "One"),
+          Pane (PaneCommand "yes 'Pane 2'") (PaneTitle "Two"),
+          Pane (PaneCommand "yes 'Pane 3'") (PaneTitle "Three"),
+          Pane (PaneCommand "yes 'Pane 4'") (PaneTitle "Four")
+        ]
+    }
+
+filterPanes :: SessionName -> [Running] -> [Pane] -> [Pane]
+filterPanes (SessionName seshName) running panes =
+  filter (\pane -> not $ matchCommand (removeQuotes (getPaneCommand $ paneCommand pane))) panes
+  where
+    matchCommand str =
+      length
+        ( filter
+            ( \(Running seshName' run _) ->
+                removeQuotes run == str
+                  && seshName == seshName'
+            )
+            running
+        )
+        > 0
+
+filterRunning :: SessionName -> [Pane] -> [Running] -> [Running]
+filterRunning (SessionName seshName) panes running =
+  filter
+    ( \(Running seshName' run _) ->
+        not $ (matchCommand (removeQuotes run) && seshName == seshName')
+    )
+    running
+  where
+    matchCommand str =
+      length
+        ( filter
+            ( \pane ->
+                removeQuotes (getPaneCommand $ paneCommand pane) == str
+            )
+            panes
+        )
+        > 0
+
+loadTestSession :: FilePath -> IO ()
+loadTestSession path = do
+  let (decoder :: Dhall.Decoder Session) = Dhall.auto
+  config <- Dhall.inputFile decoder path
+  running <- askRunning (title config)
+  print running
+  let commands = (getCommands config running)
+  print commands
+  runCommands commands

src/TmuxMate/Commands.hs

@@ -0,0 +1,58 @@
+module TmuxMate.Commands (startSession, addPane, attach, removePane) where
+
+import TmuxMate.Types
+
+-- trash session in case it's already there
+startSession :: IsNewSession -> SessionName -> [Command]
+startSession isNew seshTitle =
+  case isNew of
+    NewSession -> [newSession seshTitle]
+    OldSession -> [createAdminWindow seshTitle]
+
+addPane :: SessionName -> Pane -> [Command]
+addPane name (Pane command title) =
+  [ sendKeys name ("tmux split-window -h -d " <> (getPaneCommand command))
+  ]
+
+removePane :: SessionName -> Running -> [Command]
+removePane name (Running _ _ index) =
+  [ sendKeys name ("tmux kill-pane -t " <> show index)
+  ]
+
+attach :: IsNewSession -> SessionName -> [Command]
+attach isNew seshTitle =
+  case isNew of
+    NewSession ->
+      [ killAdminWindow seshTitle,
+        attachToSession seshTitle
+      ]
+    OldSession -> [killAdminWindow seshTitle]
+
+sendKeys :: SessionName -> String -> Command
+sendKeys (SessionName name) str =
+  Required $
+    "tmux send-keys -t " <> name <> " \""
+      <> str
+      <> "\" ENTER"
+
+--
+
+attachToSession :: SessionName -> Command
+attachToSession (SessionName name) =
+  Required $ "tmux attach-session -t " <> name
+
+killSession :: SessionName -> Command
+killSession (SessionName name) =
+  Optional $ "tmux kill-session -t " <> name
+
+newSession :: SessionName -> Command
+newSession (SessionName name) =
+  Required $ "tmux new-session -d -s " <> name
+
+createAdminWindow :: SessionName -> Command
+createAdminWindow (SessionName name) =
+  Required $ "tmux split-window -v -t " <> name
+
+killAdminWindow :: SessionName -> Command
+killAdminWindow name =
+  sendKeys name "exit"

src/TmuxMate/Running.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module TmuxMate.Running where
+
+import Control.Exception
+import Data.List (intercalate, isPrefixOf)
+import Data.Maybe (catMaybes, listToMaybe)
+import System.Process
+import Text.Read
+import TmuxMate.Types
+
+-- "foo:yes Pane 2\nfoo:yes Pane 1\n"
+
+askRunning :: SessionName -> IO [Running]
+askRunning seshName = do
+  str <- catch readTmuxProcess (\(e :: IOError) -> pure "")
+  pure $ parseRunning seshName str
+
+-- ask Tmux what's cooking
+readTmuxProcess :: IO String
+readTmuxProcess =
+  readCreateProcess
+    (shell "tmux list-pane -as -F '#{session_name}:#{pane_index}:#{pane_start_command}'")
+    ""
+
+-- stop unrequired
+
+removeQuotes :: String -> String
+removeQuotes = (filter ((/=) '\''))
+
+wordsWhen :: (Char -> Bool) -> String -> [String]
+wordsWhen p s = case dropWhile p s of
+  "" -> []
+  s' -> w : wordsWhen p s''
+    where
+      (w, s'') = break p s'
+
+myLookup :: Int -> [a] -> Maybe a
+myLookup _ [] = Nothing
+myLookup 0 (x : _) = Just x
+myLookup i (_ : xs) = myLookup (i - 1) xs
+
+parseSingle :: String -> Maybe Running
+parseSingle str =
+  Running <$> seshName <*> cmd <*> index
+  where
+    seshName = myLookup 0 subStrs
+    index = myLookup 1 subStrs >>= readMaybe
+    cmd = case intercalate ":" (drop 2 subStrs) of
+      "" -> Nothing
+      a -> Just a
+    subStrs = wordsWhen (== ':') str
+
+parseRunning :: SessionName -> String -> [Running]
+parseRunning (SessionName seshName) as =
+  catMaybes (parseSingle <$> (lines as))

src/TmuxMate/Types.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module TmuxMate.Types where
+
+import Dhall (Decoder, FromDhall, ToDhall, autoWith)
+import GHC.Generics
+
+data IsNewSession
+  = NewSession
+  | OldSession
+
+data Session
+  = Session
+      { title :: SessionName,
+        panes :: [Pane]
+      }
+  deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall)
+
+newtype PaneCommand
+  = PaneCommand {getPaneCommand :: String}
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving newtype (ToDhall, FromDhall)
+
+newtype PaneTitle
+  = PaneTitle {getPaneTitle :: String}
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving newtype (ToDhall, FromDhall)
+
+data Pane
+  = Pane
+      { paneCommand :: PaneCommand,
+        paneTitle :: PaneTitle
+      }
+  deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall)
+
+newtype SessionName
+  = SessionName {getSessionName :: String}
+  deriving stock (Eq, Ord, Show, Generic)
+  deriving newtype (FromDhall, ToDhall)
+
+data Command
+  = Required String
+  | Optional String
+  deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall)
+
+data Running
+  = Running
+      { sessionName :: String,
+        cmd :: String,
+        index :: Int
+      }
+  deriving (Eq, Ord, Show)

stack.yaml

@@ -0,0 +1,66 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: nightly-2020-02-15
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+  - .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.1"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

stack.yaml.lock

@@ -0,0 +1,12 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages: []
+snapshots:
+- completed:
+    size: 488352
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/2/15.yaml
+    sha256: 3c4888f2d80a59256a11e4192fa2ed8f60ee9c23723d46cb5a2d83e40550fc63
+  original: nightly-2020-02-15

test/Spec.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+import Dhall
+import Dhall.Core (pretty)
+import Test.Hspec
+import Test.QuickCheck
+import Test.QuickCheck.Monadic
+import Tests.TmuxMate.Types (Session)
+import TmuxMate.Running
+import TmuxMate.Types (Running (..), SessionName (..))
+
+--quickCheck dhallSessionRoundtrip
+
+main :: IO ()
+main = hspec $ do
+  describe "ParseRunning" $ do
+    it "Rejects nonsense" $ do
+      parseSingle "sdfdsf" `shouldBe` Nothing
+    it "Accepts goodness" $ do
+      parseSingle "foo:1:yes Pane 1" `shouldBe` Just (Running "foo" "yes Pane 1" 1)
+    it "Accepts goodness with double colons inside" $ do
+      parseSingle "foo:1:yes Pane 1:2" `shouldBe` Just (Running "foo" "yes Pane 1:2" 1)
+    it "returns the original number when given a positive input" $
+      parseRunning (SessionName "foo") "0:0:\nfoo:0:yes Pane 2\nfoo:1:yes Pane 1\n"
+        `shouldBe` [Running "foo" "yes Pane 2" 0, Running "foo" "yes Pane 1" 1]
+  describe "Dhall" $ do
+    it "Round trips Dhall encoding" $ do
+      property dhallSessionRoundtrip
+
+dhallSessionRoundtrip :: Property
+dhallSessionRoundtrip =
+  monadicIO $ do
+    (sesh :: Session) <- pick arbitrary
+    let dhallVal = pretty (embed inject sesh)
+    let (decoder :: Decoder Session) = auto
+    decoded <- run $ input decoder dhallVal
+    assert $ decoded == sesh

test/Tests/TmuxMate/Types.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Tests.TmuxMate.Types
+  ( Session,
+  )
+where
+
+-- add arbitary types
+
+import GHC.Generics
+import Test.QuickCheck
+import Test.QuickCheck.Arbitrary.Generic
+import TmuxMate.Types
+
+-- helper
+
+newtype GenericArb a
+  = GenericArb {getGenericArb :: a}
+  deriving (Generic)
+
+instance (Generic a, Arbitrary a) => Arbitrary (GenericArb a) where
+  arbitrary = genericArbitrary
+
+-- helper
+
+instance Arbitrary Session where
+  arbitrary = genericArbitrary
+
+instance Arbitrary SessionName where
+  arbitrary = genericArbitrary
+
+instance Arbitrary Pane where
+  arbitrary = genericArbitrary
+
+instance Arbitrary PaneTitle where
+  arbitrary = oneof [pure (PaneTitle "title")]
+
+instance Arbitrary PaneCommand where
+  arbitrary = oneof [pure (PaneCommand "command")]

test/samples/Sample1.dhall

@@ -0,0 +1,9 @@
+{ title = "foo", 
+  panes =  [  {
+    paneCommand = "yes 'Pane 1'", paneTitle = "One"
+  },
+   {
+    paneCommand = "yes 'Pane 2'", paneTitle = "Two"
+   }
+  ]
+}

test/samples/Sample2.dhall

@@ -0,0 +1,12 @@
+{ title = "foo", 
+  panes =  [  {
+    paneCommand = "yes 'Pane 1'", paneTitle = "One"
+  },
+  {
+    paneCommand = "yes 'Pane 2'", paneTitle = "Two"
+  },
+   {
+    paneCommand = "yes 'Pane 3'", paneTitle = "Three"
+  }
+  ]
+}