From f18d1afe54a73b030e892a1834bcc4f947c4c2ef Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Tue, 23 Feb 2021 20:52:42 +0100
Subject: Buffer -> Hack.Buffer

---
 src/Hack/Buffer.hs        |   7 +++
 src/Hack/Buffer/Class.hs  |  13 ++++++
 src/Hack/Buffer/Motion.hs | 108 ++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 128 insertions(+)
 create mode 100644 src/Hack/Buffer.hs
 create mode 100644 src/Hack/Buffer/Class.hs
 create mode 100644 src/Hack/Buffer/Motion.hs

(limited to 'src/Hack')

diff --git a/src/Hack/Buffer.hs b/src/Hack/Buffer.hs
new file mode 100644
index 0000000..8e03eb7
--- /dev/null
+++ b/src/Hack/Buffer.hs
@@ -0,0 +1,7 @@
+module Hack.Buffer
+    ( module Hack.Buffer.Class
+    , module Hack.Buffer.Motion
+    ) where
+
+import Hack.Buffer.Class
+import Hack.Buffer.Motion
diff --git a/src/Hack/Buffer/Class.hs b/src/Hack/Buffer/Class.hs
new file mode 100644
index 0000000..3644717
--- /dev/null
+++ b/src/Hack/Buffer/Class.hs
@@ -0,0 +1,13 @@
+-- TODO Class is a lie
+module Hack.Buffer.Class where
+
+
+type Buffer = (String, String)
+
+emptyBuffer :: Buffer
+emptyBuffer = ("", "")
+
+
+-- TODO instance Show Buffer (w/newtype Buffer) (?)
+showBuffer :: Buffer -> String
+showBuffer (lhs, rhs) = lhs ++ rhs
diff --git a/src/Hack/Buffer/Motion.hs b/src/Hack/Buffer/Motion.hs
new file mode 100644
index 0000000..5ddddc9
--- /dev/null
+++ b/src/Hack/Buffer/Motion.hs
@@ -0,0 +1,108 @@
+module Hack.Buffer.Motion where
+
+import Data.List (dropWhileEnd)
+import Hack.Buffer.Class
+
+-- TODO factor Count
+-- TODO various Vim gX
+data Motion
+  = CharsBackward
+  | CharsForward
+  | ToStartOfLine
+  -- | GotoFirstNonBlankChar
+  | ToEndOfLine             -- XXX in Vi this can go downwards
+  | ToColumn
+  -- | GotoFindLeft (Char -> Bool)   -- TODO don't use functions here
+  -- | GotoFindRight (Char -> Bool)  -- TODO ^ dto.
+  -- | GotillFindLeft Char
+  -- | GotillFindRight Char
+  -- | RepeatLastFind
+  -- | RepeatLastFindReverse
+  | WordsForward
+  | WordsBackward
+  deriving (Show)
+
+
+-- TODO fail if cannot splitAt properly OR if we didn't modify the buffer
+gotoLeft :: Int -> Buffer -> 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 :: Int -> Buffer -> Buffer
+gotoRight i (ls, rs) =
+  let (lrs, rrs) = splitAt i rs in (ls ++ lrs, rrs)
+
+
+gotoFirstChar :: Buffer -> Buffer
+gotoFirstChar (ls, rs) = ("", ls ++ rs)
+
+
+gotoEndOfLine :: Buffer -> Buffer
+gotoEndOfLine (ls, rs) = (ls ++ rs, "")
+
+
+-- TODO fail if i <= 0 or i > length
+gotoColumn :: Int -> Buffer -> Buffer
+gotoColumn i (ls, rs) = splitAt (i - 1) $ ls ++ rs
+
+
+wordsForward :: Int -> Buffer -> Buffer
+wordsForward i (ls, rs) =
+  let rs' = dropWhile (==' ') $ dropWhile (/=' ') rs
+      ls' = ls ++ take (length rs - length rs') rs
+      b' = (ls', rs')
+  in
+    if i > 1
+      then wordsForward (i - 1) b'
+      else b'
+
+
+wordsBackward :: Int -> Buffer -> Buffer
+wordsBackward i (ls, rs) =
+  let ls' = dropWhileEnd (/=' ') $ dropWhileEnd (==' ') ls
+      rs' = drop (length ls') ls ++ rs
+      b' = (ls', rs')
+  in
+    if i > 1
+      then wordsBackward (i - 1) b'
+      else b'
+
+
+move :: Motion -> Int -> Buffer -> Buffer
+move CharsBackward c = gotoLeft c
+move CharsForward c = gotoRight c
+move ToStartOfLine _ = gotoFirstChar -- TODO use count
+move ToEndOfLine _ = gotoEndOfLine -- TODO use count
+move ToColumn c = gotoColumn c
+move WordsForward c = wordsForward c
+move WordsBackward c = wordsBackward c
+
+
+select :: Motion -> Int -> Buffer -> String
+select x i b =
+    if nls' < nls then take (nls - nls') rs' else
+    if nrs' < nrs then take (nrs - nrs') rs else
+    ""
+  where
+    (ls, rs) = b
+    (ls', rs') = move x i b
+    nls = length ls
+    nls' = length ls'
+    nrs = length rs
+    nrs' = length rs'
+
+
+delete :: Motion -> Int -> Buffer -> Buffer
+delete x i b =
+    ( if nls' < nls then ls' else ls
+    , if nrs' < nrs then rs' else rs
+    )
+  where
+    (ls, rs) = b
+    (ls', rs')= move x i b
+    nls = length ls
+    nls' = length ls'
+    nrs = length rs
+    nrs' = length rs'
-- 
cgit v1.2.3