cursor-gen 0.1.0.0 → 0.2.0.0
raw patch · 5 files changed
+93/−78 lines, 5 filesdep ~cursorPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: cursor
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−0
- cursor-gen.cabal +6/−4
- src/Cursor/TextField/Gen.hs +3/−2
- test/Cursor/TextFieldSpec.hs +48/−43
- test/Cursor/TextSpec.hs +28/−29
+ CHANGELOG.md view
@@ -0,0 +1,8 @@+# Changelog++## [Unreleased]++## [0.2.0.0] - 2019-09-23++* Fixed the generator for `TextFieldCursor` to be compatible with the new validity constraint in cursor-0.2.0.0.+* Fixed the shrinking function for `TextFieldCursor`.
cursor-gen.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack ----- hash: f0096dc28a739f287cb2c184cec92b05547e888c6a4d33724be642b1f80124b2+-- hash: 0b391e9de9acd52641e27e356268ffac18998a48a689258da3a53a8cb083571d name: cursor-gen-version: 0.1.0.0+version: 0.2.0.0 synopsis: Generators for Purely Functional Cursors description: Generators for Purely Functional Cursors for common data structures category: Cursor@@ -18,6 +18,8 @@ license: MIT license-file: LICENSE build-type: Simple+extra-source-files:+ CHANGELOG.md library hs-source-dirs:@@ -27,7 +29,7 @@ QuickCheck , base <5 , containers- , cursor+ , cursor >=0.2 , genvalidity >=0.8 , genvalidity-containers , genvalidity-text >=0.6
src/Cursor/TextField/Gen.hs view
@@ -3,6 +3,7 @@ module Cursor.TextField.Gen where import qualified Data.Text as T+import qualified Data.Text.Internal as T import Data.GenValidity @@ -16,10 +17,10 @@ instance GenValid TextFieldCursor where genValid = do- let charGen = genValid `suchThat` (/= '\n')+ let charGen = genValid `suchThat` (/= '\n') `suchThat` (\c -> T.safe c == c) prevs <- genListOf $ T.pack <$> genListOf charGen nexts <- genListOf $ T.pack <$> genListOf charGen cur <- textCursorWithGen charGen let nec = NonEmptyCursor prevs cur nexts pure $ TextFieldCursor nec- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ shrinkValid = shrinkValidStructurally
test/Cursor/TextFieldSpec.hs view
@@ -22,6 +22,7 @@ import Control.Monad +import Cursor.List.NonEmpty import Cursor.TextField import Cursor.TextField.Gen () import Cursor.Types@@ -30,20 +31,41 @@ spec = do eqSpecOnValid @TextFieldCursor genValidSpec @TextFieldCursor- describe "makeTextFieldCursor" $+ describe "Validity TextFieldCursor" $ do+ it "consider a textfield with a newline in the previous lines invalid" $+ forAllValid $ \tc ->+ shouldBeInvalid $+ TextFieldCursor+ { textFieldCursorNonEmpty =+ NonEmptyCursor+ {nonEmptyCursorPrev = ["\n"], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = []}+ }+ it "consider a textfield with a newline in the next lines invalid" $+ forAllValid $ \tc ->+ shouldBeInvalid $+ TextFieldCursor+ { textFieldCursorNonEmpty =+ NonEmptyCursor+ {nonEmptyCursorPrev = [], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = ["\n"]}+ }+ describe "makeTextFieldCursor" $ do+ it "produces a valid cursor for \"\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n"+ it "produces a valid cursor for \"\\n\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n\n" it "produces valid cursors" $ producesValidsOnValids makeTextFieldCursor describe "makeTextFieldCursorWithSelection" $ do- it "produces valid cursors" $- producesValidsOnValids3 makeTextFieldCursorWithSelection- it- "is the inverse of rebuildTextFieldCursor when using the current selection" $+ it "produces a valid cursor for \"\\n\"" $+ forAllValid $ \x ->+ forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n"+ it "produces a valid cursor for \"\\n\\n\"" $+ forAllValid $ \x ->+ forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n\n"+ it "produces valid cursors" $ producesValidsOnValids3 makeTextFieldCursorWithSelection+ it "is the inverse of rebuildTextFieldCursor when using the current selection" $ forAllValid $ \tfc -> do let (x, y) = textFieldCursorSelection tfc t = rebuildTextFieldCursor tfc case makeTextFieldCursorWithSelection x y t of- Nothing ->- expectationFailure- "makeTextFieldCursorWithSelection should not have failed."+ Nothing -> expectationFailure "makeTextFieldCursorWithSelection should not have failed." Just tfc' -> unless (tfc' == tfc) $ expectationFailure $@@ -58,21 +80,18 @@ , show t ] describe "rebuildTextFieldCursorLines" $ do- it "produces valid lists" $- producesValidsOnValids rebuildTextFieldCursorLines+ it "produces valid lists" $ producesValidsOnValids rebuildTextFieldCursorLines it "produces texts without newlines" $ forAllValid $ \tfc -> do let ls = NE.toList $ rebuildTextFieldCursorLines tfc unless (all (T.all (/= '\n')) ls) $ expectationFailure $- unlines $- "Some of the following lines contain a newline:" : map show ls+ unlines $ "Some of the following lines contain a newline:" : map show ls describe "rebuildTextFieldCursor" $ do it "produces valid texts" $ producesValidsOnValids rebuildTextFieldCursor- it "is the inverse of makeTextFieldCursor for integers" $+ it "is the inverse of makeTextFieldCursor" $ inverseFunctionsOnValid makeTextFieldCursor rebuildTextFieldCursor- it- "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $+ it "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $ forAllValid $ \x -> forAllValid $ \y -> inverseFunctionsIfFirstSucceedsOnValid@@ -80,43 +99,34 @@ rebuildTextFieldCursor describe "textFieldCursorSelection" $ it "produces valid tuples" $ producesValidsOnValids textFieldCursorSelection- describe "emptyTextFieldCursor" $- it "is valid" $ shouldBeValid emptyTextFieldCursor- describe "nullTextFieldCursor" $- it "produces valid" $ producesValidsOnValids nullTextFieldCursor+ describe "emptyTextFieldCursor" $ it "is valid" $ shouldBeValid emptyTextFieldCursor+ describe "nullTextFieldCursor" $ it "produces valid" $ producesValidsOnValids nullTextFieldCursor describe "textFieldCursorSelectPrevLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectPrevLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectPrevLine it "is a movement" $ isMovementM textFieldCursorSelectPrevLine it "selects the previous line" pending describe "textFieldCursorSelectNextLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectNextLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectNextLine it "is a movement" $ isMovementM textFieldCursorSelectNextLine it "selects the next line" pending describe "textFieldCursorSelectFirstLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectFirstLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectFirstLine it "is a movement" $ isMovement textFieldCursorSelectFirstLine it "is idempotent" $ idempotentOnValid textFieldCursorSelectFirstLine it "selects the first line" pending describe "textFieldCursorSelectLastLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectLastLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectLastLine it "is a movement" $ isMovement textFieldCursorSelectLastLine it "is idempotent" $ idempotentOnValid textFieldCursorSelectLastLine it "selects the last line" pending describe "textFieldCursorSelectPrevChar" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectPrevChar+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectPrevChar it "selects the previous character on the current line" pending describe "textFieldCursorSelectNextChar" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectNextChar+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectNextChar it "selects the previous character on the current line" pending describe "textFieldCursorIndexOnLine" $ do- it "produces valid indices" $- producesValidsOnValids textFieldCursorIndexOnLine+ it "produces valid indices" $ producesValidsOnValids textFieldCursorIndexOnLine it "returns the index on the current line" pending describe "textFieldCursorSelectIndexOnLine" $ do it "produces valid cursors for any index" $@@ -131,12 +141,10 @@ forAllValid $ \d -> producesValidsOnValids (textFieldCursorAppendChar d) it "inserts a character after the cursor on the currrent line" pending describe "textFieldCursorInsertNewline" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorInsertNewline+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorInsertNewline it "inserts a new line" pending describe "textFieldCursorAppendNewline" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorAppendNewline+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorAppendNewline describe "textFieldCursorRemove" $ do it "produces valid cursors" $ producesValidsOnValids textFieldCursorRemove it "removes empty text field cursor" $@@ -148,12 +156,10 @@ textFieldCursorDelete emptyTextFieldCursor `shouldBe` Just Deleted it "deletes a character or a line" pending describe "textFieldCursorSelectStartOfLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectStartOfLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectStartOfLine it "selects the start of the current line" pending describe "textFieldCursorSelectEndOfLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectEndOfLine+ it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectEndOfLine it "selects the end of the current line" pending isMovementM :: (TextFieldCursor -> Maybe TextFieldCursor) -> Property@@ -175,5 +181,4 @@ isMovement :: (TextFieldCursor -> TextFieldCursor) -> Property isMovement func =- forAllValid $ \tfc ->- rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)+ forAllValid $ \tfc -> rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)
test/Cursor/TextSpec.hs view
@@ -12,6 +12,7 @@ import Control.Monad +import Cursor.List import Cursor.Text import Cursor.Text.Gen () @@ -19,27 +20,34 @@ spec = do eqSpec @TextCursor genValidSpec @TextCursor+ describe "Validity TextCursor" $ do+ it "considers a text cursor with a newline in the previous characters invalid" $+ shouldBeInvalid $+ TextCursor {textCursorList = ListCursor {listCursorPrev = "\n", listCursorNext = ""}}+ it "considers a text cursor with a newline in the next characters invalid" $+ shouldBeInvalid $+ TextCursor {textCursorList = ListCursor {listCursorPrev = "", listCursorNext = "\n"}}+ it "considers a text cursor with an unsafe character in the previous characters invalid" $+ shouldBeInvalid $+ TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = ""}}+ it "considers a text cursor with an unsafe character in the next characters invalid" $+ shouldBeInvalid $+ TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = "\n"}} describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor describe "makeTextCursor" $ it "produces valid list cursors" $ producesValidsOnValids makeTextCursor describe "makeTextCursorWithSelection" $- it "produces valid list cursors" $- producesValidsOnValids2 makeTextCursorWithSelection+ it "produces valid list cursors" $ producesValidsOnValids2 makeTextCursorWithSelection describe "rebuildTextCursor" $ do it "produces valid lists" $ producesValidsOnValids rebuildTextCursor it "is the inverse of makeTextCursor" $ inverseFunctionsIfFirstSucceedsOnValid makeTextCursor rebuildTextCursor it "is the inverse of makeTextCursorWithSelection for any index" $ forAllUnchecked $ \i ->- inverseFunctionsIfFirstSucceedsOnValid- (makeTextCursorWithSelection i)- rebuildTextCursor- describe "textCursorNull" $- it "produces valid bools" $ producesValidsOnValids textCursorNull- describe "textCursorLength" $- it "produces valid ints" $ producesValidsOnValids textCursorLength- describe "textCursorIndex" $- it "produces valid indices" $ producesValidsOnValids textCursorIndex+ inverseFunctionsIfFirstSucceedsOnValid (makeTextCursorWithSelection i) rebuildTextCursor+ describe "textCursorNull" $ it "produces valid bools" $ producesValidsOnValids textCursorNull+ describe "textCursorLength" $ it "produces valid ints" $ producesValidsOnValids textCursorLength+ describe "textCursorIndex" $ it "produces valid indices" $ producesValidsOnValids textCursorIndex describe "textCursorSelectPrev" $ do it "produces valid cursors" $ producesValidsOnValids textCursorSelectPrev it "is a movement" $ isMovementM textCursorSelectPrev@@ -50,11 +58,9 @@ it "selects the next position" pending describe "textCursorSelectIndex" $ do it "produces valid cursors" $ producesValidsOnValids2 textCursorSelectIndex- it "is a movement" $- forAllUnchecked $ \ix -> isMovement (textCursorSelectIndex ix)+ it "is a movement" $ forAllUnchecked $ \ix -> isMovement (textCursorSelectIndex ix) it "selects the position at the given index" pending- it- "produces a cursor that has the given selection for valid selections in the cursor" $+ it "produces a cursor that has the given selection for valid selections in the cursor" $ forAllValid $ \tc -> forAll (choose (0, textCursorLength tc)) $ \i -> textCursorIndex (textCursorSelectIndex i tc) `shouldBe` i@@ -75,12 +81,10 @@ it "produces valid items" $ producesValidsOnValids textCursorNextChar it "returns the item after the position" pending describe "textCursorInsert" $ do- it "produces valids" $- forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)+ it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorInsert d) it "inserts an item before the cursor" $ pending describe "textCursorAppend" $ do- it "produces valids" $- forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)+ it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorAppend d) it "inserts an item after the cursor" $ pending describe "textCursorRemove" $ do it "produces valids" $ validIfSucceedsOnValid textCursorRemove@@ -90,21 +94,17 @@ it "removes an item before the cursor" $ pending describe "textCursorSplit" $ do it "produces valids" $ producesValidsOnValids textCursorSplit- it- "produces two list cursors that rebuild to the rebuilding of the original" $+ it "produces two list cursors that rebuild to the rebuilding of the original" $ forAllValid $ \lc -> let (lc1, lc2) = textCursorSplit lc- in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe`- rebuildTextCursor lc+ in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe` rebuildTextCursor lc describe "textCursorCombine" $ do it "produces valids" $ producesValidsOnValids2 textCursorCombine- it- "produces a list that rebuilds to the rebuilding of the original two cursors" $+ it "produces a list that rebuilds to the rebuilding of the original two cursors" $ forAllValid $ \lc1 -> forAllValid $ \lc2 -> let lc = textCursorCombine lc1 lc2- in rebuildTextCursor lc `shouldBe`- (rebuildTextCursor lc1 <> rebuildTextCursor lc2)+ in rebuildTextCursor lc `shouldBe` (rebuildTextCursor lc1 <> rebuildTextCursor lc2) isMovementM :: (TextCursor -> Maybe TextCursor) -> Property isMovementM func =@@ -125,5 +125,4 @@ isMovement :: (TextCursor -> TextCursor) -> Property isMovement func =- forAllValid $ \lec ->- rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)+ forAllValid $ \lec -> rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)