mirror of
https://github.com/danieljharvey/tmux-mate.git
synced 2024-09-11 08:35:53 +03:00
Great
This commit is contained in:
parent
5194824efe
commit
6d3d7f2bee
1
.gitignore
vendored
1
.gitignore
vendored
@ -1,3 +1,4 @@
|
|||||||
|
.DS_Store
|
||||||
.stack-work/
|
.stack-work/
|
||||||
tmux-mate.cabal
|
tmux-mate.cabal
|
||||||
*~
|
*~
|
50
README.md
50
README.md
@ -2,23 +2,53 @@
|
|||||||
|
|
||||||
Manage your tmux sessions with the delicious power of Dhall.
|
Manage your tmux sessions with the delicious power of Dhall.
|
||||||
|
|
||||||
### Trying it
|
### Motivation
|
||||||
|
|
||||||
To use:
|
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!
|
||||||
|
|
||||||
`git clone https://github.com/danieljharvey/tmux-mate`
|
### Getting started
|
||||||
|
|
||||||
`cd tmux-mate`
|
```bash
|
||||||
|
# clone this repo
|
||||||
|
git clone https://github.com/danieljharvey/tmux-mate`
|
||||||
|
|
||||||
`stack install`
|
# enter the blessed folder
|
||||||
|
cd tmux-mate
|
||||||
|
|
||||||
`export TMUX_MATE_PATH='./test/samples/Sample1.dhall && tmux-mate`
|
# install tmux-mate using Haskell Stack (install instructions here: https://docs.haskellstack.org/en/stable/install_and_upgrade/)
|
||||||
|
# this will put tmux-mate-exe in your path
|
||||||
|
stack install
|
||||||
|
|
||||||
You should now see some garbage and your session.
|
# curse this terrible env var based API for passing config files and run tmux-mate
|
||||||
|
export TMUX_MATE_PATH='./samples/Sample1.dhall && tmux-mate-exe
|
||||||
|
```
|
||||||
|
|
||||||
### Making your own dhall files
|
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?
|
||||||
|
|
||||||
Look in `test/samples` for ideas.
|
```bash
|
||||||
|
# Run tmux-mate with the second sample script
|
||||||
|
export TMUX_MATE_PATH='./samples/Sample2.dhall && tmux-mate-exe
|
||||||
|
```
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
### Configuration
|
||||||
|
|
||||||
|
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:
|
||||||
|
|
||||||
|
```
|
||||||
|
{ sessionTitle : Text
|
||||||
|
, sessionWindows : List
|
||||||
|
{ windowTitle : Text
|
||||||
|
, windowPanes : List { paneCommand : Text }
|
||||||
|
}
|
||||||
|
}
|
||||||
|
```
|
||||||
|
|
||||||
|
A few rules
|
||||||
|
|
||||||
|
- All of the `sessionTitle` and `windowTitle` entries must be non-empty - they are used to manage the sessions internally.
|
||||||
|
- The session must contain at least one window, and each window must contain at least one pane.
|
||||||
|
|
||||||
### Requirements
|
### Requirements
|
||||||
|
|
||||||
@ -27,4 +57,4 @@ You will need a recent version of `tmux` installed. I tested on version 3, but I
|
|||||||
### Prior art
|
### Prior art
|
||||||
|
|
||||||
Very much inspired by [Tmuxinator](https://github.com/tmuxinator/tmuxinator), a
|
Very much inspired by [Tmuxinator](https://github.com/tmuxinator/tmuxinator), a
|
||||||
great project that doesn't *quite* do what I needed.
|
great project that doesn't _quite_ do what I needed.
|
||||||
|
11
app/Main.hs
11
app/Main.hs
@ -1,11 +1,18 @@
|
|||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
|
import System.Exit
|
||||||
import TmuxMate
|
import TmuxMate
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
path <- lookupEnv "TMUX_MATE_PATH"
|
path <- lookupEnv "TMUX_MATE_PATH"
|
||||||
case path of
|
case path of
|
||||||
Just dhallPath -> loadTestSession dhallPath
|
Just dhallPath -> do
|
||||||
Nothing -> putStrLn "Pass a valid path to TMUX_MATE_PATH pls"
|
didItWork <- loadTestSession dhallPath
|
||||||
|
case didItWork of
|
||||||
|
Yeah -> exitWith ExitSuccess
|
||||||
|
Nah i -> exitWith (ExitFailure i)
|
||||||
|
Nothing -> do
|
||||||
|
putStrLn "Pass a valid path to TMUX_MATE_PATH pls"
|
||||||
|
exitWith (ExitFailure 1)
|
||||||
|
@ -54,3 +54,4 @@ tests:
|
|||||||
- generic-arbitrary
|
- generic-arbitrary
|
||||||
- dhall
|
- dhall
|
||||||
- hspec
|
- hspec
|
||||||
|
- text
|
||||||
|
8
samples/MissingTitle.dhall
Normal file
8
samples/MissingTitle.dhall
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
{ sessionTitle = ""
|
||||||
|
, sessionWindows =
|
||||||
|
[ { windowTitle = "first-window"
|
||||||
|
, windowPanes =
|
||||||
|
[ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
8
samples/MissingWindowTitle.dhall
Normal file
8
samples/MissingWindowTitle.dhall
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
{ sessionTitle = "foo"
|
||||||
|
, sessionWindows =
|
||||||
|
[ { windowTitle = ""
|
||||||
|
, windowPanes =
|
||||||
|
[ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
7
samples/NoWindowPanes.dhall
Normal file
7
samples/NoWindowPanes.dhall
Normal file
@ -0,0 +1,7 @@
|
|||||||
|
{ sessionTitle = "foo"
|
||||||
|
, sessionWindows =
|
||||||
|
[ { windowTitle = "first-window"
|
||||||
|
, windowPanes = [] : List { paneCommand : Text }
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
8
samples/Sample1.dhall
Normal file
8
samples/Sample1.dhall
Normal file
@ -0,0 +1,8 @@
|
|||||||
|
{ sessionTitle = "foo"
|
||||||
|
, sessionWindows =
|
||||||
|
[ { windowTitle = "first-window"
|
||||||
|
, windowPanes =
|
||||||
|
[ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
14
samples/Sample2.dhall
Normal file
14
samples/Sample2.dhall
Normal file
@ -0,0 +1,14 @@
|
|||||||
|
-- here we are taking our first Dhall file and adding another window to it
|
||||||
|
let sample1 = ./Sample1.dhall
|
||||||
|
|
||||||
|
in { sessionTitle = sample1.sessionTitle
|
||||||
|
, sessionWindows =
|
||||||
|
sample1.sessionWindows
|
||||||
|
# [ { windowTitle = "second-window"
|
||||||
|
, windowPanes =
|
||||||
|
[ { paneCommand = "yes 'Pane 3'" }
|
||||||
|
, { paneCommand = "yes 'Pane 4'" }
|
||||||
|
]
|
||||||
|
}
|
||||||
|
]
|
||||||
|
}
|
4
samples/Schema.dhall
Normal file
4
samples/Schema.dhall
Normal file
@ -0,0 +1,4 @@
|
|||||||
|
{ sessionTitle : Text
|
||||||
|
, sessionWindows :
|
||||||
|
List { windowTitle : Text, windowPanes : List { paneCommand : Text } }
|
||||||
|
}
|
@ -3,14 +3,10 @@
|
|||||||
|
|
||||||
module TmuxMate
|
module TmuxMate
|
||||||
( loadTestSession,
|
( loadTestSession,
|
||||||
|
DidItWork (..),
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
import Data.List (nub)
|
|
||||||
import qualified Data.List.NonEmpty as NE
|
|
||||||
import Data.Maybe
|
|
||||||
import Data.Monoid (Any (..))
|
|
||||||
import qualified Dhall as Dhall
|
import qualified Dhall as Dhall
|
||||||
import System.Process
|
import System.Process
|
||||||
import TmuxMate.Commands
|
import TmuxMate.Commands
|
||||||
@ -29,46 +25,27 @@ runCommands =
|
|||||||
( \(Command a) -> callCommand a
|
( \(Command a) -> callCommand a
|
||||||
)
|
)
|
||||||
|
|
||||||
testSession :: Session
|
data DidItWork
|
||||||
testSession =
|
= Yeah
|
||||||
Session
|
| Nah Int
|
||||||
{ sessionTitle = SessionName "foo",
|
|
||||||
sessionWindows =
|
|
||||||
[ Window
|
|
||||||
{ windowTitle = WindowName "first-window",
|
|
||||||
windowPanes =
|
|
||||||
[ Pane (PaneCommand "yes 'Pane 1'"),
|
|
||||||
Pane (PaneCommand "yes 'Pane 2'"),
|
|
||||||
Pane (PaneCommand "yes 'Pane 3'"),
|
|
||||||
Pane (PaneCommand "yes 'Pane 4'")
|
|
||||||
]
|
|
||||||
},
|
|
||||||
Window
|
|
||||||
{ windowTitle = WindowName "second-window",
|
|
||||||
windowPanes =
|
|
||||||
[ Pane (PaneCommand "yes 'Second Window - Pane 1'"),
|
|
||||||
Pane (PaneCommand "yes 'Second Window - Pane 2'"),
|
|
||||||
Pane (PaneCommand "yes 'Second Window - Pane 3'"),
|
|
||||||
Pane (PaneCommand "yes 'Second Window - Pane 4'")
|
|
||||||
]
|
|
||||||
}
|
|
||||||
]
|
|
||||||
}
|
|
||||||
|
|
||||||
loadTestSession :: FilePath -> IO ()
|
loadTestSession :: FilePath -> IO DidItWork
|
||||||
loadTestSession path = do
|
loadTestSession path = do
|
||||||
--let (decoder :: Dhall.Decoder Session) = Dhall.auto
|
let (decoder :: Dhall.Decoder Session) = Dhall.auto
|
||||||
--- config <- Dhall.inputFile decoder path
|
config <- Dhall.inputFile decoder path
|
||||||
let config = testSession
|
|
||||||
case parseSession config of
|
case parseSession config of
|
||||||
Left e -> print e
|
Left e -> do
|
||||||
|
putStrLn $ "Error parsing config at " <> path
|
||||||
|
print e
|
||||||
|
pure (Nah 1)
|
||||||
Right config' -> do
|
Right config' -> do
|
||||||
tmuxState <- askTmuxState
|
tmuxState <- askTmuxState
|
||||||
print tmuxState
|
-- print tmuxState
|
||||||
let tmuxCommands = getTmuxCommands config' tmuxState
|
let tmuxCommands = getTmuxCommands config' tmuxState
|
||||||
putStrLn "Tmux Commands"
|
-- putStrLn "Tmux Commands"
|
||||||
print tmuxCommands
|
-- print tmuxCommands
|
||||||
let commands = getCommands tmuxCommands
|
let commands = getCommands tmuxCommands
|
||||||
putStrLn "Shell commands"
|
-- putStrLn "Shell commands"
|
||||||
print commands
|
-- print commands
|
||||||
runCommands commands
|
runCommands commands
|
||||||
|
pure Yeah
|
||||||
|
@ -10,7 +10,8 @@ sendKeys (VSessionName name) str =
|
|||||||
<> str
|
<> str
|
||||||
<> "\" ENTER"
|
<> "\" ENTER"
|
||||||
|
|
||||||
--
|
adminPaneName :: String
|
||||||
|
adminPaneName = "tmux-mate-admin"
|
||||||
|
|
||||||
-- turns our DSL into actual tmux commands
|
-- turns our DSL into actual tmux commands
|
||||||
createActualCommand :: TmuxCommand -> [Command]
|
createActualCommand :: TmuxCommand -> [Command]
|
||||||
@ -19,22 +20,22 @@ createActualCommand (CreateAdminPane (VSessionName seshName)) =
|
|||||||
"tmux split-window -v -t "
|
"tmux split-window -v -t "
|
||||||
<> NE.toList seshName
|
<> NE.toList seshName
|
||||||
createActualCommand (KillAdminPane seshName) =
|
createActualCommand (KillAdminPane seshName) =
|
||||||
[ Command $ "tmux select-window -t tmux-mate-admin",
|
[ Command $ "tmux select-window -t " <> adminPaneName,
|
||||||
sendKeys seshName "exit"
|
sendKeys seshName "exit"
|
||||||
]
|
]
|
||||||
createActualCommand (CreatePane seshName (VWindowName winName) cmd) =
|
createActualCommand (CreatePane _ (VWindowName winName) newCmd) =
|
||||||
[ Command $ "tmux select-window -t " <> NE.toList winName,
|
[ Command $ "tmux select-window -t " <> NE.toList winName,
|
||||||
Command $
|
Command $
|
||||||
"tmux split-window "
|
"tmux split-window "
|
||||||
<> (getCommand cmd),
|
<> (getCommand newCmd),
|
||||||
Command $ "tmux select-layout even-horizontal" -- for now let's stop it filling up
|
Command $ "tmux select-layout even-horizontal" -- for now let's stop it filling up
|
||||||
]
|
]
|
||||||
createActualCommand (KillPane seshName index) =
|
createActualCommand (KillPane seshName paneIndex) =
|
||||||
pure $
|
pure $
|
||||||
sendKeys
|
sendKeys
|
||||||
seshName
|
seshName
|
||||||
( "tmux kill-pane -t "
|
( "tmux kill-pane -t "
|
||||||
<> show index
|
<> show paneIndex
|
||||||
)
|
)
|
||||||
createActualCommand (AttachToSession (VSessionName seshName)) =
|
createActualCommand (AttachToSession (VSessionName seshName)) =
|
||||||
pure $ Command $
|
pure $ Command $
|
||||||
@ -48,10 +49,17 @@ createActualCommand (NewSession (VSessionName seshName)) =
|
|||||||
pure $ Command $
|
pure $ Command $
|
||||||
"tmux new-session -d -s "
|
"tmux new-session -d -s "
|
||||||
<> NE.toList seshName
|
<> NE.toList seshName
|
||||||
<> " -n tmux-mate-admin"
|
<> " -n "
|
||||||
createActualCommand (CreateWindow (VSessionName seshName) (VWindowName winName) (Command cmd)) =
|
<> adminPaneName
|
||||||
pure $ Command $
|
createActualCommand (CreateWindow _ (VWindowName winName) (Command newCmd)) =
|
||||||
"tmux new-window -n "
|
[ Command $
|
||||||
<> NE.toList winName
|
"tmux new-window -n "
|
||||||
<> " "
|
<> NE.toList winName
|
||||||
<> cmd
|
<> " "
|
||||||
|
<> newCmd
|
||||||
|
]
|
||||||
|
createActualCommand (KillWindow _ (VWindowName winName)) =
|
||||||
|
[ Command $
|
||||||
|
"tmux kill-window -t "
|
||||||
|
<> NE.toList winName
|
||||||
|
]
|
||||||
|
@ -3,8 +3,8 @@
|
|||||||
module TmuxMate.Running where
|
module TmuxMate.Running where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.List (intercalate, isPrefixOf)
|
import Data.List (intercalate)
|
||||||
import Data.Maybe (catMaybes, listToMaybe)
|
import Data.Maybe (catMaybes)
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Process
|
import System.Process
|
||||||
import Text.Read
|
import Text.Read
|
||||||
@ -13,16 +13,16 @@ import TmuxMate.Validate
|
|||||||
|
|
||||||
buildTmuxState :: IO TmuxState
|
buildTmuxState :: IO TmuxState
|
||||||
buildTmuxState = do
|
buildTmuxState = do
|
||||||
sessions <- askRunningSessions
|
sessions' <- askRunningSessions
|
||||||
running <- askRunning
|
running' <- askRunning
|
||||||
inTmux <- askIfWeAreInTmux
|
inTmux <- askIfWeAreInTmux
|
||||||
pure $ TmuxState inTmux running sessions
|
pure $ TmuxState inTmux running' sessions'
|
||||||
|
|
||||||
askTmuxState :: IO TmuxState
|
askTmuxState :: IO TmuxState
|
||||||
askTmuxState =
|
askTmuxState =
|
||||||
catch
|
catch
|
||||||
(buildTmuxState)
|
(buildTmuxState)
|
||||||
(\(e :: IOError) -> pure def)
|
(\(_ :: IOError) -> pure def)
|
||||||
where
|
where
|
||||||
def = TmuxState
|
def = TmuxState
|
||||||
{ inSession = NotInTmuxSession,
|
{ inSession = NotInTmuxSession,
|
||||||
@ -34,7 +34,7 @@ askTmuxState =
|
|||||||
|
|
||||||
askRunning :: IO [Running]
|
askRunning :: IO [Running]
|
||||||
askRunning = do
|
askRunning = do
|
||||||
str <- catch readTmuxProcess (\(e :: IOError) -> pure "")
|
str <- catch readTmuxProcess (\(_ :: IOError) -> pure "")
|
||||||
pure $ parseRunning str
|
pure $ parseRunning str
|
||||||
|
|
||||||
-- ask Tmux what's cooking
|
-- ask Tmux what's cooking
|
||||||
@ -47,7 +47,7 @@ readTmuxProcess =
|
|||||||
-- "foo/npoo/n0/n"
|
-- "foo/npoo/n0/n"
|
||||||
askRunningSessions :: IO [VSessionName]
|
askRunningSessions :: IO [VSessionName]
|
||||||
askRunningSessions = do
|
askRunningSessions = do
|
||||||
str <- catch readTmuxSessions (\(e :: IOError) -> pure "")
|
str <- catch readTmuxSessions (\(_ :: IOError) -> pure "")
|
||||||
pure $ catMaybes $
|
pure $ catMaybes $
|
||||||
( hush
|
( hush
|
||||||
. parseSessionName
|
. parseSessionName
|
||||||
@ -70,7 +70,7 @@ askIfWeAreInTmux = do
|
|||||||
case tmuxEnv of
|
case tmuxEnv of
|
||||||
Nothing -> pure NotInTmuxSession
|
Nothing -> pure NotInTmuxSession
|
||||||
Just "" -> pure NotInTmuxSession
|
Just "" -> pure NotInTmuxSession
|
||||||
Just a -> do
|
Just _ -> do
|
||||||
case (parseSessionName seshName) of
|
case (parseSessionName seshName) of
|
||||||
Right seshName' -> pure $ InTmuxSession seshName'
|
Right seshName' -> pure $ InTmuxSession seshName'
|
||||||
_ -> pure NotInTmuxSession
|
_ -> pure NotInTmuxSession
|
||||||
@ -104,20 +104,20 @@ parseSingle :: String -> Maybe Running
|
|||||||
parseSingle str =
|
parseSingle str =
|
||||||
Running
|
Running
|
||||||
<$> seshName
|
<$> seshName
|
||||||
<*> windowName
|
<*> windowName'
|
||||||
<*> cmd
|
<*> cmd'
|
||||||
<*> index
|
<*> index'
|
||||||
where
|
where
|
||||||
seshName =
|
seshName =
|
||||||
(SessionName <$> myLookup 0 subStrs)
|
(SessionName <$> myLookup 0 subStrs)
|
||||||
>>= (hush . parseSessionName)
|
>>= (hush . parseSessionName)
|
||||||
windowName =
|
windowName' =
|
||||||
(WindowName <$> myLookup 1 subStrs)
|
(WindowName <$> myLookup 1 subStrs)
|
||||||
>>= (hush . parseWindowName)
|
>>= (hush . parseWindowName)
|
||||||
index =
|
index' =
|
||||||
myLookup 2 subStrs
|
myLookup 2 subStrs
|
||||||
>>= readMaybe
|
>>= readMaybe
|
||||||
cmd = case intercalate ":" (drop 3 subStrs) of
|
cmd' = case intercalate ":" (drop 3 subStrs) of
|
||||||
"" -> Nothing
|
"" -> Nothing
|
||||||
a -> Just (PaneCommand a)
|
a -> Just (PaneCommand a)
|
||||||
subStrs = wordsWhen (== ':') str
|
subStrs = wordsWhen (== ':') str
|
||||||
|
@ -10,17 +10,11 @@ module TmuxMate.TmuxCommands
|
|||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
import Control.Exception
|
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import Data.Maybe
|
|
||||||
import Data.Monoid (Any (..))
|
import Data.Monoid (Any (..))
|
||||||
import qualified Dhall as Dhall
|
|
||||||
import System.Process
|
|
||||||
import TmuxMate.Commands
|
|
||||||
import TmuxMate.Running
|
import TmuxMate.Running
|
||||||
import TmuxMate.Types
|
import TmuxMate.Types
|
||||||
import TmuxMate.Validate
|
|
||||||
|
|
||||||
getTmuxCommands :: ValidatedSession -> TmuxState -> [TmuxCommand]
|
getTmuxCommands :: ValidatedSession -> TmuxState -> [TmuxCommand]
|
||||||
getTmuxCommands sesh tmuxState =
|
getTmuxCommands sesh tmuxState =
|
||||||
@ -36,46 +30,40 @@ getTmuxCommands sesh tmuxState =
|
|||||||
InTmuxSession sesh' -> sesh'
|
InTmuxSession sesh' -> sesh'
|
||||||
sWindows =
|
sWindows =
|
||||||
NE.toList (vSessionWindows sesh)
|
NE.toList (vSessionWindows sesh)
|
||||||
in {-case runningInTmux of
|
in (createSession runningInTmux sesh runningSessions)
|
||||||
NotInTmuxSession -> NE.tail (vSessionWindows sesh) -- first one is dealt with in invocation of session
|
|
||||||
InTmuxSession _ -> NE.toList (vSessionWindows sesh)-}
|
|
||||||
(createSession runningInTmux sesh runningSessions)
|
|
||||||
<> ( concatMap
|
<> ( concatMap
|
||||||
(createWindow sTitle runningPanes)
|
(createWindow sTitle runningPanes)
|
||||||
sWindows
|
sWindows
|
||||||
)
|
)
|
||||||
<> (removeWindowPanes sTitle runningPanes sWindows)
|
<> (removeWindowPanes sTitle runningPanes sWindows)
|
||||||
<> (removeWindows sTitle runningPanes sWindows)
|
<> (removeWindows sTitle runningPanes sWindows)
|
||||||
<> (removeAdminPane sTitle)
|
<> ( if needsNewSession runningInTmux sTitle runningSessions
|
||||||
|
then removeAdminPane sTitle
|
||||||
|
else []
|
||||||
|
)
|
||||||
<> [AttachToSession sTitle]
|
<> [AttachToSession sTitle]
|
||||||
|
|
||||||
-- create a new session if required
|
-- create a new session if required
|
||||||
createSession :: InTmuxSession -> ValidatedSession -> [VSessionName] -> [TmuxCommand]
|
createSession :: InTmuxSession -> ValidatedSession -> [VSessionName] -> [TmuxCommand]
|
||||||
createSession inTmux session _runningSesh =
|
createSession inTmux session runningSesh =
|
||||||
let seshName = vSessionTitle session
|
if needsNewSession inTmux (vSessionTitle session) runningSesh
|
||||||
in case inTmux of
|
then [NewSession (vSessionTitle session)]
|
||||||
InTmuxSession currentSesh -> [] -- AttachToSession currentSesh]
|
else []
|
||||||
NotInTmuxSession ->
|
|
||||||
if sessionExists seshName _runningSesh
|
|
||||||
then [AttachToSession seshName]
|
|
||||||
else
|
|
||||||
[ NewSession
|
|
||||||
seshName
|
|
||||||
]
|
|
||||||
|
|
||||||
sessionExists :: VSessionName -> [VSessionName] -> Bool
|
needsNewSession :: InTmuxSession -> VSessionName -> [VSessionName] -> Bool
|
||||||
sessionExists = elem
|
needsNewSession NotInTmuxSession seshName runningSesh = not (elem seshName runningSesh)
|
||||||
|
needsNewSession _ _ _ = False
|
||||||
|
|
||||||
-- do we need to create this window?
|
-- do we need to create this window?
|
||||||
createWindow :: VSessionName -> [Running] -> VWindow -> [TmuxCommand]
|
createWindow :: VSessionName -> [Running] -> VWindow -> [TmuxCommand]
|
||||||
createWindow seshName running window =
|
createWindow seshName running' window =
|
||||||
if windowExists seshName (vWindowTitle window) running
|
if windowExists seshName (vWindowTitle window) running'
|
||||||
then
|
then
|
||||||
createWindowPanes
|
createWindowPanes
|
||||||
seshName
|
seshName
|
||||||
(vWindowTitle window)
|
(vWindowTitle window)
|
||||||
(NE.toList $ vWindowPanes window)
|
(NE.toList $ vWindowPanes window)
|
||||||
running
|
running'
|
||||||
else
|
else
|
||||||
pure
|
pure
|
||||||
( CreateWindow
|
( CreateWindow
|
||||||
@ -87,25 +75,33 @@ createWindow seshName running window =
|
|||||||
seshName
|
seshName
|
||||||
(vWindowTitle window)
|
(vWindowTitle window)
|
||||||
(NE.tail $ vWindowPanes window)
|
(NE.tail $ vWindowPanes window)
|
||||||
running
|
running'
|
||||||
|
|
||||||
windowExists :: VSessionName -> VWindowName -> [Running] -> Bool
|
windowExists :: VSessionName -> VWindowName -> [Running] -> Bool
|
||||||
windowExists seshName winName running =
|
windowExists seshName winName running' =
|
||||||
length (filter (\a -> windowName a == winName && sessionName a == seshName) running) > 0
|
length
|
||||||
|
( filter
|
||||||
|
( \a ->
|
||||||
|
windowName a == winName
|
||||||
|
&& sessionName a == seshName
|
||||||
|
)
|
||||||
|
running'
|
||||||
|
)
|
||||||
|
> 0
|
||||||
|
|
||||||
-- create panes we need for a given window
|
-- create panes we need for a given window
|
||||||
createWindowPanes :: VSessionName -> VWindowName -> [Pane] -> [Running] -> [TmuxCommand]
|
createWindowPanes :: VSessionName -> VWindowName -> [Pane] -> [Running] -> [TmuxCommand]
|
||||||
createWindowPanes seshName windowName panes running =
|
createWindowPanes seshName windowName' panes running' =
|
||||||
( \pane ->
|
( \pane ->
|
||||||
CreatePane
|
CreatePane
|
||||||
seshName
|
seshName
|
||||||
windowName
|
windowName'
|
||||||
(paneCmdToCmd pane)
|
(paneCmdToCmd pane)
|
||||||
)
|
)
|
||||||
<$> filterPanes
|
<$> filterPanes
|
||||||
seshName
|
seshName
|
||||||
windowName
|
windowName'
|
||||||
running
|
running'
|
||||||
panes
|
panes
|
||||||
|
|
||||||
paneCmdToCmd :: Pane -> Command
|
paneCmdToCmd :: Pane -> Command
|
||||||
@ -114,7 +110,7 @@ paneCmdToCmd =
|
|||||||
|
|
||||||
-- work out what panes we need to create
|
-- work out what panes we need to create
|
||||||
filterPanes :: VSessionName -> VWindowName -> [Running] -> [Pane] -> [Pane]
|
filterPanes :: VSessionName -> VWindowName -> [Running] -> [Pane] -> [Pane]
|
||||||
filterPanes seshName winName running panes =
|
filterPanes seshName winName running' panes =
|
||||||
filter (\pane -> not $ matchCommand (removeQuotes (paneCommand pane))) panes
|
filter (\pane -> not $ matchCommand (removeQuotes (paneCommand pane))) panes
|
||||||
where
|
where
|
||||||
matchCommand str =
|
matchCommand str =
|
||||||
@ -125,7 +121,7 @@ filterPanes seshName winName running panes =
|
|||||||
&& seshName == seshName'
|
&& seshName == seshName'
|
||||||
&& winName == winName'
|
&& winName == winName'
|
||||||
)
|
)
|
||||||
running
|
running'
|
||||||
)
|
)
|
||||||
> 0
|
> 0
|
||||||
|
|
||||||
@ -133,23 +129,23 @@ filterPanes seshName winName running panes =
|
|||||||
-- removing stuff again
|
-- removing stuff again
|
||||||
|
|
||||||
removeWindowPanes :: VSessionName -> [Running] -> [VWindow] -> [TmuxCommand]
|
removeWindowPanes :: VSessionName -> [Running] -> [VWindow] -> [TmuxCommand]
|
||||||
removeWindowPanes seshName running windows =
|
removeWindowPanes seshName running' windows =
|
||||||
(\(Running _ _ _ i) -> KillPane seshName i)
|
(\(Running _ _ _ i) -> KillPane seshName i)
|
||||||
<$> (filterRunning seshName windows running)
|
<$> (filterRunning seshName windows running')
|
||||||
|
|
||||||
filterRunning :: VSessionName -> [VWindow] -> [Running] -> [Running]
|
filterRunning :: VSessionName -> [VWindow] -> [Running] -> [Running]
|
||||||
filterRunning seshName windows running =
|
filterRunning seshName windows running' =
|
||||||
filter
|
filter
|
||||||
( \(Running seshName' winName' run _) ->
|
( \(Running seshName' _ run _) ->
|
||||||
not $
|
not $
|
||||||
anyMatch (removeQuotes run) windows
|
anyMatch (removeQuotes run) windows
|
||||||
&& seshName == seshName'
|
&& seshName == seshName'
|
||||||
)
|
)
|
||||||
running
|
running'
|
||||||
where
|
where
|
||||||
anyMatch :: PaneCommand -> [VWindow] -> Bool
|
anyMatch :: PaneCommand -> [VWindow] -> Bool
|
||||||
anyMatch str windows' =
|
anyMatch str windows' =
|
||||||
getAny (foldMap (matchCommand str) windows)
|
getAny (foldMap (matchCommand str) windows')
|
||||||
matchCommand :: PaneCommand -> VWindow -> Any
|
matchCommand :: PaneCommand -> VWindow -> Any
|
||||||
matchCommand str window =
|
matchCommand str window =
|
||||||
Any $
|
Any $
|
||||||
@ -163,7 +159,7 @@ filterRunning seshName windows running =
|
|||||||
> 0
|
> 0
|
||||||
|
|
||||||
removeWindows :: VSessionName -> [Running] -> [VWindow] -> [TmuxCommand]
|
removeWindows :: VSessionName -> [Running] -> [VWindow] -> [TmuxCommand]
|
||||||
removeWindows seshName running windows =
|
removeWindows seshName running' windows =
|
||||||
( \winTitle' ->
|
( \winTitle' ->
|
||||||
KillWindow
|
KillWindow
|
||||||
seshName
|
seshName
|
||||||
@ -178,7 +174,14 @@ removeWindows seshName running windows =
|
|||||||
requiredWindowNames =
|
requiredWindowNames =
|
||||||
vWindowTitle <$> windows
|
vWindowTitle <$> windows
|
||||||
runningWindowNames =
|
runningWindowNames =
|
||||||
nub $ windowName <$> filter (\(Running sesh' win' _ _) -> sesh' == seshName) running
|
nub $
|
||||||
|
windowName
|
||||||
|
<$> filter
|
||||||
|
( \(Running sesh' _ _ _) ->
|
||||||
|
sesh'
|
||||||
|
== seshName
|
||||||
|
)
|
||||||
|
running'
|
||||||
|
|
||||||
-- remove admin window (always)
|
-- remove admin window (always)
|
||||||
|
|
||||||
|
@ -6,7 +6,7 @@
|
|||||||
module TmuxMate.Types where
|
module TmuxMate.Types where
|
||||||
|
|
||||||
import Data.List.NonEmpty
|
import Data.List.NonEmpty
|
||||||
import Dhall (Decoder, FromDhall, ToDhall, autoWith)
|
import Dhall (FromDhall, ToDhall)
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
|
|
||||||
data InTmuxSession
|
data InTmuxSession
|
||||||
@ -71,7 +71,6 @@ data TmuxCommand
|
|||||||
| AttachToSession VSessionName
|
| AttachToSession VSessionName
|
||||||
| KillSession VSessionName
|
| KillSession VSessionName
|
||||||
| NewSession VSessionName
|
| NewSession VSessionName
|
||||||
| SendKeys VSessionName String
|
|
||||||
deriving (Eq, Ord, Show, Generic)
|
deriving (Eq, Ord, Show, Generic)
|
||||||
|
|
||||||
newtype Command
|
newtype Command
|
||||||
@ -93,7 +92,16 @@ data ValidationError
|
|||||||
| NoWindows
|
| NoWindows
|
||||||
| EmptyWindowName
|
| EmptyWindowName
|
||||||
| WindowWithNoPanes VWindowName
|
| WindowWithNoPanes VWindowName
|
||||||
deriving (Eq, Ord, Show)
|
deriving (Eq, Ord)
|
||||||
|
|
||||||
|
instance Show ValidationError where
|
||||||
|
show EmptySessionName = "Session title must not be an empty string."
|
||||||
|
show NoWindows = "Session must contain at least one window."
|
||||||
|
show EmptyWindowName = "All windows must have a non-empty title."
|
||||||
|
show (WindowWithNoPanes (VWindowName name)) =
|
||||||
|
"Window '"
|
||||||
|
<> toList name
|
||||||
|
<> "' does not have any panes! All windows must contain at least one pane."
|
||||||
|
|
||||||
newtype VSessionName
|
newtype VSessionName
|
||||||
= VSessionName {getVSessionName :: NonEmpty Char}
|
= VSessionName {getVSessionName :: NonEmpty Char}
|
||||||
|
@ -47,6 +47,10 @@ extra-deps:
|
|||||||
# Override default flag values for local packages and extra-deps
|
# Override default flag values for local packages and extra-deps
|
||||||
# flags: {}
|
# flags: {}
|
||||||
|
|
||||||
|
ghc-options:
|
||||||
|
# All packages
|
||||||
|
"$locals": -Wall
|
||||||
|
|
||||||
# Extra package databases containing global packages
|
# Extra package databases containing global packages
|
||||||
# extra-package-dbs: []
|
# extra-package-dbs: []
|
||||||
|
|
||||||
|
15
test/Spec.hs
15
test/Spec.hs
@ -1,6 +1,9 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import qualified Data.Text.IO as Text.IO
|
||||||
import Dhall
|
import Dhall
|
||||||
import Dhall.Core (pretty)
|
import Dhall.Core (pretty)
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
@ -9,7 +12,6 @@ import Test.QuickCheck.Monadic
|
|||||||
import qualified Tests.TmuxMate.TmuxCommands as TmuxCommands
|
import qualified Tests.TmuxMate.TmuxCommands as TmuxCommands
|
||||||
import Tests.TmuxMate.Types (Session)
|
import Tests.TmuxMate.Types (Session)
|
||||||
import qualified Tests.TmuxMate.Validate as Validate
|
import qualified Tests.TmuxMate.Validate as Validate
|
||||||
import TmuxMate
|
|
||||||
import TmuxMate.Running
|
import TmuxMate.Running
|
||||||
import TmuxMate.Types
|
import TmuxMate.Types
|
||||||
|
|
||||||
@ -52,10 +54,13 @@ main = hspec $ do
|
|||||||
(PaneCommand "yes Pane 1")
|
(PaneCommand "yes Pane 1")
|
||||||
1
|
1
|
||||||
]
|
]
|
||||||
|
describe "Dhall" $ do
|
||||||
{-describe "Dhall" $ do
|
it "Round trips Dhall encoding" $ do
|
||||||
it "Round trips Dhall encoding" $ do
|
property dhallSessionRoundtrip
|
||||||
property dhallSessionRoundtrip -}
|
it "Generates a Dhall schema that matches our advertised one" $ do
|
||||||
|
let schema = (Dhall.Core.pretty (Dhall.expected (Dhall.auto @Session)))
|
||||||
|
savedSchema <- Text.IO.readFile "./samples/Schema.dhall"
|
||||||
|
Text.stripEnd schema `shouldBe` Text.stripEnd savedSchema
|
||||||
|
|
||||||
dhallSessionRoundtrip :: Property
|
dhallSessionRoundtrip :: Property
|
||||||
dhallSessionRoundtrip =
|
dhallSessionRoundtrip =
|
||||||
|
@ -4,12 +4,6 @@ module Tests.TmuxMate.TmuxCommands where
|
|||||||
|
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.QuickCheck
|
|
||||||
import Test.QuickCheck.Monadic
|
|
||||||
import Tests.TmuxMate.Types (Session)
|
|
||||||
import qualified Tests.TmuxMate.Validate as Validate
|
|
||||||
import TmuxMate
|
|
||||||
import TmuxMate.Running
|
|
||||||
import TmuxMate.TmuxCommands
|
import TmuxMate.TmuxCommands
|
||||||
import TmuxMate.Types
|
import TmuxMate.Types
|
||||||
|
|
||||||
@ -36,12 +30,12 @@ spec = do
|
|||||||
sampleSession
|
sampleSession
|
||||||
[]
|
[]
|
||||||
`shouldBe` []
|
`shouldBe` []
|
||||||
it "Attaches to session if it already exists" $ do
|
it "Does nothing if session already exists" $ do
|
||||||
createSession
|
createSession
|
||||||
NotInTmuxSession
|
NotInTmuxSession
|
||||||
sampleSession
|
sampleSession
|
||||||
[VSessionName $ NE.fromList "horses"]
|
[VSessionName $ NE.fromList "horses"]
|
||||||
`shouldBe` [AttachToSession (VSessionName $ NE.fromList "horses")]
|
`shouldBe` [] -- AttachToSession (VSessionName $ NE.fromList "horses")]
|
||||||
it "Creates a session if we are not in tmux and session is not running" $ do
|
it "Creates a session if we are not in tmux and session is not running" $ do
|
||||||
createSession NotInTmuxSession sampleSession []
|
createSession NotInTmuxSession sampleSession []
|
||||||
`shouldBe` [NewSession (VSessionName $ NE.fromList "horses")]
|
`shouldBe` [NewSession (VSessionName $ NE.fromList "horses")]
|
||||||
|
@ -2,6 +2,7 @@
|
|||||||
{-# LANGUAGE DerivingVia #-}
|
{-# LANGUAGE DerivingVia #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module Tests.TmuxMate.Types
|
module Tests.TmuxMate.Types
|
||||||
( Session,
|
( Session,
|
||||||
|
@ -1,14 +1,7 @@
|
|||||||
module Tests.TmuxMate.Validate where
|
module Tests.TmuxMate.Validate where
|
||||||
|
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import Dhall
|
|
||||||
import Dhall.Core (pretty)
|
|
||||||
import Test.Hspec
|
import Test.Hspec
|
||||||
import Test.QuickCheck
|
|
||||||
import Test.QuickCheck.Monadic
|
|
||||||
import Tests.TmuxMate.Types (Session)
|
|
||||||
import TmuxMate
|
|
||||||
import TmuxMate.Running
|
|
||||||
import TmuxMate.Types
|
import TmuxMate.Types
|
||||||
import TmuxMate.Validate
|
import TmuxMate.Validate
|
||||||
|
|
||||||
|
@ -1,4 +0,0 @@
|
|||||||
{ sessionTitle = "foo"
|
|
||||||
, sessionPanes =
|
|
||||||
[ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
|
|
||||||
}
|
|
@ -1,6 +0,0 @@
|
|||||||
-- here we are taking our first Dhall file and adding another item to it
|
|
||||||
let sample1 = ./Sample1.dhall
|
|
||||||
|
|
||||||
in { sessionTitle = sample1.sessionTitle
|
|
||||||
, sessionPanes = sample1.sessionPanes # [ { paneCommand = "yes 'Pane 3'" } ]
|
|
||||||
}
|
|
Loading…
Reference in New Issue
Block a user