diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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`. diff --git a/cursor-gen.cabal b/cursor-gen.cabal --- a/cursor-gen.cabal +++ b/cursor-gen.cabal @@ -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 diff --git a/src/Cursor/TextField/Gen.hs b/src/Cursor/TextField/Gen.hs --- a/src/Cursor/TextField/Gen.hs +++ b/src/Cursor/TextField/Gen.hs @@ -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 diff --git a/test/Cursor/TextFieldSpec.hs b/test/Cursor/TextFieldSpec.hs --- a/test/Cursor/TextFieldSpec.hs +++ b/test/Cursor/TextFieldSpec.hs @@ -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) diff --git a/test/Cursor/TextSpec.hs b/test/Cursor/TextSpec.hs --- a/test/Cursor/TextSpec.hs +++ b/test/Cursor/TextSpec.hs @@ -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)