1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module WordsSpec (spec) where
import Test.Hspec
import Test.QuickCheck
import Data.Char
import Data.Text.Zipper
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Zipper.Generic.Words
spec :: Spec
spec = do
constructorSpec
insertCharSpec
insertManySpec
moveWordLeftSpec
moveWordRightSpec
deletePrevWordSpec
deleteWordSpec
constructorSpec :: Spec
constructorSpec = describe "constructor" $ do
it "inserts only printable characters at construction time" $
(stringZipper ["abc\x1b def"] Nothing) `shouldBe` (stringZipper ["abc def"] Nothing)
insertCharSpec :: Spec
insertCharSpec = describe "insertChar" $ do
it "ignores an insert of a non-printable character" $
let z = stringZipper [] Nothing
in (insertChar '\x1b' z) `shouldBe` z
insertManySpec :: Spec
insertManySpec = describe "insertMany" $ do
it "ignores an insert of a non-printable character" $
let z = stringZipper ["abc"] Nothing
in (insertMany "ghi\x1bjkl" z) `shouldBe` (insertMany "ghijkl" z)
moveWordLeftSpec :: Spec
moveWordLeftSpec = describe "moveWordLeft" $ do
it "does nothing at the start of the text" $
moveWordLeft (zipLoc ["foo bar"] (0, 0)) `isAt` (0, 0)
it "moves from middle of the word to the start" $
moveWordLeft (zipLoc ["foo barfoo"] (0, 7)) `isAt` (0, 4)
it "moves from end to beginning" $
moveWordLeft (zipLoc ["barfoo"] (0, 6)) `isAt` (0, 0)
it "stops at beginning of line if word boundary" $
moveWordLeft (zipLoc ["foo", "bar"] (1, 2)) `isAt` (1, 0)
it "moves across lines from beginning of line" $
moveWordLeft (zipLoc ["foo", "bar"] (1, 0)) `isAt` (0, 0)
it "skips multiple space characters" $
moveWordLeft (zipLoc ["foo bar"] (0, 6)) `isAt` (0, 0)
it "skips multiple space characters across lines" $
moveWordLeft (zipLoc ["foo ", " bar"] (1, 1)) `isAt` (0, 0)
it "always lands on the start of a word" $ property $ \(textlist :: [Text]) cursor ->
isAtWordStart (moveWordLeft (zipLoc textlist cursor))
moveWordRightSpec :: Spec
moveWordRightSpec = describe "moveWordRight" $ do
it "does nothing at the end of the text" $
moveWordRight (zipLoc ["foo bar"] (0, 7)) `isAt` (0, 7)
it "moves from middle of the word to its end" $
moveWordRight (zipLoc ["barfoo foo"] (0, 2)) `isAt`(0, 6)
it "moves from beginning to end" $
moveWordRight (zipLoc ["barfoo"] (0, 0)) `isAt` (0, 6)
it "stops at end of line if word boundary" $
moveWordRight (zipLoc ["foo", "bar"] (0, 1)) `isAt` (0, 3)
it "moves across lines from end of line" $
moveWordRight (zipLoc ["foo", "bar"] (0, 3)) `isAt` (1, 3)
it "skips multiple space characters" $
moveWordRight (zipLoc ["foo bar"] (0, 4)) `isAt` (0, 10)
it "skips multiple space characters across lines" $
moveWordRight (zipLoc ["foo ", " bar"] (0, 4)) `isAt` (1, 5)
it "always lands at the end of a word" $ property $ \(textlist :: [Text]) cursor ->
isAtWordEnd (moveWordRight (zipLoc textlist cursor))
deletePrevWordSpec :: Spec
deletePrevWordSpec = describe "deletePrevWord" $ do
it "does the same cursor movement as moveWordLeft" $ property $ \(textlist :: [Text]) cursor ->
let zip = zipLoc textlist cursor
in deletePrevWord zip `isAt` (cursorPosition (moveWordLeft zip))
it "has the same prefix than moveWordLeft" $ property $ \textlist cursor ->
let zip = zipLoc textlist cursor
in deleteToEnd (deletePrevWord zip) === deleteToEnd (moveWordLeft zip)
it "has the same suffix than before" $ property $ \textlist cursor ->
let zip = zipLoc textlist cursor
in deleteToBeginning (deletePrevWord zip) === deleteToBeginning zip
deleteWordSpec :: Spec
deleteWordSpec = describe "deleteWord" $ do
it "does no cursor movement" $ property $ \textlist cursor ->
let zip = zipLoc textlist cursor
in deleteWord zip `isAt` cursorPosition zip
it "has the same prefix than before" $ property $ \textlist cursor ->
let zip = zipLoc textlist cursor
in deleteToEnd (deleteWord zip) === deleteToEnd zip
it "has the same suffix than moveWordRight" $ property $ \textlist cursor ->
let zip = zipLoc textlist cursor
in deleteToBeginning (deleteWord zip) === deleteToBeginning (moveWordRight zip)
-- Helpers
-- | Creates a zipper with initial content and cursor location
zipLoc :: [Text] -> (Int, Int) -> TextZipper Text
zipLoc content location = moveCursor location $ textZipper content Nothing
-- | Set the expectation that the given zipper is at the given cursor
-- location
isAt :: TextZipper a -> (Int, Int) -> Expectation
isAt zipper loc = cursorPosition zipper `shouldBe` loc
isAtWordEnd :: TextZipper Text -> Property
isAtWordEnd zipper = counterexample (show zipper) $
let
(row, col) = cursorPosition zipper
numLines = length (getText zipper)
curLine = currentLine zipper
in
(col == T.length curLine && row == numLines - 1)
|| ((col == T.length curLine || isSpace (T.index curLine col)) -- next is space
&& (col == 0 || not (isSpace (T.index curLine (col-1))))) -- previous is word
isAtWordStart :: TextZipper Text -> Property
isAtWordStart zipper = counterexample (show zipper) $
let
(row, col) = cursorPosition zipper
curLine = currentLine zipper
in
(row == 0 && col == 0)
|| ((col == 0 || isSpace (T.index curLine (col-1))) -- previous is space
&& (col == T.length curLine || not (isSpace (T.index curLine col)))) -- next is word
-- | Delete to the very end of a zipper
deleteToEnd :: TextZipper Text -> TextZipper Text
deleteToEnd zipper =
let
(row, _) = cursorPosition zipper
numLines = length (getText zipper)
in
if row == numLines-1 then
killToEOL zipper
else
deleteToEnd (deleteChar (killToEOL zipper))
deleteToBeginning :: TextZipper Text -> TextZipper Text
deleteToBeginning zipper = case cursorPosition zipper of
(0, _) -> killToBOL zipper
_ -> deleteToBeginning (deletePrevChar (killToBOL zipper))
instance Arbitrary Text where
arbitrary = do
ls <- lines <$> arbitrary
return $ T.pack $ case ls of
(l:_) -> l
_ -> mempty
|
