Main: add Delete{Left,Right} commands

1 files changed, 39 insertions, 0 deletions

diff --git a/src/Main.hs b/src/Main.hs
index b7a5ebf..71d5cd7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -157,6 +157,8 @@ data Command
   | SetCount (Maybe Int)
   | SetRegister Char
   | DeleteEntireLine
+  | DeleteLeft
+  | DeleteRight
 
 instance Monoid Command where
     mempty = Nop
@@ -347,6 +349,41 @@ execCommand DeleteEntireLine =
           & registers %~ (at r .~ v) .
                          (at defaultRegister .~ v)
 
+execCommand DeleteLeft =
+    modify $ \q -> do
+        let c = maybe 1 id $ _count q
+            r = -- TODO only use "- if we're deleting less than one line
+                if _register q == defaultRegister
+                    then '-' -- smallDeleteRegister
+                    else _register q
+
+            lhs = fst (_buffer q)
+            (lhs', y) = splitAt (length lhs - c) lhs
+
+
+        q & buffer . _1 .~ lhs'
+          & register .~ defaultRegister
+          & registers %~ (at r .~ Just y)
+                       . (at defaultRegister .~ Just y)
+
+execCommand DeleteRight =
+    modify $ \q -> do
+        let c = maybe 1 id $ _count q
+            r = -- TODO only use "- if we're deleting less than one line
+                if _register q == defaultRegister
+                    then '-' -- smallDeleteRegister
+                    else _register q
+
+            rhs = snd (_buffer q)
+            (y, rhs') = splitAt c rhs
+
+
+        q & buffer . _2 .~ rhs'
+          & register .~ defaultRegister
+          & registers %~ (at r .~ Just y)
+                       . (at defaultRegister .~ Just y)
+
+
 
 -- XXX assumes that the cursor is already at the (cleared) input line
 -- TODO renderInputLine looks like it wants to be -> VT ()
@@ -444,6 +481,8 @@ dmap :: Keymap
 dmap =
   [ ("\ESC", ChangeMode NormalMode <> SetCount Nothing)
   , ("d", DeleteEntireLine <> ChangeMode NormalMode <> SetCount Nothing)
+  , ("h", DeleteLeft <> ChangeMode NormalMode <> SetCount Nothing)
+  , ("l", DeleteRight <> ChangeMode NormalMode <> SetCount Nothing)
   ]