cursor-gen 0.2.0.0 → 0.3.0.0

raw patch · 30 files changed

+568/−837 lines, 30 filesdep +criteriondep +genvalidity-criteriondep ~basedep ~cursorPVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, genvalidity-criterion

Dependency ranges changed: base, cursor

API changes (from Hackage documentation)

+ Cursor.List.NonEmpty.Gen: genNonEmptyCursorBy :: Gen a -> Gen b -> Gen (NonEmptyCursor a b)

+ Cursor.Map.Gen: genMapCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (MapCursor kc vc k v)

+ Cursor.Map.KeyValue.Gen: genKeyValueCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (KeyValueCursor kc vc k v)

+ Cursor.Text.Gen: genSafeChar :: Gen Char

+ Cursor.Text.Gen: genTextCursorChar :: Gen Char

Files

CHANGELOG.md +4/−0
bench/Bench.hs +44/−0
cursor-gen.cabal +45/−29
src/Cursor/Forest/Gen.hs +1/−3
src/Cursor/List/NonEmpty/Gen.hs +21/−33
src/Cursor/Map/Gen.hs +14/−8
src/Cursor/Map/KeyValue/Gen.hs +10/−3
src/Cursor/Text/Gen.hs +11/−2
src/Cursor/TextField/Gen.hs +9/−10
src/Cursor/Tree/Gen.hs +24/−41
test/Cursor/List/NonEmptySpec.hs +4/−7
test/Cursor/ListSpec.hs +39/−63
test/Cursor/Map/KeyValueSpec.hs +2/−2
test/Cursor/MapSpec.hs +2/−4
test/Cursor/Simple/ForestSpec.hs +115/−233
test/Cursor/Simple/List/NonEmptySpec.hs +40/−74
test/Cursor/Simple/Map/KeyValueSpec.hs +8/−16
test/Cursor/Simple/MapSpec.hs +43/−77
test/Cursor/Simple/Tree/BaseSpec.hs +7/−16
test/Cursor/Simple/Tree/CollapseSpec.hs +5/−10
test/Cursor/Simple/Tree/DeleteSpec.hs +15/−32
test/Cursor/Simple/Tree/DemoteSpec.hs +9/−22
test/Cursor/Simple/Tree/InsertSpec.hs +8/−17
test/Cursor/Simple/Tree/MovementSpec.hs +32/−58
test/Cursor/Simple/Tree/PromoteSpec.hs +7/−17
test/Cursor/Simple/Tree/SwapSpec.hs +6/−8
test/Cursor/Simple/Tree/TestUtils.hs +6/−10
test/Cursor/TextFieldSpec.hs +1/−2
test/Cursor/TextSpec.hs +4/−4
test/Cursor/Tree/TypesSpec.hs +32/−36

CHANGELOG.md view

@@ -2,6 +2,10 @@  ## [Unreleased] +## [0.3.0.0] - 2020-02-14++* Benchmarks for cursor generation+ ## [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.

+ bench/Bench.hs view

@@ -0,0 +1,44 @@+{-# LANGUAGE TypeApplications #-}++module Main where++import Criterion.Main as Criterion++import Data.GenValidity.Criterion++import Cursor.Forest.Gen ()+import Cursor.List.Gen ()+import Cursor.List.NonEmpty.Gen ()+import Cursor.Map.Gen ()+import Cursor.Map.KeyValue.Gen ()+import Cursor.Text.Gen ()+import Cursor.TextField.Gen ()+import Cursor.Tree.Gen ()++import Cursor.List+import Cursor.Simple.Forest+import Cursor.Simple.List.NonEmpty+import Cursor.Simple.Map+import Cursor.Simple.Tree+import Cursor.Text+import Cursor.TextField++main :: IO ()+main =+  Criterion.defaultMain+    [ genValidBench @(ListCursor Bool)+    , genValidBench @(NonEmptyCursor Bool)+    , genValidBench @(KeyValueCursor Bool Bool)+    , genValidBench @(MapCursor Bool Bool)+    , genValidBench @(SwapResult Bool)+    , genValidBench @(PromoteElemResult Bool)+    , genValidBench @(PromoteResult Bool)+    , genValidBench @(DemoteResult Bool)+    , genValidBench @(CTree Bool)+    , genValidBench @(CForest Bool)+    , genValidBench @(TreeAbove Bool)+    , genValidBench @(TreeCursor Bool)+    , genValidBench @(ForestCursor Bool)+    , genValidBench @TextCursor+    , genValidBench @TextFieldCursor+    ]

cursor-gen.cabal view

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0b391e9de9acd52641e27e356268ffac18998a48a689258da3a53a8cb083571d+-- hash: ca8f0d880d4a2aa40bc3c0de55b6c000b047b412f701f38af7d0da3f5c4346a2  name:           cursor-gen-version:        0.2.0.0+version:        0.3.0.0 synopsis:       Generators for Purely Functional Cursors description:    Generators for Purely Functional Cursors for common data structures category:       Cursor@@ -22,18 +22,6 @@     CHANGELOG.md  library-  hs-source-dirs:-      src/-  ghc-options: -Wall-  build-depends:-      QuickCheck-    , base <5-    , containers-    , cursor >=0.2-    , genvalidity >=0.8-    , genvalidity-containers-    , genvalidity-text >=0.6-    , text   exposed-modules:       Cursor.Forest.Gen       Cursor.List.Gen@@ -50,26 +38,23 @@       Cursor.Tree.Gen   other-modules:       Paths_cursor_gen-  default-language: Haskell2010--test-suite cursor-test-  type: exitcode-stdio-1.0-  main-is: Spec.hs   hs-source-dirs:-      test/-  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+      src/+  ghc-options: -Wall   build-depends:       QuickCheck-    , base+    , base <5     , containers-    , cursor-    , cursor-gen-    , genvalidity-hspec-    , genvalidity-hspec-optics-    , hspec-    , microlens-    , pretty-show+    , cursor >=0.2+    , genvalidity >=0.8+    , genvalidity-containers+    , genvalidity-text >=0.6     , text+  default-language: Haskell2010++test-suite cursor-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs   other-modules:       Cursor.List.NonEmptySpec       Cursor.ListSpec@@ -92,4 +77,35 @@       Cursor.TextSpec       Cursor.Tree.TypesSpec       Paths_cursor_gen+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base <5+    , containers+    , cursor+    , cursor-gen+    , genvalidity-hspec+    , genvalidity-hspec-optics+    , hspec+    , microlens+    , pretty-show+    , text+  default-language: Haskell2010++benchmark cursor-bench+  type: exitcode-stdio-1.0+  main-is: Bench.hs+  other-modules:+      Paths_cursor_gen+  hs-source-dirs:+      bench/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      base <5+    , criterion+    , cursor+    , cursor-gen+    , genvalidity-criterion   default-language: Haskell2010

src/Cursor/Forest/Gen.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Forest.Gen@@ -13,8 +12,7 @@ import Cursor.List.NonEmpty.Gen () import Cursor.Tree.Gen () -instance (GenUnchecked a, GenUnchecked b) =>-         GenUnchecked (ForestCursor a b) where+instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (ForestCursor a b) where   genUnchecked = ForestCursor <$> genUnchecked   shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne

src/Cursor/List/NonEmpty/Gen.hs view

@@ -2,7 +2,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.List.NonEmpty.Gen-  ( nonEmptyElemOf+  ( genNonEmptyCursorBy+  , nonEmptyElemOf   , nonEmptyWithIndex0   , nonEmptyWith   ) where@@ -17,42 +18,29 @@  import Cursor.List.NonEmpty -instance (GenUnchecked a, GenUnchecked b) =>-         GenUnchecked (NonEmptyCursor a b) where-  genUnchecked =-    sized $ \n -> do-      part <- arbPartition n-      case part of-        [] -> singletonNonEmptyCursor <$> resize 0 genUnchecked-        (s:ss) -> do-          i <- choose (0, length ss)-          let (as, bs) = splitAt i ss-          nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genUnchecked-          nonEmptyCursorCurrent <- resize s genUnchecked-          nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genUnchecked-          pure NonEmptyCursor {..}+instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (NonEmptyCursor a b) where+  genUnchecked = genNonEmptyCursorBy genUnchecked genUnchecked   shrinkUnchecked (NonEmptyCursor prev cur next) =-    [ NonEmptyCursor prev' cur' next'-    | (prev', cur', next') <- shrinkUnchecked (prev, cur, next)-    ]+    [NonEmptyCursor prev' cur' next' | (prev', cur', next') <- shrinkUnchecked (prev, cur, next)]  instance (GenValid a, GenValid b) => GenValid (NonEmptyCursor a b) where-  genValid =-    sized $ \n -> do-      part <- arbPartition n-      case part of-        [] -> singletonNonEmptyCursor <$> resize 0 genValid-        (s:ss) -> do-          i <- choose (0, length ss)-          let (as, bs) = splitAt i ss-          nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genValid-          nonEmptyCursorCurrent <- resize s genValid-          nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genValid-          pure NonEmptyCursor {..}+  genValid = genNonEmptyCursorBy genValid genValid   shrinkValid (NonEmptyCursor prev cur next) =-    [ NonEmptyCursor prev' cur' next'-    | (prev', cur', next') <- shrinkValid (prev, cur, next)-    ]+    [NonEmptyCursor prev' cur' next' | (prev', cur', next') <- shrinkValid (prev, cur, next)]++genNonEmptyCursorBy :: Gen a -> Gen b -> Gen (NonEmptyCursor a b)+genNonEmptyCursorBy genA genB =+  sized $ \n -> do+    part <- arbPartition n+    case part of+      [] -> singletonNonEmptyCursor <$> resize 0 genA+      (s:ss) -> do+        i <- choose (0, length ss)+        let (as, bs) = splitAt i ss+        nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genB+        nonEmptyCursorCurrent <- resize s genA+        nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genB+        pure NonEmptyCursor {..}  nonEmptyElemOf :: NonEmptyCursor a a -> Gen a nonEmptyElemOf = elements . NE.toList . rebuildNonEmptyCursor id

src/Cursor/Map/Gen.hs view

@@ -1,22 +1,28 @@-{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Map.Gen-  (+  ( genMapCursorBy   ) where  import Data.GenValidity import Data.GenValidity.Containers () +import Test.QuickCheck+ import Cursor.Map -import Cursor.List.NonEmpty.Gen ()-import Cursor.Map.KeyValue.Gen ()+import Cursor.List.NonEmpty.Gen+import Cursor.Map.KeyValue.Gen  instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) =>-         GenUnchecked (MapCursor kc vc k v)+         GenUnchecked (MapCursor kc vc k v) where+  genUnchecked = genMapCursorBy genUnchecked genUnchecked genUnchecked genUnchecked -instance (GenValid kc, GenValid vc, GenValid k, GenValid v) =>-         GenValid (MapCursor kc vc k v) where-  genValid = genValidStructurallyWithoutExtraChecking+instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => GenValid (MapCursor kc vc k v) where+  genValid = genMapCursorBy genValid genValid genValid genValid   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++genMapCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (MapCursor kc vc k v)+genMapCursorBy genKC genVC genK genV =+  MapCursor <$>+  genNonEmptyCursorBy (genKeyValueCursorBy genKC genVC genK genV) ((,) <$> genK <*> genV)

src/Cursor/Map/KeyValue/Gen.hs view

@@ -1,21 +1,28 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Map.KeyValue.Gen-  (+  ( genKeyValueCursorBy   ) where  import Data.GenValidity +import Test.QuickCheck+ import Cursor.Map.KeyValue  instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) =>-         GenUnchecked (KeyValueCursor kc vc k v)+         GenUnchecked (KeyValueCursor kc vc k v) where+  genUnchecked = genKeyValueCursorBy genUnchecked genUnchecked genUnchecked genUnchecked  instance (GenValid kc, GenValid vc, GenValid k, GenValid v) =>          GenValid (KeyValueCursor kc vc k v) where-  genValid = genValidStructurallyWithoutExtraChecking+  genValid = genKeyValueCursorBy genValid genValid genValid genValid   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked KeyValueToggle  instance GenValid KeyValueToggle++genKeyValueCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (KeyValueCursor kc vc k v)+genKeyValueCursorBy genKC genVC genK genV =+  oneof [KeyValueCursorKey <$> genKC <*> genV, KeyValueCursorValue <$> genK <*> genVC]

src/Cursor/Text/Gen.hs view

@@ -1,7 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Text.Gen-  ( textCursorWithGen+  ( genSafeChar+  , genTextCursorChar+  , textCursorWithGen   , textCursorWithIndex0   ) where @@ -11,14 +13,21 @@ import Data.GenValidity.Text ()  import Cursor.Text+import Cursor.Types  import Cursor.List.Gen  instance GenUnchecked TextCursor  instance GenValid TextCursor where-  genValid = genValidStructurally+  genValid = TextCursor <$> listCursorWithGen genTextCursorChar   shrinkValid = shrinkValidStructurally++genSafeChar :: Gen Char+genSafeChar = choose (minBound, maxBound) `suchThat` isSafeChar++genTextCursorChar :: Gen Char+genTextCursorChar = genSafeChar `suchThat` (/= '\n')  textCursorWithGen :: Gen Char -> Gen TextCursor textCursorWithGen gen = TextCursor <$> listCursorWithGen gen

src/Cursor/TextField/Gen.hs view

@@ -2,10 +2,8 @@  module Cursor.TextField.Gen where -import qualified Data.Text as T-import qualified Data.Text.Internal as T- import Data.GenValidity+import Data.GenValidity.Text  import Test.QuickCheck @@ -16,11 +14,12 @@ import Cursor.Text.Gen  instance GenValid TextFieldCursor where-  genValid = do-    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+  genValid =+    sized $ \n -> do+      (a, b, c) <- genSplit3 n+      prevs <- resize a $ genListOf $ genTextBy genTextCursorChar+      nexts <- resize b $ genListOf $ genTextBy genTextCursorChar+      cur <- resize c $ textCursorWithGen genTextCursorChar+      let nec = NonEmptyCursor prevs cur nexts+      pure $ TextFieldCursor nec   shrinkValid = shrinkValidStructurally

src/Cursor/Tree/Gen.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,49 +19,46 @@ instance GenUnchecked TreeCursorSelection  instance GenValid TreeCursorSelection where-  genValid = genValidStructurally-  shrinkValid = shrinkValidStructurally+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (SwapResult a)  instance GenValid a => GenValid (SwapResult a) where-  genValid = genValidStructurally-  shrinkValid = shrinkValidStructurally+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (PromoteElemResult a)  instance GenValid a => GenValid (PromoteElemResult a) where-  genValid = genValidStructurally-  shrinkValid = shrinkValidStructurally+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (PromoteResult a)  instance GenValid a => GenValid (PromoteResult a) where-  genValid = genValidStructurally-  shrinkValid = shrinkValidStructurally+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (DemoteResult a)  instance GenValid a => GenValid (DemoteResult a) where-  genValid = genValidStructurally-  shrinkValid = shrinkValidStructurally+  genValid = genValidStructurallyWithoutExtraChecking+  shrinkValid = shrinkValidStructurallyWithoutExtraFiltering  instance GenUnchecked a => GenUnchecked (CTree a) where   genUnchecked =     sized $ \n -> do-      s <- upTo n-      (a, b) <- genSplit s+      (a, b) <- genSplit n       val <- resize a genUnchecked       for <- resize b genUnchecked       pure $ CNode val for-  shrinkUnchecked (CNode a cf) =-    [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)]+  shrinkUnchecked (CNode a cf) = [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)]  instance GenValid a => GenValid (CTree a) where   genValid =     sized $ \n -> do-      s <- upTo n-      (a, b) <- genSplit s+      (a, b) <- genSplit n       val <- resize a genValid       for <- resize b genValid       pure $ CNode val for@@ -69,37 +66,23 @@  instance GenUnchecked a => GenUnchecked (CForest a) where   genUnchecked =-    sized $ \n ->-      case n of-        0 -> pure EmptyCForest-        _ ->-          oneof-            [ ClosedForest <$> resize n genUnchecked-            , OpenForest <$> resize n genUnchecked-            ]+    sized $ \case+      0 -> pure EmptyCForest+      _ -> oneof [ClosedForest <$> genUnchecked, OpenForest <$> genUnchecked]   shrinkUnchecked EmptyCForest = []-  shrinkUnchecked (ClosedForest ne) =-    EmptyCForest : (ClosedForest <$> shrinkUnchecked ne)+  shrinkUnchecked (ClosedForest ne) = EmptyCForest : (ClosedForest <$> shrinkUnchecked ne)   shrinkUnchecked (OpenForest ne) =-    EmptyCForest :-    ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkUnchecked ne)+    EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkUnchecked ne)  instance GenValid a => GenValid (CForest a) where   genValid =-    sized $ \n ->-      case n of-        0 -> pure EmptyCForest-        _ ->-          oneof-            [ ClosedForest <$> resize n genValid-            , OpenForest <$> resize n genValid-            ]+    sized $ \case+      0 -> pure EmptyCForest+      _ -> oneof [ClosedForest <$> genValid, OpenForest <$> genValid]   shrinkValid EmptyCForest = []-  shrinkValid (ClosedForest ne) =-    EmptyCForest : (ClosedForest <$> shrinkValid ne)+  shrinkValid (ClosedForest ne) = EmptyCForest : (ClosedForest <$> shrinkValid ne)   shrinkValid (OpenForest ne) =-    EmptyCForest :-    ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne)+    EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne)  instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (TreeCursor a b) where   genUnchecked =

test/Cursor/List/NonEmptySpec.hs view

@@ -1,8 +1,5 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}  module Cursor.List.NonEmptySpec   ( spec@@ -20,10 +17,10 @@   describe "nonemptyPrepend" $     it "is equivalent to regular prepend" $     equivalentWhenFirstSucceeds-      (\(ls1, ls2) -> (NE.toList . nonemptyPrepend ls1) <$> NE.nonEmpty ls2)-      (uncurry (++) :: ([Int], [Int]) -> [Int])+      (\(ls1, ls2) -> NE.toList . nonemptyPrepend ls1 <$> NE.nonEmpty ls2)+      (uncurry (++) :: ([Bool], [Bool]) -> [Bool])   describe "nonemptyAppend" $     it "is equivalent to regular append" $     equivalentWhenFirstSucceeds-      (\(ls1, ls2) -> (NE.toList . (`nonemptyAppend` ls2)) <$> NE.nonEmpty ls1)-      (uncurry (++) :: ([Int], [Int]) -> [Int])+      (\(ls1, ls2) -> NE.toList . (`nonemptyAppend` ls2) <$> NE.nonEmpty ls1)+      (uncurry (++) :: ([Bool], [Bool]) -> [Bool])

test/Cursor/ListSpec.hs view

@@ -17,108 +17,85 @@  spec :: Spec spec = do-  eqSpec @(ListCursor Int)+  eqSpec @(ListCursor Bool)   functorSpec @ListCursor-  genValidSpec @(ListCursor Rational)-  describe "emptyListCursor" $-    it "is valid" $ shouldBeValid (emptyListCursor @Int)+  genValidSpec @(ListCursor Bool)+  describe "emptyListCursor" $ it "is valid" $ shouldBeValid (emptyListCursor @Bool)   describe "makeListCursor" $-    it "produces valid list cursors" $-    producesValidsOnValids (makeListCursor @Rational)+    it "produces valid list cursors" $ producesValidsOnValids (makeListCursor @Bool)   describe "makeListCursorWithSelection" $-    it "produces valid list cursors" $-    producesValidsOnValids2 (makeListCursorWithSelection @Rational)+    it "produces valid list cursors" $ producesValidsOnValids2 (makeListCursorWithSelection @Bool)   describe "rebuildListCursor" $ do-    it "produces valid lists" $-      producesValidsOnValids (rebuildListCursor @Rational)+    it "produces valid lists" $ producesValidsOnValids (rebuildListCursor @Bool)     it "is the inverse of makeListCursor" $-      inverseFunctions (makeListCursor @Int) rebuildListCursor+      inverseFunctions (makeListCursor @Bool) rebuildListCursor     it "is the inverse of makeListCursorWithSelection for any index" $       forAllUnchecked $ \i ->-        inverseFunctionsIfFirstSucceeds-          (makeListCursorWithSelection @Int i)-          rebuildListCursor+        inverseFunctionsIfFirstSucceeds (makeListCursorWithSelection @Bool i) rebuildListCursor   describe "listCursorNull" $-    it "produces valid bools" $-    producesValidsOnValids (listCursorNull @Rational)+    it "produces valid bools" $ producesValidsOnValids (listCursorNull @Bool)   describe "listCursorLength" $-    it "produces valid bools" $-    producesValidsOnValids (listCursorLength @Rational)+    it "produces valid bools" $ producesValidsOnValids (listCursorLength @Bool)   describe "listCursorIndex" $-    it "produces valid indices" $-    producesValidsOnValids (listCursorIndex @Rational)+    it "produces valid indices" $ producesValidsOnValids (listCursorIndex @Bool)   describe "listCursorSelectPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids (listCursorSelectPrev @Rational)+    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectPrev @Bool)     it "is a movement" $ isMovementM listCursorSelectPrev     it "selects the previous position" pending   describe "listCursorSelectNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids (listCursorSelectNext @Rational)+    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectNext @Bool)     it "is a movement" $ isMovementM listCursorSelectNext     it "selects the next position" pending   describe "listCursorSelectIndex" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (listCursorSelectIndex @Rational)-    it "is a movement" $-      forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)+    it "produces valid cursors" $ producesValidsOnValids2 (listCursorSelectIndex @Bool)+    it "is a movement" $ forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)     it "selects the position at the given index" pending   describe "listCursorPrevItem" $ do-    it "produces valid items" $-      producesValidsOnValids (listCursorPrevItem @Rational)+    it "produces valid items" $ producesValidsOnValids (listCursorPrevItem @Bool)     it "returns the item before the position" pending   describe "listCursorNextItem" $ do-    it "produces valid items" $-      producesValidsOnValids (listCursorNextItem @Rational)+    it "produces valid items" $ producesValidsOnValids (listCursorNextItem @Bool)     it "returns the item after the position" pending   describe "listCursorSelectStart" $ do-    it "produces valid cursors" $-      producesValidsOnValids (listCursorSelectStart @Rational)+    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectStart @Bool)     it "is a movement" $ isMovement listCursorSelectStart-    it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Rational)+    it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Bool)     it "selects the starting position" pending   describe "listCursorSelectEnd" $ do-    it "produces valid cursors" $-      producesValidsOnValids (listCursorSelectEnd @Rational)+    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectEnd @Bool)     it "is a movement" $ isMovement listCursorSelectEnd-    it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Rational)+    it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Bool)     it "selects the end position" pending   describe "listCursorInsert" $ do-    it "produces valids" $-      forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Rational d)-    it "inserts an item before the cursor" $ pending+    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Bool d)+    it "inserts an item before the cursor" pending   describe "listCursorAppend" $ do-    it "produces valids" $-      forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Rational d)-    it "inserts an item after the cursor" $ pending+    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Bool d)+    it "inserts an item after the cursor" pending   describe "listCursorRemove" $ do-    it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Rational)-    it "removes an item before the cursor" $ pending+    it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Bool)+    it "removes an item before the cursor" pending   describe "listCursorDelete" $ do-    it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Rational)-    it "removes an item before the cursor" $ pending+    it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Bool)+    it "removes an item before the cursor" pending   describe "listCursorSplit" $ do-    it "produces valids" $ producesValidsOnValids (listCursorSplit @Rational)-    it-      "produces two list cursors that rebuild to the rebuilding of the original" $+    it "produces valids" $ producesValidsOnValids (listCursorSplit @Bool)+    it "produces two list cursors that rebuild to the rebuilding of the original" $       forAllValid $ \lc ->-        let (lc1, lc2) = listCursorSplit (lc :: ListCursor Rational)-         in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe`-            rebuildListCursor lc+        let (lc1, lc2) = listCursorSplit (lc :: ListCursor Bool)+         in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe` rebuildListCursor lc   describe "listCursorCombine" $ do-    it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Rational)-    it-      "produces a list that rebuilds to the rebuilding of the original two cursors" $+    it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Bool)+    it "produces a list that rebuilds to the rebuilding of the original two cursors" $       forAllValid $ \lc1 ->         forAllValid $ \lc2 ->-          let lc = listCursorCombine lc1 (lc2 :: ListCursor Rational)-           in rebuildListCursor lc `shouldBe`-              (rebuildListCursor lc1 ++ rebuildListCursor lc2)+          let lc = listCursorCombine lc1 (lc2 :: ListCursor Bool)+           in rebuildListCursor lc `shouldBe` (rebuildListCursor lc1 ++ rebuildListCursor lc2)  isMovementM :: (forall a. ListCursor a -> Maybe (ListCursor a)) -> Property isMovementM func =   forAllValid $ \lec ->-    case func (lec :: ListCursor Int) of+    case func (lec :: ListCursor Bool) of       Nothing -> pure () -- Fine       Just lec' ->         let ne = rebuildListCursor lec@@ -135,5 +112,4 @@ isMovement :: (forall a. ListCursor a -> ListCursor a) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildListCursor (lec :: ListCursor Int) `shouldBe`-    rebuildListCursor (func lec)+    rebuildListCursor (lec :: ListCursor Bool) `shouldBe` rebuildListCursor (func lec)

test/Cursor/Map/KeyValueSpec.hs view

@@ -13,7 +13,7 @@  spec :: Spec spec = do-  eqSpec @(KeyValueCursor Int Int Int Int)-  genValidSpec @(KeyValueCursor Double Double Double Double)+  eqSpec @(KeyValueCursor Bool Bool Bool Bool)+  genValidSpec @(KeyValueCursor Bool Bool Bool Bool)   eqSpec @KeyValueToggle   genValidSpec @KeyValueToggle

test/Cursor/MapSpec.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} @@ -14,6 +13,5 @@  spec :: Spec spec = do-  eqSpec @(MapCursor Word Int Bool Ordering)-  genValidSpec @(MapCursor Double Rational Int Bool)-  shrinkValidSpec @(MapCursor Double Rational Int Bool)+  eqSpec @(MapCursor Bool Bool Bool Bool)+  genValidSpec @(MapCursor Bool Bool Bool Bool)

test/Cursor/Simple/ForestSpec.hs view

@@ -29,33 +29,26 @@ spec :: Spec spec = do   eqSpec @(SFC.ForestCursor Int)-  genValidSpec @(SFC.ForestCursor Rational)+  genValidSpec @(SFC.ForestCursor Bool)   modifyMaxSize (`quot` 2) $-    modifyMaxSuccess (`quot` 2) $-    shrinkValidSpecWithLimit @(SFC.ForestCursor Rational) 10+    modifyMaxSuccess (`quot` 2) $ shrinkValidSpecWithLimit @(SFC.ForestCursor Bool) 10   describe "makeForestCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (makeForestCursor @Rational)+    it "produces valid cursors" $ producesValidsOnValids (makeForestCursor @Bool)   describe "rebuildForestCursor" $ do-    it "produces valid forests" $-      producesValidsOnValids (rebuildForestCursor @Rational)+    it "produces valid forests" $ producesValidsOnValids (rebuildForestCursor @Bool)     it "is the inverse of makeForestCursor for integers" $       inverseFunctions (makeForestCursor @Int) rebuildForestCursor-  describe "forestCursorLestCursorL" $-    lensSpecOnValid (forestCursorListCursorL @Rational @Rational)-  describe "forestCursorSelectedTreeL" $-    lensSpecOnValid (forestCursorSelectedTreeL @Rational @Rational)+  describe "forestCursorLestCursorL" $ lensSpecOnValid (forestCursorListCursorL @Bool @Bool)+  describe "forestCursorSelectedTreeL" $ lensSpecOnValid (forestCursorSelectedTreeL @Bool @Bool)   describe "forestCursorSelection" $ do-    it "produces valid ints" $-      producesValidsOnValids (forestCursorSelection @Rational @Rational)+    it "produces valid ints" $ producesValidsOnValids (forestCursorSelection @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "forestCursorSelectIndex" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorSelectIndex @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorSelectIndex @Bool)     it "is the identity function when given the current selection" $       forAllValid $ \fc ->         forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe`-        Just (fc :: SFC.ForestCursor Rational)+        Just (fc :: SFC.ForestCursor Bool)     it "returns selects the element at the given index" pending   movementsSpec   collapseSpec@@ -67,28 +60,23 @@ movementsSpec :: Spec movementsSpec = do   describe "forestCursorSelectPrevTreeCursor" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Bool     it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor     it "selects the previous tree cursor" pending   describe "forestCursorSelectNextTreeCursor" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectNextTreeCursor @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNextTreeCursor @Bool     it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor     it "selects the next tree" pending   describe "forestCursorSelectFirstTreeCursor" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Bool     it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor     it "selects the first tree" pending   describe "forestCursorSelectLastTreeCursor" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectLastTreeCursor @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectLastTreeCursor @Bool     it "is a movement" $ isMovement forestCursorSelectLastTreeCursor     it "selects the last tree" pending   describe "forestCursorSelectPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectPrev @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrev @Bool     it "is a movement" $ isMovementM forestCursorSelectPrev     it "selects the previous node" pending         -- TODO example with a collapsed tree@@ -101,14 +89,10 @@             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev =-                        [CNode 1 $ openForest [CNode 2 $ emptyCForest]]+                    { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]]                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 3 :: Int-                          , treeBelow = emptyCForest-                          }+                          {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest}                     , nonEmptyCursorNext = []                     }               }@@ -130,16 +114,14 @@                           , treeCurrent = 2                           , treeBelow = emptyCForest                           }-                    , nonEmptyCursorNext = [CNode 3 $ emptyCForest]+                    , nonEmptyCursorNext = [CNode 3 emptyCForest]                     }               }       case forestCursorSelectPrev start of-        Nothing ->-          expectationFailure "forestCursorSelectPrev should not have failed."+        Nothing -> expectationFailure "forestCursorSelectPrev should not have failed."         Just actual -> actual `forestShouldBe` expected   describe "forestCursorSelectNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectNext @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNext @Bool     it "is a movement" $ isMovementM forestCursorSelectNext     it "selects the next node" pending     it "Works for this classic example" $@@ -165,207 +147,155 @@                           , treeCurrent = 2                           , treeBelow = emptyCForest                           }-                    , nonEmptyCursorNext = [CNode 3 $ emptyCForest]+                    , nonEmptyCursorNext = [CNode 3 emptyCForest]                     }               }           expected =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev =-                        [CNode 1 $ openForest [CNode 2 $ emptyCForest]]+                    { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]]                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 3 :: Int-                          , treeBelow = emptyCForest-                          }+                          {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest}                     , nonEmptyCursorNext = []                     }               }       case forestCursorSelectNext start of-        Nothing ->-          expectationFailure "forestCursorSelectNext should not have failed."+        Nothing -> expectationFailure "forestCursorSelectNext should not have failed."         Just actual -> actual `forestShouldBe` expected   describe "forestCursorSelectPrevOnSameLevel" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Bool     it "is a movement" $ isMovementM forestCursorSelectPrevOnSameLevel     it "selects the previous node on the same level as the current node" pending   describe "forestCursorSelectNextOnSameLevel" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Bool     it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel     it "selects the next node on the same level as the current node" pending   describe "forestCursorSelectFirst" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectFirst @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirst @Bool     it "is a movement" $ isMovement forestCursorSelectFirst     it "selects the first node in the forest" pending   describe "forestCursorSelectLast" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectLast @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectLast @Bool     it "is a movement" $ isMovement forestCursorSelectLast     it "selects the last node in the forest" pending   describe "forestCursorSelectAbove" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectAbove @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectAbove @Bool     it "is a movement" $ isMovementM forestCursorSelectAbove     it "selects the parent" pending   describe "forestCursorSelectBelowAtPos" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Rational+    it "produces valid cursors" $ producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Bool     it "is a movement for any index" $       forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i     it "selects the child of the selected node at the given position" pending   describe "forestCursorSelectBelowAtStart" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectBelowAtStart @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectBelowAtStart @Bool     it "is a movement" $ isMovementM forestCursorSelectBelowAtStart     it "selects the first child of the selected node" pending   describe "forestCursorSelectBelowAtEnd" $ do-    it "produces valid cursors" $-      producesValidsOnValids $ forestCursorSelectBelowAtEnd @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectBelowAtEnd @Bool     it "is a movement" $ isMovementM forestCursorSelectBelowAtEnd     it "selects the first child of the selected node" pending  collapseSpec :: Spec collapseSpec = do   describe "forestCursorOpenCurrentForest" $-    it "produces valid cursors" $-    producesValidsOnValids $ forestCursorOpenCurrentForest @Rational @Rational+    it "produces valid cursors" $ producesValidsOnValids $ forestCursorOpenCurrentForest @Bool @Bool   describe "forestCursorCloseCurrentForest" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorCloseCurrentForest @Rational @Rational+    producesValidsOnValids $ forestCursorCloseCurrentForest @Bool @Bool   describe "forestCursorToggleCurrentForest" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorToggleCurrentForest @Double @Double+    producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool   describe "forestCursorOpenCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorToggleCurrentForest @Rational @Rational+    producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool   describe "forestCursorToggleCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $-    forestCursorToggleCurrentForestRecursively @Rational @Rational+    producesValidsOnValids $ forestCursorToggleCurrentForestRecursively @Bool @Bool  insertSpec :: Spec insertSpec = do   describe "forestCursorInsertEntireTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertEntireTree @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertEntireTree @Bool @Bool)     it "inserts a tree cursor before the currently selected tree cursor" pending   describe "forestCursorInsertAndSelectTreeCursor" $ do     it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Rational)-    it-      "inserts a tree cursor before the currently selected tree cursor and selects it"-      pending+      producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Bool)+    it "inserts a tree cursor before the currently selected tree cursor and selects it" pending   describe "forestCursorAppendEntireTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendEntireTree @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendEntireTree @Bool @Bool)     it "appends a tree after the currently selected tree cursor" pending   describe "forestCursorAppendAndSelectTreeCursor" $ do     it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Rational)-    it-      "appends a tree cursor after the currently selected tree cursor and selects it"-      pending+      producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Bool)+    it "appends a tree cursor after the currently selected tree cursor and selects it" pending   describe "forestCursorInsertTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertTree @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertTree @Bool @Bool)     it "inserts a tree before the currently selected tree" pending   describe "forestCursorInsertAndSelectTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertAndSelectTree @Rational)-    it-      "inserts a tree before the currently selected tree and selects it"-      pending+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelectTree @Bool)+    it "inserts a tree before the currently selected tree and selects it" pending   describe "forestCursorAppendTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendTree @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendTree @Bool @Bool)     it "appends a tree after the currently selected tree " pending   describe "forestCursorAppendAndSelectTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendAndSelectTree @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelectTree @Bool)     it "appends a tree after the currently selected tree and selects it" pending   describe "forestCursorInsert" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsert @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsert @Bool @Bool)     it "inserts a node before the currently selected node" pending   describe "forestCursorInsertAndSelect" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertAndSelect @Rational)-    it-      "inserts a node before the currently selected node and selects it"-      pending+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelect @Bool)+    it "inserts a node before the currently selected node and selects it" pending   describe "forestCursorAppend" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppend @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppend @Bool @Bool)     it "appends a node after the currently selected node" pending   describe "forestCursorAppendAndSelect" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendAndSelect @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelect @Bool)     it "appends a node after the currently selected node and selects it" pending   describe "forestCursorAddChildTreeToNodeAtPos" $ do     it "produces valid cursors" $-      producesValidsOnValids3 $-      forestCursorAddChildTreeToNodeAtPos @Rational @Rational-    it-      "adds a child tree to a node at the given position in the children of that node"-      pending+      producesValidsOnValids3 $ forestCursorAddChildTreeToNodeAtPos @Bool @Bool+    it "adds a child tree to a node at the given position in the children of that node" pending   describe "forestCursorAddChildTreeToNodeAtStart" $ do     it "produces valid cursors" $-      producesValidsOnValids2 $-      forestCursorAddChildTreeToNodeAtStart @Rational @Rational-    it-      "adds a child tree to a node at the start the children of that node"-      pending+      producesValidsOnValids2 $ forestCursorAddChildTreeToNodeAtStart @Bool @Bool+    it "adds a child tree to a node at the start the children of that node" pending   describe "forestCursorAddChildTreeToNodeAtEnd" $ do     it "produces valid cursors" $-      producesValidsOnValids2 $-      forestCursorAddChildTreeToNodeAtEnd @Rational @Rational-    it-      "adds a child tree to a node at the end the children of that node"-      pending+      producesValidsOnValids2 $ forestCursorAddChildTreeToNodeAtEnd @Bool @Bool+    it "adds a child tree to a node at the end the children of that node" pending   describe "forestCursorAddChildToNodeAtPos" $ do     it "produces valid cursors" $-      producesValidsOnValids3 $-      forestCursorAddChildToNodeAtPos @Rational @Rational-    it-      "adds a child to a node at the given position in the children of that node"-      pending+      producesValidsOnValids3 $ forestCursorAddChildToNodeAtPos @Bool @Bool+    it "adds a child to a node at the given position in the children of that node" pending   describe "forestCursorAddChildToNodeAtStart" $ do     it "produces valid cursors" $-      producesValidsOnValids2 $-      forestCursorAddChildToNodeAtStart @Rational @Rational+      producesValidsOnValids2 $ forestCursorAddChildToNodeAtStart @Bool @Bool     it "adds a child to a node at the start the children of that node" pending   describe "forestCursorAddChildToNodeAtEnd" $ do     it "produces valid cursors" $-      producesValidsOnValids2 $-      forestCursorAddChildToNodeAtEnd @Rational @Rational+      producesValidsOnValids2 $ forestCursorAddChildToNodeAtEnd @Bool @Bool     it "adds a child to a node at the end the children of that node" pending   describe "forestCursorAddRoot" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAddRoot @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAddRoot @Bool)     it "houses the entire forest under the given node" pending  swapSpec :: Spec swapSpec = do   describe "forestCursorSwapPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorSwapPrev @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorSwapPrev @Bool @Bool)     it "works on the example from the docs" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 'a' $ emptyCForest]+                    { nonEmptyCursorPrev = [CNode 'a' emptyCForest]                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'b'-                          , treeBelow = emptyCForest-                          }+                          {treeAbove = Nothing, treeCurrent = 'b', treeBelow = emptyCForest}                     , nonEmptyCursorNext = []                     }               }@@ -376,25 +306,20 @@                     { nonEmptyCursorPrev = []                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'b'-                          , treeBelow = emptyCForest-                          }-                    , nonEmptyCursorNext = [CNode 'a' $ emptyCForest]+                          {treeAbove = Nothing, treeCurrent = 'b', treeBelow = emptyCForest}+                    , nonEmptyCursorNext = [CNode 'a' emptyCForest]                     }               }        in case forestCursorSwapPrev start of-            Nothing ->-              expectationFailure "forestCursorSwapPrev should not have failed."+            Nothing -> expectationFailure "forestCursorSwapPrev should not have failed."             Just r -> r `forestShouldBe` end     it "swaps the current node with the previous node on the same level" pending     it "reverts forestCursorSwapNext" $       inverseFunctionsIfSucceedOnValid-        (forestCursorSwapNext @Rational @Rational)-        (forestCursorSwapPrev @Rational @Rational)+        (forestCursorSwapNext @Bool @Bool)+        (forestCursorSwapPrev @Bool @Bool)   describe "forestCursorSwapNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorSwapNext @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorSwapNext @Bool @Bool)     it "works on the example from the docs" $       let start =             ForestCursor@@ -403,42 +328,34 @@                     { nonEmptyCursorPrev = []                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'a'-                          , treeBelow = emptyCForest-                          }-                    , nonEmptyCursorNext = [CNode 'b' $ emptyCForest]+                          {treeAbove = Nothing, treeCurrent = 'a', treeBelow = emptyCForest}+                    , nonEmptyCursorNext = [CNode 'b' emptyCForest]                     }               }           end =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 'b' $ emptyCForest]+                    { nonEmptyCursorPrev = [CNode 'b' emptyCForest]                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'a'-                          , treeBelow = emptyCForest-                          }+                          {treeAbove = Nothing, treeCurrent = 'a', treeBelow = emptyCForest}                     , nonEmptyCursorNext = []                     }               }        in case forestCursorSwapNext start of-            Nothing ->-              expectationFailure "forestCursorSwapNext should not have failed."+            Nothing -> expectationFailure "forestCursorSwapNext should not have failed."             Just r -> r `forestShouldBe` end     it "swaps the current node with the next node on the same level" pending     it "reverts forestCursorSwapPrev" $       inverseFunctionsIfSucceedOnValid-        (forestCursorSwapPrev @Rational @Rational)-        (forestCursorSwapNext @Rational @Rational)+        (forestCursorSwapPrev @Bool @Bool)+        (forestCursorSwapNext @Bool @Bool)  deleteSpec :: Spec deleteSpec = do   describe "forestCursorRemoveElemAndSelectPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Bool)     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =@@ -465,8 +382,7 @@                   "forestCursorRemoveElemAndSelectPrev should not have updated the forest cursor, but failed instead."     it "removes the selected element and selects the previous element" pending   describe "forestCursorDeleteElemAndSelectNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Bool)     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =@@ -499,16 +415,14 @@                 }          in case forestCursorDeleteElemAndSelectNext simpleDeleteElemStart of               Nothing ->-                expectationFailure-                  "forestCursorDeleteElemAndSelectNext should not have failed."+                expectationFailure "forestCursorDeleteElemAndSelectNext should not have failed."               Just Deleted ->                 expectationFailure                   "forestCursorDeleteElemAndSelectNext should not have deleted the entire example forest."               Just (Updated f) -> f `shouldBe` simpleDeleteElemExpected     it "deletes the selected element and selects the next element" pending   describe "forestCursorRemoveElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorRemoveElem @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveElem @Bool)     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =@@ -546,8 +460,7 @@               Updated f -> f `shouldBe` simpleDeleteElemExpected     it "removes the selected element" pending   describe "forestCursorDeleteElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorDeleteElem @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteElem @Bool)     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =@@ -586,26 +499,23 @@     it "deletes the selected element" pending   describe "forestCursorRemoveSubTreeAndSelectPrev" $ do     it "produces valid cursors" $-      producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Rational)+      producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Bool)     it "removes the selected subtree and selects the previous tree" pending   describe "forestCursorDeleteSubTreeAndSelectNext" $ do     it "produces valid cursors" $-      producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Rational)+      producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Bool)     it "deletes the selected subtree and selects the next tree" pending   describe "forestCursorRemoveSubTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorRemoveSubTree @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveSubTree @Bool)     it "removes the selected subtree" pending   describe "forestCursorDeleteSubTree" $ do-    it "produces valid cursors" $-      producesValidsOnValids (forestCursorDeleteSubTree @Rational)+    it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteSubTree @Bool)     it "deletes the selected subtree" pending  shiftingSpec :: Spec shiftingSpec = do   describe "forestCursorPromoteElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ forestCursorPromoteElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ forestCursorPromoteElem @Bool     it "works on the example from the documentation" $       let start =             ForestCursor@@ -617,17 +527,15 @@                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts =-                                      [CNode 'b' $ closedForest [Node 'c' []]]+                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]                                   , treeAboveAbove = Nothing                                   , treeAboveNode = 'a'-                                  , treeAboveRights =-                                      [CNode 'f' $ closedForest [Node 'g' []]]+                                  , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]                                   }                           , treeCurrent = 'd'                           , treeBelow = closedForest [Node 'e' []]                           }-                    , nonEmptyCursorNext = [CNode 'h' $ emptyCForest]+                    , nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }           expected =@@ -638,36 +546,28 @@                         [ CNode 'a' $                           openForest                             [ CNode 'b' $-                              openForest-                                [CNode 'c' emptyCForest, CNode 'e' emptyCForest]+                              openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest]                             , CNode 'f' $ closedForest [Node 'g' []]                             ]                         ]                     , nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'd'-                          , treeBelow = emptyCForest-                          }+                          {treeAbove = Nothing, treeCurrent = 'd', treeBelow = emptyCForest}                     , nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }        in case forestCursorPromoteElem start of-            Nothing ->-              expectationFailure-                "forestCursorPromoteElem should not have failed."+            Nothing -> expectationFailure "forestCursorPromoteElem should not have failed."             Just f -> f `forestShouldBe` expected     it "promotes the current node to the level of its parent" pending   describe "forestCursorDemoteElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ forestCursorDemoteElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ forestCursorDemoteElem @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev =-                        [CNode 'a' $ closedForest [Node 'b' []]]+                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]]                     , nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove = Nothing@@ -687,26 +587,23 @@                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts = [CNode 'b' $ emptyCForest]+                                  { treeAboveLefts = [CNode 'b' emptyCForest]                                   , treeAboveAbove = Nothing                                   , treeAboveNode = 'a'-                                  , treeAboveRights = [CNode 'd' $ emptyCForest]+                                  , treeAboveRights = [CNode 'd' emptyCForest]                                   }                           , treeCurrent = 'c'                           , treeBelow = emptyCForest                           }-                    , nonEmptyCursorNext = [CNode 'e' $ emptyCForest]+                    , nonEmptyCursorNext = [CNode 'e' emptyCForest]                     }               }        in case forestCursorDemoteElem start of-            Nothing ->-              expectationFailure-                "forestCursorDemoteElem should not have failed."+            Nothing -> expectationFailure "forestCursorDemoteElem should not have failed."             Just f -> f `forestShouldBe` expected     it "demotes the current node to the level of its children" pending   describe "forestCursorPromoteSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ forestCursorPromoteSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ forestCursorPromoteSubTree @Bool     it "works on the example from the documentation" $       let start =             ForestCursor@@ -718,12 +615,10 @@                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts =-                                      [CNode 'b' $ closedForest [Node 'c' []]]+                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]                                   , treeAboveAbove = Nothing                                   , treeAboveNode = 'a'-                                  , treeAboveRights =-                                      [CNode 'f' $ closedForest [Node 'g' []]]+                                  , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]                                   }                           , treeCurrent = 'd'                           , treeBelow = closedForest [Node 'e' []]@@ -752,21 +647,17 @@                     }               }        in case forestCursorPromoteSubTree start of-            Nothing ->-              expectationFailure-                "forestCursorPromoteSubTree should not have failed."+            Nothing -> expectationFailure "forestCursorPromoteSubTree should not have failed."             Just f -> f `forestShouldBe` expected     it "promotes the current subtree to the level of its parent" pending   describe "forestCursorDemoteSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ forestCursorDemoteSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ forestCursorDemoteSubTree @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev =-                        [CNode 'a' $ closedForest [Node 'b' []]]+                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]]                     , nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove = Nothing@@ -798,14 +689,12 @@                     }               }        in case forestCursorDemoteSubTree start of-            Nothing ->-              expectationFailure-                "forestCursorDemoteSubTree should not have failed."+            Nothing -> expectationFailure "forestCursorDemoteSubTree should not have failed."             Just f -> f `forestShouldBe` expected     it "demotes the current subtree to the level of its children" pending   describe "forestCursorDemoteElemUnder" $ do     it "produces valids on valids" $-      producesValidsOnValids3 $ forestCursorDemoteElemUnder @Rational @Rational+      producesValidsOnValids3 $ forestCursorDemoteElemUnder @Bool @Bool     it "Works on the example from the docs" $       forAllValid $ \b1 ->         forAllValid $ \b2 ->@@ -840,13 +729,11 @@                         }                   , nonEmptyCursorNext = [CNode b2 $ closedForest [Node 'b' []]]                   }-           in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe`-              demoteEnd+           in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe` demoteEnd     it "demotes the current node to the level of its children" pending   describe "forestCursorDemoteSubTreeUnder" $ do     it "produces valids on valids" $-      producesValidsOnValids2 $-      forestCursorDemoteSubTreeUnder @Rational @Rational+      producesValidsOnValids2 $ forestCursorDemoteSubTreeUnder @Bool @Bool     it "Works on the example from the docs" $       forAllValid $ \v -> do         let demoteStart =@@ -881,12 +768,9 @@                 , nonEmptyCursorNext = []                 }         forestCursorDemoteSubTreeUnder v demoteStart `forestShouldBe` demoteEnd-    it-      "demotes the current subtree to the level of its children, by adding a root"-      pending+    it "demotes the current subtree to the level of its children, by adding a root" pending -isMovementM ::-     (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property+isMovementM :: (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property isMovementM func =   forAllValid @(SFC.ForestCursor Int) $ \lec ->     case func lec of@@ -906,11 +790,9 @@ isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe`-    rebuildForestCursor (func lec)+    rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe` rebuildForestCursor (func lec) -forestShouldBe ::-     (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation+forestShouldBe :: (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation forestShouldBe actual expected =   unless (actual == expected) $   expectationFailure $

test/Cursor/Simple/List/NonEmptySpec.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}@@ -20,150 +19,118 @@  spec :: Spec spec = do-  eqSpec @(NonEmptyCursor Int)-  genValidSpec @(NonEmptyCursor Rational)-  shrinkValidSpec @(NonEmptyCursor Rational)+  eqSpec @(NonEmptyCursor Bool)+  genValidSpec @(NonEmptyCursor Bool)   describe "makeNonEmptyCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (makeNonEmptyCursor @Rational)+    it "produces valid cursors" $ producesValidsOnValids (makeNonEmptyCursor @Bool)   describe "makeNonEmptyCursorWithSelection" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Rational)-    it-      "is the inverse of rebuildNonEmptyCursor when using the current selection" $+    it "produces valid cursors" $ producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Bool)+    it "is the inverse of rebuildNonEmptyCursor when using the current selection" $       forAllValid $ \lec ->         makeNonEmptyCursorWithSelection-          (nonEmptyCursorSelection @Rational lec)+          (nonEmptyCursorSelection @Bool lec)           (rebuildNonEmptyCursor lec) `shouldBe`         Just lec   describe "singletonNonEmptyCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (singletonNonEmptyCursor @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (singletonNonEmptyCursor @Bool @Bool)   describe "rebuildNonEmptyCursor" $ do-    it "produces valid nonempty lists" $-      producesValidsOnValids (rebuildNonEmptyCursor @Rational)+    it "produces valid nonempty lists" $ producesValidsOnValids (rebuildNonEmptyCursor @Bool)     it "is the inverse of makeNonEmptyCursor for integers" $       inverseFunctions (makeNonEmptyCursor @Int) rebuildNonEmptyCursor-    it-      "is the inverse of makeNonEmptyCursorWithSelection for integers, for any index" $+    it "is the inverse of makeNonEmptyCursorWithSelection for integers, for any index" $       forAll genUnchecked $ \i ->         inverseFunctionsIfFirstSucceedsOnValid           (makeNonEmptyCursorWithSelection @Int i)           rebuildNonEmptyCursor-  describe "nonEmptyCursorElemL" $-    lensSpecOnValid (nonEmptyCursorElemL @Rational @Rational)+  describe "nonEmptyCursorElemL" $ lensSpecOnValid (nonEmptyCursorElemL @Bool @Bool)   describe "nonEmptyCursorSelectPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorSelectPrev @Rational)+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectPrev @Bool)     it "is a movement" $ isMovementM nonEmptyCursorSelectPrev     it "selects the previous element" pending   describe "nonEmptyCursorSelectNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorSelectNext @Rational)+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectNext @Bool)     it "is a movement" $ isMovementM nonEmptyCursorSelectNext     it "selects the next element" pending   describe "nonEmptyCursorSelectFirst" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorSelectFirst @Rational)+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectFirst @Bool)     it "is a movement" $ isMovement nonEmptyCursorSelectFirst-    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Rational)+    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Bool)     it "selects the first element" pending   describe "nonEmptyCursorSelectLast" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorSelectLast @Rational)+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectLast @Bool)     it "is a movement" $ isMovement nonEmptyCursorSelectLast-    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Rational)+    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Bool)     it "selects the last element" pending   describe "nonEmptyCursorSelection" $ do-    it "produces valid ints" $-      producesValidsOnValids (nonEmptyCursorSelection @Rational @Rational)+    it "produces valid ints" $ producesValidsOnValids (nonEmptyCursorSelection @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "nonEmptyCursorSelectIndex" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (nonEmptyCursorSelectIndex @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (nonEmptyCursorSelectIndex @Bool)     it "is the identity function when given the current selection" $       forAllValid $ \nec ->         nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe`-        Just (nec :: NonEmptyCursor Rational)+        Just (nec :: NonEmptyCursor Bool)     it "returns selects the element at the given index" pending   describe "nonEmptyCursorInsert" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorInsert @Rational @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsert @Bool @Bool d)     it "inserts a character before the cursor" pending   describe "nonEmptyCursorAppend" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorAppend @Rational @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppend @Bool @Bool d)     it "inserts a character after the cursor" pending   describe "nonEmptyCursorInsertAndSelect" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorInsertAndSelect @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAndSelect @Bool d)     it "inserts a character before the cursor and selects it" pending   describe "nonEmptyCursorAppendAndSelect" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorAppendAndSelect @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAndSelect @Bool d)     it "appends a character before the cursor and selects it" pending   describe "nonEmptyCursorInsertAtStart" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids-          (nonEmptyCursorInsertAtStart @Rational @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAtStart @Bool @Bool d)     it "inserts a character at the start of the list" pending   describe "nonEmptyCursorAppendAtEnd" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorAppendAtEnd @Rational @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAtEnd @Bool @Bool d)     it "inserts a character at the end of the list" pending   describe "nonEmptyCursorInsertAtStartAndSelect" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids-          (nonEmptyCursorInsertAtStartAndSelect @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAtStartAndSelect @Bool d)     it "inserts a character at the start of the list and selects it" pending   describe "nonEmptyCursorAppendAtEndAndSelect" $ do     it "produces valid cursors" $-      forAllValid $ \d ->-        producesValidsOnValids (nonEmptyCursorAppendAtEndAndSelect @Rational d)+      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAtEndAndSelect @Bool d)     it "appends a character at the end of the list and selects it" pending   describe "nonEmptyCursorRemoveElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorRemoveElem @Rational)+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorRemoveElem @Bool)     it "removes an element" pending-  describe "nonEmptyCursorDeleteElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (nonEmptyCursorDeleteElem @Rational)+  describe "nonEmptyCursorDeleteElem" $+    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorDeleteElem @Bool)   describe "nonEmptyCursorSearch" $ do     it "produces valid cursors when looking for an equal element" $-      forAllValid $ \a ->-        producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Rational))-    it-      "is indeed the right value when it finds a value and is looking for an equal element" $+      forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Bool))+    it "is indeed the right value when it finds a value and is looking for an equal element" $       forAllValid $ \a ->         forAllValid $ \nec ->-          case nonEmptyCursorSearch (== (a :: Rational)) nec of+          case nonEmptyCursorSearch (== (a :: Bool)) nec of             Nothing -> pure ()             Just e -> nonEmptyCursorCurrent e `shouldBe` a     it "finds an element if it is in there" $       forAllValid $ \a ->         forAll (nonEmptyWith a genValid) $ \nec ->-          case nonEmptyCursorSearch (== (a :: Rational)) nec of-            Nothing ->-              expectationFailure "Should not have failed to find the element."+          case nonEmptyCursorSearch (== (a :: Bool)) nec of+            Nothing -> expectationFailure "Should not have failed to find the element."             Just e -> nonEmptyCursorCurrent e `shouldBe` a-  describe "nonEmptyCursorSelectOrAdd" $ do+  describe "nonEmptyCursorSelectOrAdd" $     it "produces valid cursors when looking for an equal element" $-      forAllValid $ \a ->-        producesValidsOnValids $-        nonEmptyCursorSelectOrAdd (== a) (a :: Rational)+    forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSelectOrAdd (== a) (a :: Bool) -isMovementM ::-     (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property+isMovementM :: (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property isMovementM func =   forAllValid $ \lec ->-    case func (lec :: NonEmptyCursor Rational) of+    case func (lec :: NonEmptyCursor Bool) of       Nothing -> pure () -- Fine       Just lec' ->         let ne = rebuildNonEmptyCursor lec@@ -180,5 +147,4 @@ isMovement :: (forall a. NonEmptyCursor a -> NonEmptyCursor a) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildNonEmptyCursor (lec :: NonEmptyCursor Rational) `shouldBe`-    rebuildNonEmptyCursor (func lec)+    rebuildNonEmptyCursor (lec :: NonEmptyCursor Bool) `shouldBe` rebuildNonEmptyCursor (func lec)

test/Cursor/Simple/Map/KeyValueSpec.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}@@ -19,34 +18,27 @@ spec = do   describe "makeKeyValueCursorKey" $     it "produces valid cursors" $-    producesValidsOnValids2-      (makeKeyValueCursorKey @Rational @Rational @Rational @Rational)+    producesValidsOnValids2 (makeKeyValueCursorKey @Bool @Bool @Bool @Bool)   describe "makeKeyValueCursorValue" $     it "produces valid cursors" $-    producesValidsOnValids2-      (makeKeyValueCursorValue @Rational @Rational @Rational @Rational)+    producesValidsOnValids2 (makeKeyValueCursorValue @Bool @Bool @Bool @Bool)   describe "rebuildKeyValueCursor" $-    it "produces valid tuples" $-    producesValidsOnValids (rebuildKeyValueCursor @Rational @Rational)+    it "produces valid tuples" $ producesValidsOnValids (rebuildKeyValueCursor @Bool @Bool)   describe "keyValueCursorSelection" $     it "produces valid selections" $-    producesValidsOnValids-      (keyValueCursorSelection @Rational @Rational @Rational @Rational)+    producesValidsOnValids (keyValueCursorSelection @Bool @Bool @Bool @Bool)   describe "keyValueCursorSelectKey" $ do-    it "produces valid cursors" $-      producesValidsOnValids (keyValueCursorSelectKey @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectKey @Bool @Bool)     it "is a movement" $ isMovement keyValueCursorSelectKey   describe "keyValueCursorSelectValue" $ do-    it "produces valid cursors" $-      producesValidsOnValids (keyValueCursorSelectValue @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectValue @Bool @Bool)     it "is a movement" $ isMovement keyValueCursorSelectValue   describe "keyValueCursorToggleSelected" $ do-    it "produces valid cursors" $-      producesValidsOnValids (keyValueCursorToggleSelected @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorToggleSelected @Bool @Bool)     it "is a movement" $ isMovement keyValueCursorToggleSelected  isMovement :: (forall k v. KeyValueCursor k v -> KeyValueCursor k v) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildKeyValueCursor (lec :: KeyValueCursor Rational Rational) `shouldBe`+    rebuildKeyValueCursor (lec :: KeyValueCursor Bool Bool) `shouldBe`     rebuildKeyValueCursor (func lec)

test/Cursor/Simple/MapSpec.hs view

@@ -21,133 +21,100 @@ spec :: Spec spec = do   describe "makeMapCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (makeMapCursor @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (makeMapCursor @Bool @Bool)   describe "makeMapCursorWithSelection" $-    it "produces valid cursors" $-    producesValidsOnValids2 (makeMapCursorWithSelection @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (makeMapCursorWithSelection @Bool @Bool)   describe "singletonMapCursorKey" $     it "produces valid cursors" $-    producesValidsOnValids2-      (singletonMapCursorKey @Rational @Rational @Rational @Rational)+    producesValidsOnValids2 (singletonMapCursorKey @Bool @Bool @Bool @Bool)   describe "singletonMapCursorValue" $     it "produces valid cursors" $-    producesValidsOnValids2-      (singletonMapCursorValue @Rational @Rational @Rational @Rational)+    producesValidsOnValids2 (singletonMapCursorValue @Bool @Bool @Bool @Bool)   describe "rebuildMapCursor" $ do-    it "produces valid Nonempty lists" $-      producesValidsOnValids (rebuildMapCursor @Rational @Rational)+    it "produces valid Nonempty lists" $ producesValidsOnValids (rebuildMapCursor @Bool @Bool)     it "is the inverse of makeMapCursor for integers" $-      inverseFunctions (makeMapCursor @Int @Int) rebuildMapCursor+      inverseFunctions (makeMapCursor @Bool @Bool) rebuildMapCursor   describe "mapCursorNonEmptyCursorL" $-    lensSpecOnValid-      (mapCursorNonEmptyCursorL @Rational @Rational @Rational @Rational)-  describe "mapCursorElemL" $-    lensSpecOnValid (mapCursorElemL @Rational @Rational @Rational @Rational)+    lensSpecOnValid (mapCursorNonEmptyCursorL @Bool @Bool @Bool @Bool)+  describe "mapCursorElemL" $ lensSpecOnValid (mapCursorElemL @Bool @Bool @Bool @Bool)   describe "mapCursorSelectKey" $-    it "produces valid cursors" $-    producesValidsOnValids (mapCursorSelectKey @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectKey @Bool @Bool)   describe "mapCursorSelectValue" $-    it "produces valid cursors" $-    producesValidsOnValids (mapCursorSelectValue @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectValue @Bool @Bool)   describe "mapCursorToggleSelected" $-    it "produces valid cursors" $-    producesValidsOnValids (mapCursorToggleSelected @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorToggleSelected @Bool @Bool)   describe "mapCursorSelectPrev" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorSelectPrev @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectPrev @Bool @Bool)     it "is a movement" $ isMovementM mapCursorSelectPrev     it "selects the previous element" pending   describe "mapCursorSelectNext" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorSelectNext @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectNext @Bool @Bool)     it "is a movement" $ isMovementM mapCursorSelectNext     it "selects the next element" pending   describe "mapCursorSelectFirst" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorSelectFirst @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectFirst @Bool @Bool)     it "is a movement" $ isMovement mapCursorSelectFirst-    it "is idempotent" $-      idempotentOnValid (mapCursorSelectFirst @Rational @Rational)+    it "is idempotent" $ idempotentOnValid (mapCursorSelectFirst @Bool @Bool)     it "selects the first element" pending   describe "mapCursorSelectLast" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorSelectLast @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectLast @Bool @Bool)     it "is a movement" $ isMovement mapCursorSelectLast-    it "is idempotent" $-      idempotentOnValid (mapCursorSelectLast @Rational @Rational)+    it "is idempotent" $ idempotentOnValid (mapCursorSelectLast @Bool @Bool)     it "selects the last element" pending   describe "mapCursorSelection" $ do-    it "produces valid ints" $-      producesValidsOnValids-        (mapCursorSelection @Rational @Rational @Rational @Rational)+    it "produces valid ints" $ producesValidsOnValids (mapCursorSelection @Bool @Bool @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "mapCursorSelectIndex" $ do-    it "produces valid cursors" $-      producesValidsOnValids2 (mapCursorSelectIndex @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (mapCursorSelectIndex @Bool @Bool)     it "is the identity function when given the current selection" $       forAllValid $ \nec ->         mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe`-        Just (nec :: MapCursor Rational Rational)+        Just (nec :: MapCursor Bool Bool)     it "returns selects the element at the given index" pending   describe "mapCursorInsert" $ do-    it "produces valid cursors" $-      producesValidsOnValids3-        (mapCursorInsert @Rational @Rational @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsert @Bool @Bool @Bool @Bool)     it "inserts a character before the cursor" pending   describe "mapCursorAppend" $ do-    it "produces valid cursors" $-      producesValidsOnValids3-        (mapCursorAppend @Rational @Rational @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppend @Bool @Bool @Bool @Bool)     it "inserts a character after the cursor" pending-  describe "mapCursorInsertAndSelectKey" $ do-    it "produces valid cursors" $-      producesValidsOnValids3 (mapCursorInsertAndSelectKey @Rational @Rational)-  describe "mapCursorAppendAndSelectKey" $ do-    it "produces valid cursors" $-      producesValidsOnValids3 (mapCursorAppendAndSelectKey @Rational @Rational)-  describe "mapCursorInsertAndSelectValue" $ do+  describe "mapCursorInsertAndSelectKey" $+    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsertAndSelectKey @Bool @Bool)+  describe "mapCursorAppendAndSelectKey" $+    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppendAndSelectKey @Bool @Bool)+  describe "mapCursorInsertAndSelectValue" $     it "produces valid cursors" $-      producesValidsOnValids3-        (mapCursorInsertAndSelectValue @Rational @Rational)-  describe "mapCursorAppendAndSelectValue" $ do+    producesValidsOnValids3 (mapCursorInsertAndSelectValue @Bool @Bool)+  describe "mapCursorAppendAndSelectValue" $     it "produces valid cursors" $-      producesValidsOnValids3-        (mapCursorAppendAndSelectValue @Rational @Rational)+    producesValidsOnValids3 (mapCursorAppendAndSelectValue @Bool @Bool)   describe "mapCursorRemoveElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorRemoveElem @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorRemoveElem @Bool @Bool)     it "removes an element" pending   describe "mapCursorDeleteElem" $ do-    it "produces valid cursors" $-      producesValidsOnValids (mapCursorDeleteElem @Rational @Rational)+    it "produces valid cursors" $ producesValidsOnValids (mapCursorDeleteElem @Bool @Bool)     it "deletes an element" pending   describe "mapCursorSearch" $ do     it "produces valid cursors when looking for an equal pair" $       forAllValid $ \(k, v) ->-        producesValidsOnValids $-        mapCursorSearch @Rational @Rational (\k_ v_ -> k_ == k && v_ == v)-    it-      "is indeed the right value when it finds a value and is looking for an equal element" $+        producesValidsOnValids $ mapCursorSearch @Bool @Bool (\k_ v_ -> k_ == k && v_ == v)+    it "is indeed the right value when it finds a value and is looking for an equal element" $       forAllValid $ \(k, v) ->         forAllValid $ \nec ->           case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of             Nothing -> pure ()-            Just e ->-              rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe`-              (k :: Rational, v :: Rational)-  describe "mapCursorSelectOrAdd" $ do+            Just e -> rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe` (k :: Bool, v :: Bool)+  describe "mapCursorSelectOrAdd" $     it "produces valid cursors when looking for an equal element" $-      forAllValid $ \(k, v) ->-        producesValidsOnValids $-        mapCursorSelectOrAdd-          (\k_ v_ -> k_ == k && v_ == v)-          (makeKeyValueCursorKey (k :: Rational) (v :: Rational))+    forAllValid $ \(k, v) ->+      producesValidsOnValids $+      mapCursorSelectOrAdd+        (\k_ v_ -> k_ == k && v_ == v)+        (makeKeyValueCursorKey (k :: Bool) (v :: Bool))  isMovementM :: (forall k v. MapCursor k v -> Maybe (MapCursor k v)) -> Property isMovementM func =   forAllValid $ \lec ->-    case func (lec :: MapCursor Rational Rational) of+    case func (lec :: MapCursor Bool Bool) of       Nothing -> pure () -- Fine       Just lec' ->         let ne = rebuildMapCursor lec@@ -164,5 +131,4 @@ isMovement :: (forall k v. MapCursor k v -> MapCursor k v) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildMapCursor (lec :: MapCursor Int Int) `shouldBe`-    rebuildMapCursor (func lec)+    rebuildMapCursor (lec :: MapCursor Bool Bool) `shouldBe` rebuildMapCursor (func lec)

test/Cursor/Simple/Tree/BaseSpec.hs view

@@ -21,28 +21,19 @@ spec :: Spec spec = do   eqSpec @(STC.TreeCursor Int)-  genValidSpec @(STC.TreeCursor Rational)+  genValidSpec @(STC.TreeCursor Bool)   describe "makeTreeCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (makeTreeCursor @Rational)+    it "produces valid cursors" $ producesValidsOnValids (makeTreeCursor @Bool)   describe "makeTreeCursorWithSelection" $-    it "produces valid cursors" $-    producesValidsOnValids2 (makeTreeCursorWithSelection @Rational)+    it "produces valid cursors" $ producesValidsOnValids2 (makeTreeCursorWithSelection @Bool)   describe "singletonTreeCursor" $-    it "produces valid cursors" $-    producesValidsOnValids (singletonTreeCursor @Rational)+    it "produces valid cursors" $ producesValidsOnValids (singletonTreeCursor @Bool)   describe "rebuildTreeCursor" $ do-    it "produces valid trees" $-      producesValidsOnValids (rebuildTreeCursor @Rational)+    it "produces valid trees" $ producesValidsOnValids (rebuildTreeCursor @Bool)     it "is the inverse of makeTreeCursor for integers" $       inverseFunctions (makeTreeCursor @Int) rebuildTreeCursor     it "is the inverse of makeTreeCursorWithSelection for the current selection" $       forAllValid $ \tc ->-        case makeTreeCursorWithSelection-               @Rational-               (treeCursorSelection tc)-               (rebuildTreeCursor tc) of-          Nothing ->-            expectationFailure-              "makeTreeCursorWithSelection should not have failed."+        case makeTreeCursorWithSelection @Bool (treeCursorSelection tc) (rebuildTreeCursor tc) of+          Nothing -> expectationFailure "makeTreeCursorWithSelection should not have failed."           Just r -> r `treeShouldBe` tc

test/Cursor/Simple/Tree/CollapseSpec.hs view

@@ -17,19 +17,14 @@ spec :: Spec spec = do   describe "treeCursorOpenCurrentForest" $-    it "produces valid cursors" $-    producesValidsOnValids $ treeCursorOpenCurrentForest @Rational @Rational+    it "produces valid cursors" $ producesValidsOnValids $ treeCursorOpenCurrentForest @Bool @Bool   describe "treeCursorCloseCurrentForest" $-    it "produces valid cursors" $-    producesValidsOnValids $ treeCursorCloseCurrentForest @Rational @Rational+    it "produces valid cursors" $ producesValidsOnValids $ treeCursorCloseCurrentForest @Bool @Bool   describe "treeCursorToggleCurrentForest" $-    it "produces valid cursors" $-    producesValidsOnValids $ treeCursorToggleCurrentForest @Rational @Rational+    it "produces valid cursors" $ producesValidsOnValids $ treeCursorToggleCurrentForest @Bool @Bool   describe "treeCursorOpenCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $-    treeCursorOpenCurrentForestRecursively @Double @Double+    producesValidsOnValids $ treeCursorOpenCurrentForestRecursively @Bool @Bool   describe "treeCursorToggleCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $-    treeCursorToggleCurrentForestRecursively @Double @Double+    producesValidsOnValids $ treeCursorToggleCurrentForestRecursively @Bool @Bool

test/Cursor/Simple/Tree/DeleteSpec.hs view

@@ -24,36 +24,30 @@ spec = do   describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do     it "produces valids on valids" $-      producesValidsOnValids $-      treeCursorDeleteSubTreeAndSelectPrevious @Rational+      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectPrevious @Bool     it "deletes the current subtree selects the previous subtree" pending   describe "treeCursorDeleteSubTreeAndSelectNext" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Rational+      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Bool     it "deletes the current subtree selects the next subtree" pending   describe "treeCursorDeleteSubTreeAndSelectAbove" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Rational+      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Bool     it "deletes the current subtree selects the above node" pending   describe "treeCursorRemoveSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorRemoveSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorRemoveSubTree @Bool     it "removes the current subtree" pending   describe "treeCursorDeleteSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteSubTree @Bool     it "deletes the current subtree" pending   describe "treeCursorDeleteElemAndSelectPrevious" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Rational+      producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Bool     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =               TreeCursor-                { treeAbove = Nothing-                , treeCurrent = 1 :: Int-                , treeBelow = closedForest [Node 2 fs]-                }+                {treeAbove = Nothing, treeCurrent = 1 :: Int, treeBelow = closedForest [Node 2 fs]}          in case treeCursorDeleteElemAndSelectPrevious simpleDeleteElemStart of               Nothing -> pure ()               Just Deleted ->@@ -65,22 +59,16 @@     it "deletes the current element and selects the previous element" pending   describe "treeCursorDeleteElemAndSelectNext" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Rational+      producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Bool     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =-              TreeCursor-                { treeAbove = Nothing-                , treeCurrent = 1-                , treeBelow = openForest [CNode 2 fs]-                }+              TreeCursor {treeAbove = Nothing, treeCurrent = 1, treeBelow = openForest [CNode 2 fs]}             simpleDeleteElemExpected =-              TreeCursor-                {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs}+              TreeCursor {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs}          in case treeCursorDeleteElemAndSelectNext simpleDeleteElemStart of               Nothing ->-                expectationFailure-                  "treeCursorDeleteElemAndSelectNext should not have failed."+                expectationFailure "treeCursorDeleteElemAndSelectNext should not have failed."               Just Deleted ->                 expectationFailure                   "treeCursorDeleteElemAndSelectNext should not have deleted the entire example tree."@@ -88,15 +76,12 @@     it "deletes the current element and selects the next element" pending   describe "treeCursorDeleteElemAndSelectAbove" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Rational+      producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Bool     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =               TreeCursor-                { treeAbove = Nothing-                , treeCurrent = 1 :: Int-                , treeBelow = closedForest [Node 2 fs]-                }+                {treeAbove = Nothing, treeCurrent = 1 :: Int, treeBelow = closedForest [Node 2 fs]}          in case treeCursorDeleteElemAndSelectAbove simpleDeleteElemStart of               Nothing -> pure ()               Just Deleted ->@@ -107,10 +92,8 @@                   "treeCursorDeleteElemAndSelectAbove should not have updated the example tree, but failed instead."     it "deletes the current element and selects the above element" pending   describe "treeCursorRemoveElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorRemoveElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorRemoveElem @Bool     it "removes the current element" pending   describe "treeCursorDeleteElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteElem @Bool     it "deletes the current element" pending

test/Cursor/Simple/Tree/DemoteSpec.hs view

@@ -23,8 +23,7 @@ spec = do   functorSpec @DemoteResult   describe "treeCursorDemoteElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDemoteElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDemoteElem @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor@@ -61,12 +60,10 @@               }        in case treeCursorDemoteElem promoteStart of             Demoted tc' -> tc' `treeShouldBe` promoteEnd-            _ ->-              expectationFailure "treeCursorDemoteElem should not have failed"+            _ -> expectationFailure "treeCursorDemoteElem should not have failed"     it "demotes the current node to the level of its children" pending   describe "treeCursorDemoteSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDemoteSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDemoteSubTree @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor@@ -103,13 +100,10 @@               }        in case treeCursorDemoteSubTree promoteStart of             Demoted tc' -> tc' `treeShouldBe` promoteEnd-            _ ->-              expectationFailure-                "treeCursorDemoteSubTree should not have failed"+            _ -> expectationFailure "treeCursorDemoteSubTree should not have failed"     it "demotes the current subtree to the level of its children" pending   describe "treeCursorDemoteElemUnder" $ do-    it "produces valids on valids" $-      producesValidsOnValids3 $ treeCursorDemoteElemUnder @Rational @Rational+    it "produces valids on valids" $ producesValidsOnValids3 $ treeCursorDemoteElemUnder @Bool @Bool     it "Works on the example from the docs" $       forAllValid $ \b1 ->         forAllValid $ \b2 ->@@ -148,21 +142,16 @@                   }            in case treeCursorDemoteElemUnder b1 b2 demoteStart of                 Just tc' -> tc' `treeShouldBe` demoteEnd-                _ ->-                  expectationFailure-                    "treeCursorDemoteElemUnder should not have failed"+                _ -> expectationFailure "treeCursorDemoteElemUnder should not have failed"     it "demotes the current node to the level of its children" pending   describe "treeCursorDemoteSubTreeUnder" $ do     it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorDemoteSubTreeUnder @Rational @Rational+      producesValidsOnValids2 $ treeCursorDemoteSubTreeUnder @Bool @Bool     it "Works on the example from the docs" $       forAllValid $ \v -> do         let demoteStart =               TreeCursor-                { treeAbove = Nothing-                , treeCurrent = 'a'-                , treeBelow = closedForest [Node 'b' []]-                }+                {treeAbove = Nothing, treeCurrent = 'a', treeBelow = closedForest [Node 'b' []]}             demoteEnd =               TreeCursor                 { treeAbove =@@ -177,6 +166,4 @@                 , treeBelow = closedForest [Node 'b' []]                 }         treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe` demoteEnd-    it-      "demotes the current subtree to the level of its children, by adding a root"-      pending+    it "demotes the current subtree to the level of its children, by adding a root" pending

test/Cursor/Simple/Tree/InsertSpec.hs view

@@ -17,32 +17,23 @@ spec :: Spec spec = do   describe "treeCursorInsert" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorInsert @Rational @Rational+    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsert @Bool @Bool     it "inserts the element" pending   describe "treeCursorInsertAndSelect" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorInsertAndSelect @Rational+    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsertAndSelect @Bool     it "inserts and select the element" pending   describe "treeCursorAppend" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorAppend @Rational @Rational+    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppend @Bool @Bool     it "appends the element" pending   describe "treeCursorAppendAndSelect" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorAppendAndSelect @Rational+    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppendAndSelect @Bool     it "appends and select the element" pending   describe "treeCursorAddChildAtPos" $ do-    it "produces valid cursors " $-      producesValidsOnValids3 $ treeCursorAddChildAtPos @Rational @Rational-    it-      "adds a tree at the given index in the children of the current node"-      pending+    it "produces valid cursors " $ producesValidsOnValids3 $ treeCursorAddChildAtPos @Bool @Bool+    it "adds a tree at the given index in the children of the current node" pending   describe "treeCursorAddChildAtStart" $ do-    it "produces valid cursors " $-      producesValidsOnValids2 $ treeCursorAddChildAtStart @Rational @Rational+    it "produces valid cursors " $ producesValidsOnValids2 $ treeCursorAddChildAtStart @Bool @Bool     it "adds a tree at the start of the children of the current node" pending   describe "treeCursorAddChildAtEnd" $ do-    it "produces valid cursors " $-      producesValidsOnValids2 $ treeCursorAddChildAtEnd @Rational @Rational+    it "produces valid cursors " $ producesValidsOnValids2 $ treeCursorAddChildAtEnd @Bool @Bool     it "adds a tree at the end of the children of the current node" pending

test/Cursor/Simple/Tree/MovementSpec.hs view

@@ -17,30 +17,21 @@  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree-  ( CTree(..)-  , TreeAbove(..)-  , TreeCursor(..)-  , emptyCForest-  , openForest-  )+import Cursor.Tree (CTree(..), TreeAbove(..), TreeCursor(..), emptyCForest, openForest)  import Cursor.Simple.Tree.TestUtils  spec :: Spec spec = do   describe "treeCursorSelection" $-    it "produces valids on valids" $-    producesValidsOnValids (treeCursorSelection @Rational @Rational)+    it "produces valids on valids" $ producesValidsOnValids (treeCursorSelection @Bool @Bool)   describe "treeCursorSelect" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 (treeCursorSelect @Rational)+    it "produces valids on valids" $ producesValidsOnValids2 (treeCursorSelect @Bool)     it "is identity with the current selection" $       forAllValid $ \tc ->         let sel = treeCursorSelection tc-         in case treeCursorSelect @Rational sel tc of-              Nothing ->-                expectationFailure "treeCursorSelect should not have failed."+         in case treeCursorSelect @Bool sel tc of+              Nothing -> expectationFailure "treeCursorSelect should not have failed."               Just r ->                 unless (r == tc) $                 expectationFailure $@@ -55,17 +46,17 @@   describe "treeCursorSelectPrevOnSameLevel" $ do     testMovementM treeCursorSelectPrevOnSameLevel     it "selects the previous element" pending-    it "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $ do+    it "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $       inverseFunctionsIfSucceedOnValid-        (treeCursorSelectNextOnSameLevel @Rational)-        (treeCursorSelectPrevOnSameLevel @Rational)+        (treeCursorSelectNextOnSameLevel @Bool)+        (treeCursorSelectPrevOnSameLevel @Bool)   describe "treeCursorSelectNextOnSameLevel" $ do     testMovementM treeCursorSelectNextOnSameLevel     it "selects the next element" pending-    it "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ do+    it "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $       inverseFunctionsIfSucceedOnValid-        (treeCursorSelectPrevOnSameLevel @Rational)-        (treeCursorSelectNextOnSameLevel @Rational)+        (treeCursorSelectPrevOnSameLevel @Bool)+        (treeCursorSelectNextOnSameLevel @Bool)   describe "treeCursorSelectAbovePrev" $ do     testMovementM treeCursorSelectAbovePrev     it "Works for this classic example" $@@ -81,10 +72,7 @@                   Just                     (TreeAbove                        { treeAboveLefts =-                           [ CNode 1 $-                             openForest-                               [CNode 2 $ openForest [CNode 3 emptyCForest]]-                           ]+                           [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]]                        , treeAboveAbove = Nothing                        , treeAboveNode = 0                        , treeAboveRights = []@@ -108,8 +96,7 @@                                          { treeAboveLefts = []                                          , treeAboveAbove = Nothing                                          , treeAboveNode = 0-                                         , treeAboveRights =-                                             [CNode 4 emptyCForest]+                                         , treeAboveRights = [CNode 4 emptyCForest]                                          })                                 , treeAboveNode = 1                                 , treeAboveRights = []@@ -121,19 +108,16 @@               , treeBelow = emptyCForest               }       case treeCursorSelectAbovePrev start of-        Nothing ->-          expectationFailure "treeCursorSelectAbovePrev should not have failed"+        Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed"         Just r -> r `treeShouldBe` expected     it "selects the previous element" pending-    it "after treeCursorSelectAboveNext is identity if they don't fail" $ do+    it "after treeCursorSelectAboveNext is identity if they don't fail" $       forAllValid $ \tc ->-        case treeCursorSelectAboveNext @Rational tc of+        case treeCursorSelectAboveNext @Bool tc of           Nothing -> pure ()           Just tc' ->             case treeCursorSelectAbovePrev tc' of-              Nothing ->-                expectationFailure-                  "treeCursorSelectAbovePrev should not have failed."+              Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed."               Just tc'' ->                 unless (tc == tc'') $                 expectationFailure $@@ -190,10 +174,7 @@                   Just                     (TreeAbove                        { treeAboveLefts =-                           [ CNode 1 $-                             openForest-                               [CNode 2 $ openForest [CNode 3 emptyCForest]]-                           ]+                           [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]]                        , treeAboveAbove = Nothing                        , treeAboveNode = 0                        , treeAboveRights = []@@ -202,13 +183,12 @@               , treeBelow = emptyCForest               }       case treeCursorSelectAboveNext start of-        Nothing ->-          expectationFailure "treeCursorSelectAboveNext should not have failed."+        Nothing -> expectationFailure "treeCursorSelectAboveNext should not have failed."         Just r -> r `treeShouldBe` expected     it "selects the next element" pending-    it "after treeCursorSelectAbovePrev is identity if they don't fail" $ do+    it "after treeCursorSelectAbovePrev is identity if they don't fail" $       forAllValid $ \tc ->-        case treeCursorSelectAbovePrev @Rational tc of+        case treeCursorSelectAbovePrev @Bool tc of           Nothing -> pure ()           Just tc' ->             case treeCursorSelectAboveNext tc' of@@ -230,36 +210,30 @@   describe "treeCursorSelectPrev" $ do     testMovementM treeCursorSelectPrev     it "selects the previous element" pending-    it "after treeCursorSelectNext is identity if they don't fail" $ do-      inverseFunctionsIfSucceedOnValid-        (treeCursorSelectNext @Rational)-        (treeCursorSelectPrev @Rational)+    it "after treeCursorSelectNext is identity if they don't fail" $+      inverseFunctionsIfSucceedOnValid (treeCursorSelectNext @Bool) (treeCursorSelectPrev @Bool)   describe "treeCursorSelectNext" $ do     testMovementM treeCursorSelectNext     it "selects the next element" pending-    it "after treeCursorSelectPrev is identity if they don't fail" $ do-      inverseFunctionsIfSucceedOnValid-        (treeCursorSelectPrev @Rational)-        (treeCursorSelectNext @Rational)+    it "after treeCursorSelectPrev is identity if they don't fail" $+      inverseFunctionsIfSucceedOnValid (treeCursorSelectPrev @Bool) (treeCursorSelectNext @Bool)   describe "treeCursorSelectFirst" $ do     testMovement treeCursorSelectFirst     it "selects the first element" pending-    it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Rational+    it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Bool   describe "treeCursorSelectLast" $ do     testMovement treeCursorSelectLast     it "selects the last element" pending-    it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Rational+    it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Bool   describe "treeCursorSelectAbove" $ do     testMovementM treeCursorSelectAbove     it "selects the element above" pending-    it "after treeCursorSelectBelow is identity if they don't fail" $ do-      inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Rational) $-        treeCursorSelectAbove @Rational+    it "after treeCursorSelectBelow is identity if they don't fail" $+      inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Bool) $+      treeCursorSelectAbove @Bool   describe "treeCursorSelectBelowAtPos" $ do-    it "produces valids on valids" $-      producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Rational-    it "is a movement" $-      forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n+    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Bool+    it "is a movement" $ forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n     it "selects the element n-th below" pending   describe "treeCursorSelectBelowAtStart" $ do     testMovementM treeCursorSelectBelowAtStart

test/Cursor/Simple/Tree/PromoteSpec.hs view

@@ -32,8 +32,7 @@   applicativeSpec @PromoteElemResult   monadSpec @PromoteElemResult   describe "treeCursorPromoteElem" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorPromoteElem @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteElem @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor@@ -64,10 +63,7 @@                           [ CNode 'a' $                             openForest                               [ CNode 'b' $-                                openForest-                                  [ CNode 'c' emptyCForest-                                  , CNode 'e' emptyCForest-                                  ]+                                openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest]                               , CNode 'f' $ closedForest [Node 'g' []]                               ]                           ]@@ -80,23 +76,20 @@               }        in case treeCursorPromoteElem promoteStart of             PromotedElem tc' -> tc' `treeShouldBe` promoteEnd-            _ ->-              expectationFailure "treeCursorPromoteElem should not have failed"+            _ -> expectationFailure "treeCursorPromoteElem should not have failed"     it "promotes the current node to the level of its parent" pending   functorSpec @PromoteResult   applicativeSpec @PromoteResult   monadSpec @PromoteResult   describe "treeCursorPromoteSubTree" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorPromoteSubTree @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteSubTree @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts =-                          [CNode 'b' $ closedForest [Node 'c' []]]+                      { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]                       , treeAboveAbove =                           Just                             TreeAbove@@ -106,8 +99,7 @@                               , treeAboveRights = [node 'h' []]                               }                       , treeAboveNode = 'a'-                      , treeAboveRights =-                          [CNode 'f' $ closedForest [Node 'g' []]]+                      , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]                       }               , treeCurrent = 'd'               , treeBelow = closedForest [Node 'e' []]@@ -133,7 +125,5 @@               }        in case treeCursorPromoteSubTree promoteStart of             Promoted tc' -> tc' `treeShouldBe` promoteEnd-            _ ->-              expectationFailure-                "treeCursorPromoteSubTree should not have failed"+            _ -> expectationFailure "treeCursorPromoteSubTree should not have failed"     it "promotes the current subtree to the level of its parent" pending

test/Cursor/Simple/Tree/SwapSpec.hs view

@@ -21,8 +21,7 @@ spec = do   functorSpec @SwapResult   describe "treeCursorSwapPrev" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorSwapPrev @Rational @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorSwapPrev @Bool @Bool     it "works on the example from the docs" $       let start =             TreeCursor@@ -55,12 +54,11 @@             _ -> expectationFailure "treeCursorSwapPrev should not have failed."     it "reverts treeCursorSwapNext" $       inverseFunctionsIfSucceedOnValid-        (treeCursorSwapNext @Rational @Rational)-        (treeCursorSwapPrev @Rational @Rational)+        (treeCursorSwapNext @Bool @Bool)+        (treeCursorSwapPrev @Bool @Bool)     it "swaps the current node with the previous node" pending   describe "treeCursorSwapNext" $ do-    it "produces valids on valids" $-      producesValidsOnValids $ treeCursorSwapNext @Rational @Rational+    it "produces valids on valids" $ producesValidsOnValids $ treeCursorSwapNext @Bool @Bool     it "works on the example from the docs" $       let start =             TreeCursor@@ -93,6 +91,6 @@             _ -> expectationFailure "treeCursorSwapNext should not have failed."     it "reverts treeCursorSwapNext" $       inverseFunctionsIfSucceedOnValid-        (treeCursorSwapPrev @Rational @Rational)-        (treeCursorSwapNext @Rational @Rational)+        (treeCursorSwapPrev @Bool @Bool)+        (treeCursorSwapNext @Bool @Bool)     it "swaps the current node with the next node" pending

test/Cursor/Simple/Tree/TestUtils.hs view

@@ -22,17 +22,15 @@  testMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Spec testMovement func = do-  it "produces valids on valids" $ producesValidsOnValids $ func @Rational+  it "produces valids on valids" $ producesValidsOnValids $ func @Bool   it "is a movement" $ isMovement func -testMovementM ::-     (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec+testMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec testMovementM func = do-  it "produces valids on valids" $ producesValidsOnValids $ func @Rational+  it "produces valids on valids" $ producesValidsOnValids $ func @Bool   it "is a movement" $ isMovementM func -isMovementM ::-     (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property+isMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property isMovementM func =   forAllValid @(STC.TreeCursor Int) $ \lec ->     case func lec of@@ -52,11 +50,9 @@ isMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Property isMovement func =   forAllValid $ \lec ->-    rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe`-    rebuildTreeCursor (func lec)+    rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe` rebuildTreeCursor (func lec) -treeShouldBe ::-     (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation+treeShouldBe :: (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation treeShouldBe actual expected =   unless (actual == expected) $   expectationFailure $

test/Cursor/TextFieldSpec.hs view

@@ -1,4 +1,3 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-}@@ -143,7 +142,7 @@   describe "textFieldCursorInsertNewline" $ do     it "produces valid cursors" $ producesValidsOnValids textFieldCursorInsertNewline     it "inserts a new line" pending-  describe "textFieldCursorAppendNewline" $ do+  describe "textFieldCursorAppendNewline" $     it "produces valid cursors" $ producesValidsOnValids textFieldCursorAppendNewline   describe "textFieldCursorRemove" $ do     it "produces valid cursors" $ producesValidsOnValids textFieldCursorRemove

test/Cursor/TextSpec.hs view

@@ -82,16 +82,16 @@     it "returns the item after the position" pending   describe "textCursorInsert" $ do     it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)-    it "inserts an item before the cursor" $ pending+    it "inserts an item before the cursor" pending   describe "textCursorAppend" $ do     it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)-    it "inserts an item after the cursor" $ pending+    it "inserts an item after the cursor" pending   describe "textCursorRemove" $ do     it "produces valids" $ validIfSucceedsOnValid textCursorRemove-    it "removes an item before the cursor" $ pending+    it "removes an item before the cursor" pending   describe "textCursorDelete" $ do     it "produces valids" $ validIfSucceedsOnValid textCursorDelete-    it "removes an item before the cursor" $ pending+    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" $

test/Cursor/Tree/TypesSpec.hs view

@@ -21,39 +21,35 @@   eqSpec @TreeCursorSelection   genValidSpec @TreeCursorSelection   shrinkValidSpecWithLimit @TreeCursorSelection 10-  eqSpec @(SwapResult Int)-  genValidSpec @(SwapResult Rational)-  shrinkValidSpecWithLimit @(SwapResult Int) 10-  eqSpec @(PromoteElemResult Int)-  genValidSpec @(PromoteElemResult Rational)-  shrinkValidSpecWithLimit @(PromoteElemResult Int) 10-  eqSpec @(PromoteResult Int)-  genValidSpec @(PromoteResult Rational)-  shrinkValidSpecWithLimit @(PromoteResult Int) 10-  eqSpec @(DemoteResult Int)-  genValidSpec @(DemoteResult Rational)-  shrinkValidSpecWithLimit @(DemoteResult Int) 10-  eqSpec @(CTree Int)-  genValidSpec @(CTree Rational)-  shrinkValidSpecWithLimit @(CTree Int) 10-  eqSpec @(CForest Int)-  genValidSpec @(CForest Rational)-  shrinkValidSpecWithLimit @(CForest Int) 10-  eqSpec @(TreeAbove Int)-  genValidSpec @(TreeAbove Rational)-  shrinkValidSpecWithLimit @(TreeAbove Int) 10-  describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Rational-  describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Rational-  describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Rational-  describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Rational-  eqSpec @(TreeCursor Int Word)-  genValidSpec @(TreeCursor Rational Rational)-  shrinkValidSpecWithLimit @(TreeCursor Word Int) 10-  describe "treeCursorAboveL" $-    lensSpecOnValid $ treeCursorAboveL @Rational @Rational-  describe "treeCursorCurrentL" $-    lensSpecOnValid $ treeCursorCurrentL @Rational @Rational-  describe "treeCursorBelowL" $-    lensSpecOnValid $ treeCursorBelowL @Rational @Rational-  describe "treeCursorCurrentSubTreeL" $-    lensSpecOnValid $ treeCursorCurrentSubTreeL @Rational @Rational+  eqSpec @(SwapResult Bool)+  genValidSpec @(SwapResult Bool)+  shrinkValidSpecWithLimit @(SwapResult Bool) 10+  eqSpec @(PromoteElemResult Bool)+  genValidSpec @(PromoteElemResult Bool)+  shrinkValidSpecWithLimit @(PromoteElemResult Bool) 10+  eqSpec @(PromoteResult Bool)+  genValidSpec @(PromoteResult Bool)+  shrinkValidSpecWithLimit @(PromoteResult Bool) 10+  eqSpec @(DemoteResult Bool)+  genValidSpec @(DemoteResult Bool)+  shrinkValidSpecWithLimit @(DemoteResult Bool) 10+  eqSpec @(CTree Bool)+  genValidSpec @(CTree Bool)+  shrinkValidSpecWithLimit @(CTree Bool) 10+  eqSpec @(CForest Bool)+  genValidSpec @(CForest Bool)+  shrinkValidSpecWithLimit @(CForest Bool) 10+  eqSpec @(TreeAbove Bool)+  genValidSpec @(TreeAbove Bool)+  shrinkValidSpecWithLimit @(TreeAbove Bool) 10+  describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Bool+  describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Bool+  describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Bool+  describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Bool+  eqSpec @(TreeCursor Bool Word)+  genValidSpec @(TreeCursor Bool Bool)+  shrinkValidSpecWithLimit @(TreeCursor Word Bool) 10+  describe "treeCursorAboveL" $ lensSpecOnValid $ treeCursorAboveL @Bool @Bool+  describe "treeCursorCurrentL" $ lensSpecOnValid $ treeCursorCurrentL @Bool @Bool+  describe "treeCursorBelowL" $ lensSpecOnValid $ treeCursorBelowL @Bool @Bool+  describe "treeCursorCurrentSubTreeL" $ lensSpecOnValid $ treeCursorCurrentSubTreeL @Bool @Bool