Add windowArrangement to schema (#18)

* Add windowArrangement to schema

* New command added to Dhall

* Output schema when it doesn't match saved one

* Explanation of schema

* My lord it works

* Remove mentions of old layouts

* Remove unrequired pragma

README.md

@@ -38,10 +38,12 @@ This project uses [Dhall](https://dhall-lang.org/) files for configuration. Ther
 
 ```
 { sessionTitle : Text
-, sessionWindows : List
-  { windowTitle : Text
-  , windowPanes : List { paneCommand : Text }
-  }
+, sessionWindows :
+    List
+      { windowTitle : Text
+      , windowPanes : List { paneCommand : Text }
+      , windowArrangement : Text
+      }
 }
 ```
 
@@ -49,6 +51,10 @@ 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.
+- `windowArrangement` is one of `tmux`'s options `tiled`, `even-horizontal`,
+  `even-vertical`, `main-horizontal` and `main-vertical`. Info on what those
+mean in the [man page](http://man7.org/linux/man-pages/man1/tmux.1.html) -
+search for `select-layout` for info.
 
 ### Options
 

samples/MissingTitle.dhall

@@ -1,6 +1,7 @@
 { sessionTitle = ""
 , sessionWindows =
   [ { windowTitle = "first-window"
+    , windowArrangement = "tiled"
     , windowPanes =
       [ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
     }

samples/MissingWindowTitle.dhall

@@ -1,6 +1,7 @@
 { sessionTitle = "foo"
 , sessionWindows =
   [ { windowTitle = ""
+    , windowArrangement = "tiled"
     , windowPanes =
       [ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
     }

samples/NoWindowPanes.dhall

@@ -1,6 +1,7 @@
 { sessionTitle = "foo"
 , sessionWindows =
   [ { windowTitle = "first-window"
+    , windowArrangement = "even-horizontal"
     , windowPanes = [] : List { paneCommand : Text }
     }
   ]

samples/Sample1.dhall

@@ -2,7 +2,11 @@
 , sessionWindows =
   [ { windowTitle = "first-window"
     , windowPanes =
-      [ { paneCommand = "yes 'Pane 1'" }, { paneCommand = "yes 'Pane 2'" } ]
+      [ { paneCommand = "yes 'Pane 0'" }
+      , { paneCommand = "yes 'Pane 1'" }
+      , { paneCommand = "yes 'Pane 2'" }
+      ]
+    , windowArrangement = "even-horizontal"
     }
   ]
 }

samples/Sample2.dhall

@@ -5,9 +5,12 @@ in  { sessionTitle = sample1.sessionTitle
     , sessionWindows =
           sample1.sessionWindows
         # [ { windowTitle = "second-window"
+            , windowArrangement = "tiled"
             , windowPanes =
               [ { paneCommand = "yes 'Pane 3'" }
               , { paneCommand = "yes 'Pane 4'" }
+              , { paneCommand = "yes 'Pane 5'" }
+              , { paneCommand = "yes 'Pane 6'" }
               ]
             }
           ]

samples/Schema.dhall

@@ -1,4 +1,8 @@
 { sessionTitle : Text
 , sessionWindows :
-    List { windowTitle : Text, windowPanes : List { paneCommand : Text } }
+    List
+      { windowTitle : Text
+      , windowPanes : List { paneCommand : Text }
+      , windowArrangement : Text
+      }
 }

src/TmuxMate/Commands.hs

@@ -23,13 +23,16 @@ createActualCommand (KillAdminPane seshName) =
   [ Command $ "tmux select-window -t " <> adminPaneName,
     sendKeys seshName "exit"
   ]
-createActualCommand (CreatePane _ (VWindowName winName) newCmd) =
-  [ Command $ "tmux select-window -t " <> (quoteAndEscape . NE.toList) winName,
-    Command $
-      "tmux split-window "
-        <> (quoteAndEscape . getCommand) newCmd,
-    Command $ "tmux select-layout even-horizontal" -- for now let's stop it filling up
-  ]
+createActualCommand (CreatePane _ (VWindowName winName) arrangement newCmd) =
+  let windowName' = (quoteAndEscape . NE.toList) winName
+   in [ Command $ "tmux select-window -t " <> windowName',
+        Command $
+          "tmux split-window "
+            <> (quoteAndEscape . getCommand) newCmd,
+        Command $
+          "tmux select-layout -t " <> windowName' <> " "
+            <> (showPaneArrangement arrangement)
+      ]
 createActualCommand (KillPane seshName paneIndex) =
   pure $
     sendKeys
@@ -64,6 +67,13 @@ createActualCommand (KillWindow _ (VWindowName winName)) =
         <> (quoteAndEscape . NE.toList) winName
   ]
 
+showPaneArrangement :: VPaneArrangement -> String
+showPaneArrangement Tiled = "tiled"
+showPaneArrangement EvenHorizontal = "even-horizontal"
+showPaneArrangement EvenVertical = "even-vertical"
+showPaneArrangement MainHorizontal = "main-horizontal"
+showPaneArrangement MainVertical = "main-vertical"
+
 quote :: String -> String
 quote s = "\"" <> s <> "\""
 

src/TmuxMate/TmuxCommands.hs

@@ -63,6 +63,7 @@ createWindow seshName running' window =
       createWindowPanes
         seshName
         (vWindowTitle window)
+        (vWindowArrangement window)
         (NE.toList $ vWindowPanes window)
         running'
     else
@@ -75,6 +76,7 @@ createWindow seshName running' window =
         <> createWindowPanes
           seshName
           (vWindowTitle window)
+          (vWindowArrangement window)
           (NE.tail $ vWindowPanes window)
           running'
 
@@ -91,12 +93,14 @@ windowExists seshName winName running' =
     > 0
 
 -- create panes we need for a given window
-createWindowPanes :: VSessionName -> VWindowName -> [Pane] -> [Running] -> [TmuxCommand]
-createWindowPanes seshName windowName' panes running' =
+createWindowPanes ::
+  VSessionName -> VWindowName -> VPaneArrangement -> [Pane] -> [Running] -> [TmuxCommand]
+createWindowPanes seshName windowName' arrange panes running' =
   ( \pane ->
       CreatePane
         seshName
         windowName'
+        arrange
         (paneCmdToCmd pane)
   )
     <$> filterPanes

src/TmuxMate/Types.hs

@@ -27,6 +27,11 @@ data IsNewSession
   = IsNewSession
   | IsOldSession
 
+newtype PaneArrangement
+  = PaneArrangement {getPaneArrangement :: String}
+  deriving stock (Eq, Ord, Generic)
+  deriving newtype (Show, ToDhall, FromDhall)
+
 data Session
   = Session
       { sessionTitle :: SessionName,
@@ -37,7 +42,8 @@ data Session
 data Window
   = Window
       { windowTitle :: WindowName,
-        windowPanes :: [Pane]
+        windowPanes :: [Pane],
+        windowArrangement :: PaneArrangement
       }
   deriving (Eq, Ord, Show, Generic, FromDhall, ToDhall)
 
@@ -65,7 +71,7 @@ newtype WindowName
 data TmuxCommand
   = CreateAdminPane VSessionName
   | KillAdminPane VSessionName
-  | CreatePane VSessionName VWindowName Command
+  | CreatePane VSessionName VWindowName VPaneArrangement Command
   | KillPane VSessionName Int
   | CreateWindow VSessionName VWindowName Command
   | KillWindow VSessionName VWindowName
@@ -118,6 +124,14 @@ newtype VSessionName
   deriving stock (Eq, Ord, Generic)
   deriving (Show) via NicelyPrintedNonEmpty
 
+data VPaneArrangement
+  = EvenHorizontal
+  | EvenVertical
+  | MainHorizontal
+  | MainVertical
+  | Tiled
+  deriving (Eq, Ord, Show, Generic)
+
 data ValidatedSession
   = ValidatedSession
       { vSessionTitle :: VSessionName,
@@ -133,7 +147,8 @@ newtype VWindowName
 data VWindow
   = VWindow
       { vWindowTitle :: VWindowName,
-        vWindowPanes :: NonEmpty Pane
+        vWindowPanes :: NonEmpty Pane,
+        vWindowArrangement :: VPaneArrangement
       }
   deriving (Eq, Ord, Show, Generic)
 
@@ -143,8 +158,7 @@ data Verbosity
   = Silent
   | Chatty
   | DryRun
-  deriving
-    (Eq, Ord, Show)
+  deriving (Eq, Ord, Show)
 
 newtype ConfigFilePath
   = ConfigFilePath {getConfigFilePath :: String}

src/TmuxMate/Validate.hs

@@ -1,5 +1,6 @@
 module TmuxMate.Validate where
 
+import Data.Char (toLower)
 import qualified Data.List as L
 import Data.List.NonEmpty
 import TmuxMate.Types
@@ -11,10 +12,11 @@ parseSession :: Session -> Either ValidationError ValidatedSession
 parseSession sesh = do
   windows <- parseSessionWindows (sessionWindows sesh)
   seshTitle <- parseSessionName (sessionTitle sesh)
-  pure $ ValidatedSession
-    { vSessionTitle = seshTitle,
-      vSessionWindows = windows
-    }
+  pure $
+    ValidatedSession
+      { vSessionTitle = seshTitle,
+        vSessionWindows = windows
+      }
 
 parseSessionName :: SessionName -> Either ValidationError VSessionName
 parseSessionName (SessionName str) =
@@ -45,7 +47,17 @@ parseWindow :: Window -> Either ValidationError VWindow
 parseWindow window = do
   name <- parseWindowName (windowTitle window)
   panes <- parseWindowPanes name (windowPanes window)
-  pure $ VWindow
-    { vWindowTitle = name,
-      vWindowPanes = panes
-    }
+  pure $
+    VWindow
+      { vWindowTitle = name,
+        vWindowPanes = panes,
+        vWindowArrangement = case (fmap toLower)
+          . getPaneArrangement
+          . windowArrangement
+          $ window of
+          "even-horizontal" -> EvenHorizontal
+          "even-vertical" -> EvenVertical
+          "main-horizontal" -> MainHorizontal
+          "main-vertical" -> MainVertical
+          _ -> Tiled
+      }

test/Spec.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
+import Control.Monad (when)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text.IO
@@ -60,6 +61,12 @@ main = hspec $ do
     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"
+      when
+        (Text.stripEnd schema /= Text.stripEnd savedSchema)
+        ( do
+            putStrLn "Generated schema:"
+            Text.IO.putStrLn schema
+        )
       Text.stripEnd schema `shouldBe` Text.stripEnd savedSchema
 
 dhallSessionRoundtrip :: Property

test/Tests/TmuxMate/TmuxCommands.hs

@@ -8,16 +8,18 @@ import TmuxMate.TmuxCommands
 import TmuxMate.Types
 
 sampleSession :: ValidatedSession
-sampleSession = ValidatedSession
-  { vSessionTitle = VSessionName $ NE.fromList "horses",
-    vSessionWindows =
-      NE.fromList
-        [ VWindow
-            { vWindowTitle = VWindowName $ NE.fromList "window",
-              vWindowPanes = undefined
-            }
-        ]
-  }
+sampleSession =
+  ValidatedSession
+    { vSessionTitle = VSessionName $ NE.fromList "horses",
+      vSessionWindows =
+        NE.fromList
+          [ VWindow
+              { vWindowTitle = VWindowName $ NE.fromList "window",
+                vWindowArrangement = Tiled,
+                vWindowPanes = undefined
+              }
+          ]
+    }
 
 spec :: Spec
 spec = do
@@ -45,8 +47,10 @@ spec = do
         (VSessionName $ NE.fromList "horses")
         []
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` pure
           ( CreateWindow
@@ -64,8 +68,10 @@ spec = do
             0
         ]
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` [ ( CreateWindow
                          (VSessionName $ NE.fromList "horses")
@@ -83,8 +89,10 @@ spec = do
             0
         ]
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` []
     it "Adds second pane to existing window" $ do
@@ -97,12 +105,15 @@ spec = do
             0
         ]
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "whoa")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "whoa")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` [ CreatePane
                        (VSessionName $ NE.fromList "horses")
                        (VWindowName $ NE.fromList "window")
+                       Tiled
                        (Command "whoa")
                    ]
     it "Creates a pane if something matches, but it's in another window" $ do
@@ -120,12 +131,15 @@ spec = do
             0
         ]
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` [ CreatePane
                        (VSessionName $ NE.fromList "horses")
                        (VWindowName $ NE.fromList "window")
+                       Tiled
                        (Command "go")
                    ]
     it "Ignores panes that already exist" $ do
@@ -143,8 +157,10 @@ spec = do
             0
         ]
         ( VWindow
-            (VWindowName (NE.fromList "window"))
-            $ NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "yo")]
+            { vWindowTitle = VWindowName (NE.fromList "window"),
+              vWindowPanes = NE.fromList [Pane (PaneCommand "go"), Pane (PaneCommand "yo")],
+              vWindowArrangement = Tiled
+            }
         )
         `shouldBe` []
   describe "removeWindowPanes" $ do
@@ -154,8 +170,10 @@ spec = do
         (VSessionName (NE.fromList "horses"))
         []
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList [Pane (PaneCommand "go")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` []
@@ -170,8 +188,10 @@ spec = do
             0
         ]
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList [Pane (PaneCommand "go")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` []
@@ -186,8 +206,10 @@ spec = do
             24
         ]
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList [Pane (PaneCommand "whoa-no")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes = NE.fromList [Pane (PaneCommand "whoa-no")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` [KillPane (VSessionName (NE.fromList "horses")) 24]
@@ -207,8 +229,10 @@ spec = do
             24
         ]
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList [Pane (PaneCommand "whoa-no")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes = NE.fromList [Pane (PaneCommand "whoa-no")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` [KillPane (VSessionName (NE.fromList "horses")) 24]
@@ -219,8 +243,10 @@ spec = do
         (VSessionName (NE.fromList "horses"))
         []
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList [Pane (PaneCommand "go")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes = NE.fromList [Pane (PaneCommand "go")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` []
@@ -235,9 +261,12 @@ spec = do
             10
         ]
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList
-                [Pane (PaneCommand "go")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes =
+                  NE.fromList
+                    [Pane (PaneCommand "go")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` [ KillWindow
@@ -260,9 +289,12 @@ spec = do
             10
         ]
         [ ( VWindow
-              (VWindowName (NE.fromList "window"))
-              $ NE.fromList
-                [Pane (PaneCommand "go")]
+              { vWindowTitle = VWindowName (NE.fromList "window"),
+                vWindowPanes =
+                  NE.fromList
+                    [Pane (PaneCommand "go")],
+                vWindowArrangement = Tiled
+              }
           )
         ]
         `shouldBe` []

test/Tests/TmuxMate/Types.hs

@@ -33,6 +33,19 @@ instance Arbitrary Session where
 instance Arbitrary Window where
   arbitrary = genericArbitrary
 
+instance Arbitrary VPaneArrangement where
+  arbitrary = genericArbitrary
+
+instance Arbitrary PaneArrangement where
+  arbitrary =
+    oneof
+      [ pure (PaneArrangement "tiled"),
+        pure (PaneArrangement "even-vertical"),
+        pure (PaneArrangement "even-horizontal"),
+        pure (PaneArrangement "main-vertical"),
+        pure (PaneArrangement "main-horizontal")
+      ]
+
 instance Arbitrary WindowName where
   arbitrary = oneof [pure (WindowName "window-name")]
 

test/Tests/TmuxMate/Validate.hs

@@ -9,64 +9,84 @@ spec :: Spec
 spec = do
   describe "Validating Session to VSession" $ do
     it "Fails on an empty name" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "",
-              sessionWindows =
-                [ Window
-                    { windowTitle = WindowName "OK",
-                      windowPanes = [Pane {paneCommand = PaneCommand ""}]
-                    }
-                ]
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "",
+                sessionWindows =
+                  [ Window
+                      { windowTitle = WindowName "OK",
+                        windowPanes = [Pane {paneCommand = PaneCommand ""}],
+                        windowArrangement = PaneArrangement "Tiled"
+                      }
+                  ]
+              }
       parseSession sesh
         `shouldBe` Left EmptySessionName
     it "Fails on just a newline" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "\n",
-              sessionWindows =
-                [ Window
-                    { windowTitle = WindowName "OK",
-                      windowPanes = [Pane {paneCommand = PaneCommand ""}]
-                    }
-                ]
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "\n",
+                sessionWindows =
+                  [ Window
+                      { windowTitle = WindowName "OK",
+                        windowPanes = [Pane {paneCommand = PaneCommand ""}],
+                        windowArrangement = PaneArrangement "Tiled"
+                      }
+                  ]
+              }
       parseSession sesh
         `shouldBe` Left EmptySessionName
     it "Fails with no windows" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "Whoa",
-              sessionWindows = []
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "Whoa",
+                sessionWindows = []
+              }
       parseSession sesh
         `shouldBe` Left NoWindows
     it "Fails with empty window name" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "Whoa",
-              sessionWindows =
-                [ Window
-                    { windowTitle = WindowName "",
-                      windowPanes = [Pane {paneCommand = PaneCommand ""}]
-                    }
-                ]
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "Whoa",
+                sessionWindows =
+                  [ Window
+                      { windowTitle = WindowName "",
+                        windowPanes = [Pane {paneCommand = PaneCommand ""}],
+                        windowArrangement = PaneArrangement "Tiled"
+                      }
+                  ]
+              }
       parseSession sesh
         `shouldBe` Left EmptyWindowName
     it "Fails on a newline" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "Whoa",
-              sessionWindows =
-                [ Window
-                    { windowTitle = WindowName "\n",
-                      windowPanes = [Pane {paneCommand = PaneCommand ""}]
-                    }
-                ]
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "Whoa",
+                sessionWindows =
+                  [ Window
+                      { windowTitle = WindowName "\n",
+                        windowPanes = [Pane {paneCommand = PaneCommand ""}],
+                        windowArrangement = PaneArrangement "Tiled"
+                      }
+                  ]
+              }
       parseSession sesh
         `shouldBe` Left EmptyWindowName
     it "Fails with no window panes" $ do
-      let sesh = Session
-            { sessionTitle = SessionName "Whoa",
-              sessionWindows = [Window {windowTitle = WindowName "empty-boy", windowPanes = []}]
-            }
+      let sesh =
+            Session
+              { sessionTitle = SessionName "Whoa",
+                sessionWindows =
+                  [ Window
+                      { windowTitle =
+                          WindowName "empty-boy",
+                        windowPanes = [],
+                        windowArrangement = PaneArrangement "Tiled"
+                      }
+                  ]
+              }
       parseSession sesh
-        `shouldBe` Left (WindowWithNoPanes (VWindowName $ NE.fromList "empty-boy"))
+        `shouldBe` Left
+          ( WindowWithNoPanes
+              (VWindowName $ NE.fromList "empty-boy")
+          )