@@ -0,0 +1,71 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Reflex.Vty.Widget.Text where
3+
4+import Data.Text (Text)
5+import qualified Data.Text as T
6+
7+-- | A zipper of the logical text input contents. The lines before the line containing the cursor
8+-- are stored in reverse order. The cursor is logically _between_ the "before" and "after" text.
9+data TextZipper = TextZipper
10+ { _textZipper_linesBefore :: [Text] -- reversed
11+ , _textZipper_before :: Text
12+ , _textZipper_after :: Text -- The cursor is on top of the first character of this text
13+ , _textZipper_linesAfter :: [Text]
14+ }
15+ deriving (Show)
16+
17+left :: TextZipper -> TextZipper
18+left z@(TextZipper lb b a la) = case T.unsnoc b of
19+ Nothing -> case lb of
20+ [] -> z
21+ (l:ls) -> TextZipper ls l "" (a : la)
22+ Just (b', c) -> TextZipper lb b' (T.cons c a) la
23+
24+right :: TextZipper -> TextZipper
25+right z@(TextZipper lb b a la) = case T.uncons a of
26+ Nothing -> case la of
27+ [] -> z
28+ (l:ls) -> TextZipper (b : lb) "" l ls
29+ Just (c, a') -> TextZipper lb (T.snoc b c) a' la
30+
31+up :: TextZipper -> TextZipper
32+up z@(TextZipper lb b a la) = case lb of
33+ [] -> z
34+ (l:ls) ->
35+ let (b', a') = T.splitAt (T.length b) l
36+ in TextZipper ls b' a' ((b <> a) : la)
37+
38+down :: TextZipper -> TextZipper
39+down z@(TextZipper lb b a la) = case la of
40+ [] -> z
41+ (l:ls) ->
42+ let (b', a') = T.splitAt (T.length b) l
43+ in TextZipper ((b <> a) : lb) b' a' ls
44+
45+home :: TextZipper -> TextZipper
46+home (TextZipper lb b a la) = TextZipper lb "" (b <> a) la
47+
48+end :: TextZipper -> TextZipper
49+end (TextZipper lb b a la) = TextZipper lb (b <> a) "" la
50+
51+top :: TextZipper -> TextZipper
52+top (TextZipper lb b a la) = case reverse lb of
53+ [] -> TextZipper [] "" (b <> a) la
54+ (start:rest) -> TextZipper [] "" start (rest <> la)
55+
56+insert :: Text -> TextZipper -> TextZipper
57+insert i z@(TextZipper lb b a la) = case T.split (=='\n') i of
58+ [] -> z
59+ (start:rest) -> case reverse rest of
60+ [] -> TextZipper lb (b <> start) a la
61+ (l:ls) -> TextZipper (ls <> [b <> start] <> lb) l a la
62+
63+value :: TextZipper -> Text
64+value (TextZipper lb b a la) = T.intercalate "\n" $ mconcat
65+ [ reverse lb
66+ , [b <> a]
67+ , la
68+ ]
69+
70+empty :: TextZipper
71+empty = TextZipper [] "" "" []