add Buffer.{Class,Motion} modules

2 files changed, 95 insertions, 0 deletions

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