From c3e9446f79998b78cfe47aec26baa148403d8dfa Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Sun, 27 Jul 2014 15:11:38 +0200
Subject: add Buffer.{Class,Motion} modules

---
 Buffer.hs        |  7 +++++
 Buffer/Class.hs  |  6 ++++
 Buffer/Motion.hs | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 Main.hs          | 32 ++++++++++----------
 4 files changed, 117 insertions(+), 17 deletions(-)
 create mode 100644 Buffer.hs
 create mode 100644 Buffer/Class.hs
 create mode 100644 Buffer/Motion.hs

diff --git a/Buffer.hs b/Buffer.hs
new file mode 100644
index 0000000..43d222e
--- /dev/null
+++ b/Buffer.hs
@@ -0,0 +1,7 @@
+module Buffer
+    ( module Buffer.Class
+    , module Buffer.Motion
+    ) where
+
+import Buffer.Class
+import Buffer.Motion
diff --git a/Buffer/Class.hs b/Buffer/Class.hs
new file mode 100644
index 0000000..b2770b1
--- /dev/null
+++ b/Buffer/Class.hs
@@ -0,0 +1,6 @@
+-- TODO Class is a lie
+module Buffer.Class where
+
+type Buffer = (String, String)
+
+emptyBuffer = ("", "")
diff --git a/Buffer/Motion.hs b/Buffer/Motion.hs
new file mode 100644
index 0000000..3918e1b
--- /dev/null
+++ b/Buffer/Motion.hs
@@ -0,0 +1,89 @@
+module Buffer.Motion where
+
+import Data.List (dropWhileEnd)
+import Buffer.Class
+
+--data Motion = Motion Int LeftRightMotion
+
+
+-- TODO factor Count
+-- TODO various Vim gX
+data LeftRightMotion
+  = GotoLeft Int
+  | GotoRight Int
+  | GotoFirstChar
+  -- | GotoFirstNonBlankChar
+  | GotoEndOfLine             -- XXX in Vi this can go downwards
+  | GotoColumn Int
+  | GotoFindLeft Int Char 
+  | GotoFindRight Int Char
+  | GotillFindLeft Int Char
+  | GotillFindRight Int Char
+  -- | RepeatLastFind Int
+  -- | RepeatLastFindReverse Int
+
+-- TODO fail if cannot splitAt properly OR if we didn't modify the buffer
+gotoLeft i (ls, rs) =
+  let (lls, rls) = splitAt (length ls - i) ls in (lls, rls ++ rs)
+
+-- TODO fail if cannot splitAt properly OR if we didn't modify the buffer
+gotoRight i (ls, rs) =
+  let (lrs, rrs) = splitAt i rs in (ls ++ lrs, rrs)
+
+gotoFirstChar (ls, rs) = ("", ls ++ rs)
+
+gotoEndOfLine (ls, rs) = (ls ++ rs, "")
+
+-- TODO fail if i <= 0 or i > length
+gotoColumn i (ls, rs) = splitAt (i - 1) $ ls ++ rs
+
+-- TODO is this definition correct?
+spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
+spanEnd p xs = let ls = dropWhileEnd p xs in (ls, drop (length ls) xs)
+
+-- TODO don't allow i == 0 in go{to,till}Find{Left,Right}
+
+gotoFindLeft i c b@(ls, rs) 
+  | i == 0 = b
+  | i > 0 = 
+    let (lls, rls) = spanEnd (/= c) ls
+    in gotoFindLeft (i - 1) c (init lls, last lls : rls ++ rs)
+
+gotoFindRight i c b@(ls, rs) 
+  | i == 0 = b
+  | i > 0 = 
+    let (lrs, rrs) = span (/= c) rs
+    in gotoFindRight (i - 1) c (ls ++ lrs ++ [head rrs], tail rrs)
+
+-- TODO this has to fail it there aren't enought c's
+gotillFindLeft i c b@(ls, rs) =
+    let (lls, rls) = spanEnd (/= c) ls
+    in
+        if i > 1
+            then gotillFindLeft (i - 1) c (init lls, last lls : rls ++ rs)
+            else (lls, rls ++ rs)
+
+--gotillFindRight i c b@(ls, rs) 
+--  | i == 0 = b
+--  | i > 0 = 
+--    let (lrs, rrs) = span (/= c) rs
+--    in gotoFindRight (i - 1) c (ls ++ lrs, rrs)
+
+gotillFindRight i c b@(ls, rs) =
+    let (lrs, rrs) = span (/= c) rs
+    in
+        if i > 1
+            then gotillFindRight (i - 1) c (ls ++ lrs ++ [head rrs], tail rrs)
+            else (ls ++ lrs, rrs)
+
+
+move :: LeftRightMotion -> Buffer -> Buffer
+move (GotoLeft i) = gotoLeft i
+move (GotoRight i) = gotoRight i
+move GotoFirstChar = gotoFirstChar
+move GotoEndOfLine = gotoEndOfLine
+move (GotoColumn i) = gotoColumn i
+move (GotoFindLeft i c) = gotoFindLeft i c
+move (GotoFindRight i c) = gotoFindRight i c
+move (GotillFindLeft i c) = gotillFindLeft i c
+move (GotillFindRight i c) = gotillFindRight i c
diff --git a/Main.hs b/Main.hs
index ac0b236..484f72f 100644
--- a/Main.hs
+++ b/Main.hs
@@ -19,6 +19,8 @@ import Control.Monad.Error
 import Control.Monad.Writer
 import Control.Monad.State
 
+import Buffer
+
 
 data VTState = VTState
     { buffer :: Buffer
@@ -28,10 +30,6 @@ data VTState = VTState
 emptyState = VTState emptyBuffer (NormalMode nmap)
 
 
-type Buffer = (String, String)
-
-emptyBuffer = ("", "")
-
 
 main :: IO ()
 main = do
@@ -172,35 +170,40 @@ runExecCommand st (ExecM ex) =
 
 
 
+insertChar c (ls, rs) = (ls ++ [c], rs)
+
+
 execCommand :: Command -> ExecM ()
 
 execCommand GotoBOL =
-    modifyBuffer $ \(lhs, rhs) -> ("", lhs ++ rhs)
+    modifyBuffer (move GotoFirstChar)
 
 execCommand GotoEOL =
-    modifyBuffer $ \(lhs, rhs) -> (lhs ++ rhs, "")
+    modifyBuffer (move GotoEndOfLine)
 
 execCommand MoveCursorLeft = do
     get >>= flip (when . null . fst . buffer)
                  (throwError $ OtherError "no char to move left")
-    modifyBuffer $ \(lhs, rhs) -> (init lhs, last lhs : rhs)
+    modifyBuffer (move $ GotoLeft 1)
 
 execCommand MoveCursorRight = do
     get >>= flip (when . null . snd . buffer)
                  (throwError $ OtherError "no char to move right")
-    modifyBuffer $ \(lhs, rhs) -> (lhs ++ [head rhs], tail rhs)
+    modifyBuffer (move $ GotoRight 1)
 
 execCommand (InsertChar c) =
-    modifyBuffer $ \(lhs, rhs) -> (lhs ++ [c], rhs)
+    modifyBuffer (insertChar c)
 
 execCommand (InsertCharThenChangeMode c m) =
     modify $ \ q -> q
-      { buffer = (\(lhs, rhs) -> (lhs ++ [c], rhs)) $ buffer q
-      , mode = m
+      { mode = m
+      , buffer = insertChar c (buffer q)
       }
 
 execCommand InsertNextCharVerbatim =
-    modify $ \ q -> q { mode = VerbatimMode }
+    modify $ \ q -> q
+      { mode = VerbatimMode
+      }
 
 execCommand ExecuteInputBuffer = do
     b <- gets buffer
@@ -290,11 +293,6 @@ ringBell = putStr "\x07" -- BEL '\a'
 moveCursorLeft 0 = return ()
 moveCursorLeft i = putStr $ "\x1b[" ++ show i ++ "D"
 
-moveCursorRight 0 = return ()
-moveCursorRight i = putStr $ "\x1b[" ++ show i ++ "C"
-
-clearLineFromCursorRight = putStr "\x1b[0K"
-
 
 -- TODO? charToCode c = "\\x" ++ showHex (ord c)
 charToCode c = "\\x" ++ showIntAtBase 16 intToDigit (ord c) ""
-- 
cgit v1.2.3