cursor-gen 0.3.0.0 → 0.4.0.0

raw patch · 38 files changed

+1844/−1511 lines, 38 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−1
• LICENSE +1/−1
• Setup.hs +0/−3
• bench/Bench.hs +20/−23
• cursor-gen.cabal +4/−4
• src/Cursor/Forest/Gen.hs +4/−9
• src/Cursor/List/Gen.hs +5/−16
• src/Cursor/List/NonEmpty/Gen.hs +12/−20
• src/Cursor/Map/Gen.hs +13/−14
• src/Cursor/Map/KeyValue/Gen.hs +13/−13
• src/Cursor/Simple/Forest/Gen.hs +2/−1
• src/Cursor/Simple/List/NonEmpty/Gen.hs +6/−6
• src/Cursor/Simple/Map/Gen.hs +2/−1
• src/Cursor/Simple/Map/KeyValue/Gen.hs +2/−1
• src/Cursor/Simple/Tree/Gen.hs +2/−1
• src/Cursor/Text/Gen.hs +32/−14
• src/Cursor/TextField/Gen.hs +4/−7
• src/Cursor/Tree/Gen.hs +4/−64
• test/Cursor/List/NonEmptySpec.hs +11/−12
• test/Cursor/ListSpec.hs +74/−42
• test/Cursor/Map/KeyValueSpec.hs +5/−6
• test/Cursor/MapSpec.hs +6/−6
• test/Cursor/Simple/ForestSpec.hs +548/−448
• test/Cursor/Simple/List/NonEmptySpec.hs +73/−58
• test/Cursor/Simple/Map/KeyValueSpec.hs +15/−14
• test/Cursor/Simple/MapSpec.hs +67/−58
• test/Cursor/Simple/Tree/BaseSpec.hs +21/−16
• test/Cursor/Simple/Tree/CollapseSpec.hs +19/−12
• test/Cursor/Simple/Tree/DeleteSpec.hs +58/−47
• test/Cursor/Simple/Tree/DemoteSpec.hs +107/−104
• test/Cursor/Simple/Tree/InsertSpec.hs +114/−15
• test/Cursor/Simple/Tree/MovementSpec.hs +192/−178
• test/Cursor/Simple/Tree/PromoteSpec.hs +61/−66
• test/Cursor/Simple/Tree/SwapSpec.hs +39/−41
• test/Cursor/Simple/Tree/TestUtils.hs +23/−27
• test/Cursor/TextFieldSpec.hs +118/−94
• test/Cursor/TextSpec.hs +144/−53
• test/Cursor/Tree/TypesSpec.hs +14/−15

@@ -1,12 +1,20 @@ # Changelog -## [Unreleased]+## [0.4.0.0] - 2021-11-21 +### Changed++* Compatibility with `genvalidity >=1.0.0.0`+ ## [0.3.0.0] - 2020-02-14 +### Added+ * Benchmarks for cursor generation  ## [0.2.0.0] - 2019-09-23++### Changed  * Fixed the generator for `TextFieldCursor` to be compatible with the new validity constraint in cursor-0.2.0.0. * Fixed the shrinking function for `TextFieldCursor`.

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2018 Tom Sydney Kerckhove+Copyright (c) 2018-2021 Tom Sydney Kerckhove  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,3 +0,0 @@-import Distribution.Simple--main = defaultMain

@@ -3,42 +3,39 @@ module Main where  import Criterion.Main as Criterion--import Data.GenValidity.Criterion- import Cursor.Forest.Gen ()+import Cursor.List 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.Text.Gen () import Cursor.TextField+import Cursor.TextField.Gen ()+import Cursor.Tree.Gen ()+import Data.GenValidity.Criterion  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+    [ 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     ]

@@ -1,20 +1,20 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: ca8f0d880d4a2aa40bc3c0de55b6c000b047b412f701f38af7d0da3f5c4346a2+-- hash: 22ff370fec49a2935a5592601cfd45bcdce55a0343352c14841cc1d09ceb9de8  name:           cursor-gen-version:        0.3.0.0+version:        0.4.0.0 synopsis:       Generators for Purely Functional Cursors description:    Generators for Purely Functional Cursors for common data structures category:       Cursor homepage:       https://github.com/NorfairKing/cursor author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove+copyright:      Copyright: (c) 2018-2021 Tom Sydney Kerckhove license:        MIT license-file:   LICENSE build-type:     Simple

@@ -2,19 +2,14 @@  module Cursor.Forest.Gen   (-  ) where--import Data.GenValidity-import Data.GenValidity.Containers ()+  )+where  import Cursor.Forest- import Cursor.List.NonEmpty.Gen () import Cursor.Tree.Gen ()--instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (ForestCursor a b) where-  genUnchecked = ForestCursor <$> genUnchecked-  shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne+import Data.GenValidity+import Data.GenValidity.Containers ()  instance (GenValid a, GenValid b) => GenValid (ForestCursor a b) where   genValid = ForestCursor <$> genValid

@@ -2,25 +2,14 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.List.Gen-  ( listCursorWithGen-  , listCursorWithIndex0-  ) where--import Test.QuickCheck+  ( listCursorWithGen,+    listCursorWithIndex0,+  )+where  import Cursor.List- import Data.GenValidity--instance GenUnchecked a => GenUnchecked (ListCursor a) where-  genUnchecked =-    sized $ \n -> do-      (a, b) <- genSplit n-      listCursorPrev <- resize a genUnchecked-      listCursorNext <- resize b genUnchecked-      pure ListCursor {..}-  shrinkUnchecked (ListCursor prev next) =-    [ListCursor prev' next' | (prev', next') <- shrinkUnchecked (prev, next)]+import Test.QuickCheck  instance GenValid a => GenValid (ListCursor a) where   genValid =

@@ -2,26 +2,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.List.NonEmpty.Gen-  ( genNonEmptyCursorBy-  , nonEmptyElemOf-  , nonEmptyWithIndex0-  , nonEmptyWith-  ) where+  ( genNonEmptyCursorBy,+    nonEmptyElemOf,+    nonEmptyWithIndex0,+    nonEmptyWith,+  )+where  import Control.Monad-+import Cursor.List.NonEmpty import Data.GenValidity--import Test.QuickCheck- import qualified Data.List.NonEmpty as NE--import Cursor.List.NonEmpty--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)]+import Test.QuickCheck  instance (GenValid a, GenValid b) => GenValid (NonEmptyCursor a b) where   genValid = genNonEmptyCursorBy genValid genValid@@ -34,7 +26,7 @@     part <- arbPartition n     case part of       [] -> singletonNonEmptyCursor <$> resize 0 genA-      (s:ss) -> do+      (s : ss) -> do         i <- choose (0, length ss)         let (as, bs) = splitAt i ss         nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genB@@ -51,9 +43,9 @@ nonEmptyWith :: a -> Gen a -> Gen (NonEmptyCursor a a) nonEmptyWith a g =   oneof-    [ NonEmptyCursor <$> listWithA <*> g <*> genListOf g-    , NonEmptyCursor <$> genListOf g <*> pure a <*> genListOf g-    , NonEmptyCursor <$> genListOf g <*> g <*> listWithA+    [ NonEmptyCursor <$> listWithA <*> g <*> genListOf g,+      NonEmptyCursor <$> genListOf g <*> pure a <*> genListOf g,+      NonEmptyCursor <$> genListOf g <*> g <*> listWithA     ]   where     listWithA = do

@@ -1,28 +1,27 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Map.Gen-  ( genMapCursorBy-  ) where+  ( genMapCursorBy,+    genMapCursorByDependent,+  )+where +import Cursor.List.NonEmpty.Gen+import Cursor.Map+import Cursor.Map.KeyValue.Gen import Data.GenValidity import Data.GenValidity.Containers ()- import Test.QuickCheck -import Cursor.Map--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) where-  genUnchecked = genMapCursorBy genUnchecked genUnchecked genUnchecked genUnchecked- 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)+  MapCursor+    <$> genNonEmptyCursorBy (genKeyValueCursorBy genKC genVC genK genV) ((,) <$> genK <*> genV)++genMapCursorByDependent :: Gen (kc, v) -> Gen (k, vc) -> Gen (k, v) -> Gen (MapCursor kc vc k v)+genMapCursorByDependent genKVCK genKVCV genKV =+  MapCursor <$> genNonEmptyCursorBy (genKeyValueCursorByDependent genKVCK genKVCV) genKV

@@ -1,28 +1,28 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Map.KeyValue.Gen-  ( genKeyValueCursorBy-  ) where+  ( genKeyValueCursorBy,+    genKeyValueCursorByDependent,+  )+where +import Cursor.Map.KeyValue 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) where-  genUnchecked = genKeyValueCursorBy genUnchecked genUnchecked genUnchecked genUnchecked--instance (GenValid kc, GenValid vc, GenValid k, GenValid v) =>-         GenValid (KeyValueCursor kc vc k v) where+instance+  (GenValid kc, GenValid vc, GenValid k, GenValid v) =>+  GenValid (KeyValueCursor kc vc k v)+  where   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]++genKeyValueCursorByDependent :: Gen (kc, v) -> Gen (k, vc) -> Gen (KeyValueCursor kc vc k v)+genKeyValueCursorByDependent genKVCK genKVCV =+  oneof [uncurry KeyValueCursorKey <$> genKVCK, uncurry KeyValueCursorValue <$> genKVCV]

@@ -1,5 +1,6 @@ module Cursor.Simple.Forest.Gen   (-  ) where+  )+where  import Cursor.Forest.Gen ()

@@ -1,13 +1,13 @@ module Cursor.Simple.List.NonEmpty.Gen-  ( nonEmptyElemOf-  , nonEmptyWithIndex0-  , nonEmptyWith-  ) where--import Test.QuickCheck+  ( nonEmptyElemOf,+    nonEmptyWithIndex0,+    nonEmptyWith,+  )+where  import qualified Cursor.List.NonEmpty.Gen as NEC import Cursor.Simple.List.NonEmpty+import Test.QuickCheck  nonEmptyElemOf :: NonEmptyCursor a -> Gen a nonEmptyElemOf = NEC.nonEmptyElemOf

@@ -1,5 +1,6 @@ module Cursor.Simple.Map.Gen   (-  ) where+  )+where  import Cursor.Map.Gen ()

@@ -1,5 +1,6 @@ module Cursor.Simple.Map.KeyValue.Gen   (-  ) where+  )+where  import Cursor.Map.KeyValue.Gen ()

@@ -1,5 +1,6 @@ module Cursor.Simple.Tree.Gen   (-  ) where+  )+where  import Cursor.Tree.Gen ()

@@ -1,23 +1,23 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Text.Gen-  ( genSafeChar-  , genTextCursorChar-  , textCursorWithGen-  , textCursorWithIndex0-  ) where--import Test.QuickCheck--import Data.GenValidity-import Data.GenValidity.Text ()+  ( genSafeChar,+    genTextCursorChar,+    textCursorSentenceGen,+    textCursorWithGen,+    textCursorWithIndex0,+    shrinkSentence,+  )+where +import Cursor.List+import Cursor.List.Gen import Cursor.Text import Cursor.Types--import Cursor.List.Gen--instance GenUnchecked TextCursor+import Data.Char (isSpace)+import Data.GenValidity+import Data.GenValidity.Text ()+import Test.QuickCheck  instance GenValid TextCursor where   genValid = TextCursor <$> listCursorWithGen genTextCursorChar@@ -26,6 +26,9 @@ genSafeChar :: Gen Char genSafeChar = choose (minBound, maxBound) `suchThat` isSafeChar +genSpaceChar :: Gen Char+genSpaceChar = elements [' ', '\t', '\v']+ genTextCursorChar :: Gen Char genTextCursorChar = genSafeChar `suchThat` (/= '\n') @@ -34,3 +37,18 @@  textCursorWithIndex0 :: Gen Char -> Gen TextCursor textCursorWithIndex0 gen = TextCursor <$> listCursorWithIndex0 gen++textCursorSentenceGen :: Gen TextCursor+textCursorSentenceGen = textCursorWithGen sentenceGen+  where+    sentenceGen :: Gen Char+    sentenceGen = frequency [(1, genSpaceChar), (5, genSafeChar)]++shrinkSentence :: TextCursor -> [TextCursor]+shrinkSentence tc@(TextCursor (ListCursor before after)) =+  filter (/= tc) [TextCursor (ListCursor (map f before) (map f after))]+  where+    f :: Char -> Char+    f x+      | isSpace x = ' '+      | otherwise = 'a'

@@ -2,16 +2,13 @@  module Cursor.TextField.Gen where -import Data.GenValidity-import Data.GenValidity.Text--import Test.QuickCheck- import Cursor.List.NonEmpty-import Cursor.TextField- import Cursor.List.NonEmpty.Gen () import Cursor.Text.Gen+import Cursor.TextField+import Data.GenValidity+import Data.GenValidity.Text+import Test.QuickCheck  instance GenValid TextFieldCursor where   genValid =

@@ -4,57 +4,35 @@  module Cursor.Tree.Gen   (-  ) where--import qualified Data.List.NonEmpty as NE-import Data.Maybe+  )+where +import Cursor.Tree import Data.GenValidity import Data.GenValidity.Containers ()-+import qualified Data.List.NonEmpty as NE import Test.QuickCheck -import Cursor.Tree--instance GenUnchecked TreeCursorSelection- instance GenValid TreeCursorSelection where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance GenUnchecked a => GenUnchecked (SwapResult a)- instance GenValid a => GenValid (SwapResult a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance GenUnchecked a => GenUnchecked (PromoteElemResult a)- instance GenValid a => GenValid (PromoteElemResult a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance GenUnchecked a => GenUnchecked (PromoteResult a)- instance GenValid a => GenValid (PromoteResult a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance GenUnchecked a => GenUnchecked (DemoteResult a)- instance GenValid a => GenValid (DemoteResult a) where   genValid = genValidStructurallyWithoutExtraChecking   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering -instance GenUnchecked a => GenUnchecked (CTree a) where-  genUnchecked =-    sized $ \n -> do-      (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)]- instance GenValid a => GenValid (CTree a) where   genValid =     sized $ \n -> do@@ -64,16 +42,6 @@       pure $ CNode val for   shrinkValid (CNode a cf) = [CNode a' cf' | (a', cf') <- shrinkValid (a, cf)] -instance GenUnchecked a => GenUnchecked (CForest a) where-  genUnchecked =-    sized $ \case-      0 -> pure EmptyCForest-      _ -> oneof [ClosedForest <$> genUnchecked, OpenForest <$> genUnchecked]-  shrinkUnchecked EmptyCForest = []-  shrinkUnchecked (ClosedForest ne) = EmptyCForest : (ClosedForest <$> shrinkUnchecked ne)-  shrinkUnchecked (OpenForest ne) =-    EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkUnchecked ne)- instance GenValid a => GenValid (CForest a) where   genValid =     sized $ \case@@ -84,23 +52,6 @@   shrinkValid (OpenForest ne) =     EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne) -instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (TreeCursor a b) where-  genUnchecked =-    sized $ \n -> do-      s <- upTo n-      (a, b, c, d) <- genSplit4 s-      treeAbove <- resize (a + b) genUnchecked-      treeCurrent <- resize c genUnchecked-      treeBelow <- resize d genUnchecked-      pure TreeCursor {..}-  shrinkUnchecked tc =-    let opts =-          catMaybes-            [ do ta <- treeAbove tc-                 pure $ tc {treeAbove = treeAboveAbove ta}-            ]-     in opts ++ genericShrinkUnchecked tc- instance (GenValid a, GenValid b) => GenValid (TreeCursor a b) where   genValid =     sized $ \n -> do@@ -111,17 +62,6 @@       treeBelow <- resize d genValid       pure TreeCursor {..}   shrinkValid = shrinkValidStructurallyWithoutExtraFiltering--instance GenUnchecked b => GenUnchecked (TreeAbove b) where-  genUnchecked =-    sized $ \n -> do-      s <- upTo n-      (a, b, c, d) <- genSplit4 s-      treeAboveLefts <- resize a genUnchecked-      treeAboveAbove <- resize b genUnchecked-      treeAboveNode <- resize c genUnchecked-      treeAboveRights <- resize d genUnchecked-      pure TreeAbove {..}  instance GenValid b => GenValid (TreeAbove b) where   genValid =

@@ -2,25 +2,24 @@ {-# LANGUAGE RankNTypes #-}  module Cursor.List.NonEmptySpec-  ( spec-  ) where+  ( spec,+  )+where +import Cursor.List.NonEmpty+import qualified Data.List.NonEmpty as NE import Test.Hspec import Test.Validity -import qualified Data.List.NonEmpty as NE--import Cursor.List.NonEmpty- spec :: Spec spec = do   describe "nonemptyPrepend" $     it "is equivalent to regular prepend" $-    equivalentWhenFirstSucceeds-      (\(ls1, ls2) -> NE.toList . nonemptyPrepend ls1 <$> NE.nonEmpty ls2)-      (uncurry (++) :: ([Bool], [Bool]) -> [Bool])+      equivalentWhenFirstSucceeds+        (\(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 (++) :: ([Bool], [Bool]) -> [Bool])+      equivalentWhenFirstSucceeds+        (\(ls1, ls2) -> NE.toList . (`nonemptyAppend` ls2) <$> NE.nonEmpty ls1)+        (uncurry (++) :: ([Bool], [Bool]) -> [Bool])

@@ -1,19 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.ListSpec-  ( spec-  ) where--import Test.Hspec-import Test.QuickCheck-import Test.Validity+  ( spec,+  )+where  import Control.Monad- import Cursor.List import Cursor.List.Gen ()+import Test.Hspec+import Test.QuickCheck+import Test.Validity  spec :: Spec spec = do@@ -22,70 +21,103 @@   genValidSpec @(ListCursor Bool)   describe "emptyListCursor" $ it "is valid" $ shouldBeValid (emptyListCursor @Bool)   describe "makeListCursor" $-    it "produces valid list cursors" $ producesValidsOnValids (makeListCursor @Bool)+    it "produces valid list cursors" $+      producesValid (makeListCursor @Bool)   describe "makeListCursorWithSelection" $-    it "produces valid list cursors" $ producesValidsOnValids2 (makeListCursorWithSelection @Bool)+    it "produces valid list cursors" $+      producesValid2 (makeListCursorWithSelection @Bool)   describe "rebuildListCursor" $ do-    it "produces valid lists" $ producesValidsOnValids (rebuildListCursor @Bool)+    it "produces valid lists" $ producesValid (rebuildListCursor @Bool)     it "is the inverse of makeListCursor" $       inverseFunctions (makeListCursor @Bool) rebuildListCursor     it "is the inverse of makeListCursorWithSelection for any index" $-      forAllUnchecked $ \i ->-        inverseFunctionsIfFirstSucceeds (makeListCursorWithSelection @Bool i) rebuildListCursor+      forAllValid $+        \i ->+          inverseFunctionsIfFirstSucceeds (makeListCursorWithSelection @Bool i) rebuildListCursor   describe "listCursorNull" $-    it "produces valid bools" $ producesValidsOnValids (listCursorNull @Bool)+    it "produces valid bools" $+      producesValid (listCursorNull @Bool)   describe "listCursorLength" $-    it "produces valid bools" $ producesValidsOnValids (listCursorLength @Bool)+    it "produces valid bools" $+      producesValid (listCursorLength @Bool)   describe "listCursorIndex" $-    it "produces valid indices" $ producesValidsOnValids (listCursorIndex @Bool)+    it "produces valid indices" $+      producesValid (listCursorIndex @Bool)   describe "listCursorSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectPrev @Bool)+    it "produces valid cursors" $ producesValid (listCursorSelectPrev @Bool)     it "is a movement" $ isMovementM listCursorSelectPrev     it "selects the previous position" pending   describe "listCursorSelectNext" $ do-    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectNext @Bool)+    it "produces valid cursors" $ producesValid (listCursorSelectNext @Bool)     it "is a movement" $ isMovementM listCursorSelectNext     it "selects the next position" pending   describe "listCursorSelectIndex" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (listCursorSelectIndex @Bool)-    it "is a movement" $ forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)+    it "produces valid cursors" $ producesValid2 (listCursorSelectIndex @Bool)+    it "is a movement" $ forAllValid $ \ix -> isMovement (listCursorSelectIndex ix)     it "selects the position at the given index" pending   describe "listCursorPrevItem" $ do-    it "produces valid items" $ producesValidsOnValids (listCursorPrevItem @Bool)+    it "produces valid items" $ producesValid (listCursorPrevItem @Bool)     it "returns the item before the position" pending   describe "listCursorNextItem" $ do-    it "produces valid items" $ producesValidsOnValids (listCursorNextItem @Bool)+    it "produces valid items" $ producesValid (listCursorNextItem @Bool)     it "returns the item after the position" pending+  describe "listCursorPrevUntil" $ do+    it "produces valid cursors" $ producesValid (listCursorPrevUntil @Bool id)+    it "produces a cursor where the previous item either satisfies the predicate or is empty" $+      forAllValid $ \cursor -> do+        let predicate = id+            result = listCursorPrevUntil @Bool predicate cursor+        case listCursorPrevItem result of+          Just item -> item `shouldSatisfy` predicate+          Nothing -> pure ()+  describe "listCursorNextUntil" $ do+    it "produces valid cursors" $ producesValid (listCursorNextUntil @Bool id)+    it "produces a cursor where the previous item either satisfies the predicate or is empty" $+      forAllValid $ \cursor -> do+        let predicate = id+            result = listCursorNextUntil @Bool predicate cursor+        case listCursorNextItem result of+          Just item -> item `shouldSatisfy` predicate+          Nothing -> pure ()   describe "listCursorSelectStart" $ do-    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectStart @Bool)+    it "produces valid cursors" $ producesValid (listCursorSelectStart @Bool)     it "is a movement" $ isMovement listCursorSelectStart-    it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Bool)+    it "is idempotent" $ idempotent (listCursorSelectStart @Bool)     it "selects the starting position" pending   describe "listCursorSelectEnd" $ do-    it "produces valid cursors" $ producesValidsOnValids (listCursorSelectEnd @Bool)+    it "produces valid cursors" $ producesValid (listCursorSelectEnd @Bool)     it "is a movement" $ isMovement listCursorSelectEnd-    it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Bool)+    it "is idempotent" $ idempotent (listCursorSelectEnd @Bool)     it "selects the end position" pending   describe "listCursorInsert" $ do-    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Bool d)+    it "produces valids" $ forAllValid $ \d -> producesValid (listCursorInsert @Bool d)     it "inserts an item before the cursor" pending   describe "listCursorAppend" $ do-    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Bool d)+    it "produces valids" $ forAllValid $ \d -> producesValid (listCursorAppend @Bool d)     it "inserts an item after the cursor" pending+  describe "listCursorInsertList" $+    it "produces valids" $+      forAllValid $+        \d -> producesValid (listCursorInsertList @Bool d)+  describe "listCursorAppendList" $+    it "produces valids" $+      forAllValid $+        \d -> producesValid (listCursorAppendList @Bool d)   describe "listCursorRemove" $ do-    it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Bool)+    it "produces valids" $ validIfSucceeds (listCursorRemove @Bool)     it "removes an item before the cursor" pending   describe "listCursorDelete" $ do-    it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Bool)+    it "produces valids" $ validIfSucceeds (listCursorDelete @Bool)     it "removes an item before the cursor" pending   describe "listCursorSplit" $ do-    it "produces valids" $ producesValidsOnValids (listCursorSplit @Bool)+    it "produces valids" $ producesValid (listCursorSplit @Bool)     it "produces two list cursors that rebuild to the rebuilding of the original" $-      forAllValid $ \lc ->-        let (lc1, lc2) = listCursorSplit (lc :: ListCursor Bool)-         in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe` rebuildListCursor lc+      forAllValid $+        \lc ->+          let (lc1, lc2) = listCursorSplit (lc :: ListCursor Bool)+           in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe` rebuildListCursor lc   describe "listCursorCombine" $ do-    it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Bool)+    it "produces valids" $ producesValid2 (listCursorCombine @Bool)     it "produces a list that rebuilds to the rebuilding of the original two cursors" $       forAllValid $ \lc1 ->         forAllValid $ \lc2 ->@@ -101,13 +133,13 @@         let ne = rebuildListCursor lec             ne' = rebuildListCursor lec'          in unless (ne == ne') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show lec-              , "List before:  \n" ++ show ne-              , "Cursor after: \n" ++ show lec'-              , "List after:   \n" ++ show ne'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show lec,+                    "List before:  \n" ++ show ne,+                    "Cursor after: \n" ++ show lec',+                    "List after:   \n" ++ show ne'+                  ]  isMovement :: (forall a. ListCursor a -> ListCursor a) -> Property isMovement func =

@@ -1,15 +1,14 @@ {-# LANGUAGE TypeApplications #-}  module Cursor.Map.KeyValueSpec-  ( spec-  ) where--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Map.KeyValue import Cursor.Map.KeyValue.Gen ()+import Test.Hspec+import Test.Validity  spec :: Spec spec = do

@@ -1,15 +1,15 @@-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.MapSpec-  ( spec-  ) where--import Test.Hspec-import Test.Validity+  ( spec,+  )+where  import Cursor.Map import Cursor.Map.Gen ()+import Test.Hspec+import Test.Validity  spec :: Spec spec = do

@@ -1,54 +1,57 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.ForestSpec-  ( spec-  ) where--import Data.Tree+  ( spec,+  )+where  import Control.Monad (unless)--import Test.Hspec-import Test.Hspec.QuickCheck-import Test.QuickCheck-import Test.Validity-import Test.Validity.Optics--import Cursor.Forest (ForestCursor(..))+import Cursor.Forest (ForestCursor (..)) import Cursor.List.NonEmpty import Cursor.Simple.Forest hiding (ForestCursor) import qualified Cursor.Simple.Forest as SFC (ForestCursor)+import Cursor.Simple.Forest.Gen () import Cursor.Tree import Cursor.Types--import Cursor.Simple.Forest.Gen ()+import Data.Tree+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck+import Test.Validity+import Test.Validity.Optics  spec :: Spec spec = do   eqSpec @(SFC.ForestCursor Int)   genValidSpec @(SFC.ForestCursor Bool)   modifyMaxSize (`quot` 2) $-    modifyMaxSuccess (`quot` 2) $ shrinkValidSpecWithLimit @(SFC.ForestCursor Bool) 10+    modifyMaxSuccess (`quot` 2) $+      shrinkValidSpecWithLimit @(SFC.ForestCursor Bool) 10+  describe "singletonForestCursor" $+    it "produces valid cursors" $+      producesValid (singletonForestCursor @Bool @Bool)   describe "makeForestCursor" $-    it "produces valid cursors" $ producesValidsOnValids (makeForestCursor @Bool)+    it "produces valid cursors" $+      producesValid (makeForestCursor @Bool)   describe "rebuildForestCursor" $ do-    it "produces valid forests" $ producesValidsOnValids (rebuildForestCursor @Bool)+    it "produces valid forests" $ producesValid (rebuildForestCursor @Bool)     it "is the inverse of makeForestCursor for integers" $       inverseFunctions (makeForestCursor @Int) rebuildForestCursor-  describe "forestCursorLestCursorL" $ lensSpecOnValid (forestCursorListCursorL @Bool @Bool)-  describe "forestCursorSelectedTreeL" $ lensSpecOnValid (forestCursorSelectedTreeL @Bool @Bool)+  describe "forestCursorLestCursorL" $ lensSpec (forestCursorListCursorL @Bool @Bool)+  describe "forestCursorSelectedTreeL" $ lensSpec (forestCursorSelectedTreeL @Bool @Bool)   describe "forestCursorSelection" $ do-    it "produces valid ints" $ producesValidsOnValids (forestCursorSelection @Bool @Bool)+    it "produces valid ints" $ producesValid (forestCursorSelection @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "forestCursorSelectIndex" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorSelectIndex @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorSelectIndex @Bool)     it "is the identity function when given the current selection" $-      forAllValid $ \fc ->-        forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe`-        Just (fc :: SFC.ForestCursor Bool)+      forAllValid $+        \fc ->+          forestCursorSelectIndex (forestCursorSelection fc) fc+            `shouldBe` Just (fc :: SFC.ForestCursor Bool)     it "returns selects the element at the given index" pending   movementsSpec   collapseSpec@@ -60,254 +63,335 @@ movementsSpec :: Spec movementsSpec = do   describe "forestCursorSelectPrevTreeCursor" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectPrevTreeCursor @Bool     it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor     it "selects the previous tree cursor" pending   describe "forestCursorSelectNextTreeCursor" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNextTreeCursor @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectNextTreeCursor @Bool     it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor     it "selects the next tree" pending   describe "forestCursorSelectFirstTreeCursor" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectFirstTreeCursor @Bool     it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor     it "selects the first tree" pending   describe "forestCursorSelectLastTreeCursor" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectLastTreeCursor @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectLastTreeCursor @Bool     it "is a movement" $ isMovement forestCursorSelectLastTreeCursor     it "selects the last tree" pending   describe "forestCursorSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrev @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectPrev @Bool     it "is a movement" $ isMovementM forestCursorSelectPrev     it "selects the previous node" pending-        -- TODO example with a collapsed tree+    -- TODO example with a collapsed tree     it "Works for this classic example without any collapsing" $-            --   > 1-            --     > 2 <- expected end cursor-            --   > 3 <- start cursor-     do-      let start =-            ForestCursor-              { forestCursorListCursor =-                  NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]]-                    , nonEmptyCursorCurrent =-                        TreeCursor-                          {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest}-                    , nonEmptyCursorNext = []-                    }-              }-          expected =-            ForestCursor-              { forestCursorListCursor =-                  NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =-                        TreeCursor-                          { treeAbove =-                              Just-                                TreeAbove-                                  { treeAboveAbove = Nothing-                                  , treeAboveLefts = []-                                  , treeAboveNode = 1-                                  , treeAboveRights = []-                                  }-                          , treeCurrent = 2-                          , treeBelow = emptyCForest-                          }-                    , nonEmptyCursorNext = [CNode 3 emptyCForest]-                    }-              }-      case forestCursorSelectPrev start of-        Nothing -> expectationFailure "forestCursorSelectPrev should not have failed."-        Just actual -> actual `forestShouldBe` expected+      --   > 1+      --     > 2 <- expected end cursor+      --   > 3 <- start cursor+      do+        let start =+              ForestCursor+                { forestCursorListCursor =+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove = Nothing,+                              treeCurrent = 3 :: Int,+                              treeBelow = emptyCForest+                            },+                        nonEmptyCursorNext = []+                      }+                }+            expected =+              ForestCursor+                { forestCursorListCursor =+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove =+                                Just+                                  TreeAbove+                                    { treeAboveAbove = Nothing,+                                      treeAboveLefts = [],+                                      treeAboveNode = 1,+                                      treeAboveRights = []+                                    },+                              treeCurrent = 2,+                              treeBelow = emptyCForest+                            },+                        nonEmptyCursorNext = [CNode 3 emptyCForest]+                      }+                }+        case forestCursorSelectPrev start of+          Nothing -> expectationFailure "forestCursorSelectPrev should not have failed."+          Just actual -> actual `forestShouldBe` expected   describe "forestCursorSelectNext" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNext @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectNext @Bool     it "is a movement" $ isMovementM forestCursorSelectNext     it "selects the next node" pending     it "Works for this classic example" $-            --   > 1-            --     > 2 <- start cursor-            --   > 3 <- expected end cursor-     do-      let start =-            ForestCursor-              { forestCursorListCursor =-                  NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =-                        TreeCursor-                          { treeAbove =-                              Just-                                TreeAbove-                                  { treeAboveAbove = Nothing-                                  , treeAboveLefts = []-                                  , treeAboveNode = 1-                                  , treeAboveRights = []-                                  }-                          , treeCurrent = 2-                          , treeBelow = emptyCForest-                          }-                    , nonEmptyCursorNext = [CNode 3 emptyCForest]-                    }-              }-          expected =-            ForestCursor-              { forestCursorListCursor =-                  NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]]-                    , nonEmptyCursorCurrent =-                        TreeCursor-                          {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest}-                    , nonEmptyCursorNext = []-                    }-              }-      case forestCursorSelectNext start of-        Nothing -> expectationFailure "forestCursorSelectNext should not have failed."-        Just actual -> actual `forestShouldBe` expected+      --   > 1+      --     > 2 <- start cursor+      --   > 3 <- expected end cursor+      do+        let start =+              ForestCursor+                { forestCursorListCursor =+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove =+                                Just+                                  TreeAbove+                                    { treeAboveAbove = Nothing,+                                      treeAboveLefts = [],+                                      treeAboveNode = 1,+                                      treeAboveRights = []+                                    },+                              treeCurrent = 2,+                              treeBelow = emptyCForest+                            },+                        nonEmptyCursorNext = [CNode 3 emptyCForest]+                      }+                }+            expected =+              ForestCursor+                { forestCursorListCursor =+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove = Nothing,+                              treeCurrent = 3 :: Int,+                              treeBelow = emptyCForest+                            },+                        nonEmptyCursorNext = []+                      }+                }+        case forestCursorSelectNext start of+          Nothing -> expectationFailure "forestCursorSelectNext should not have failed."+          Just actual -> actual `forestShouldBe` expected   describe "forestCursorSelectPrevOnSameLevel" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Bool+    it "produces valid cursors" $ producesValid $ 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 @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectNextOnSameLevel @Bool     it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel     it "selects the next node on the same level as the current node" pending+  describe "forestCursorSelectFirstOnSameLevel" $ do+    it "produces valid cursors" $ producesValid $ forestCursorSelectFirstOnSameLevel @Bool+    it "is a movement" $ isMovement forestCursorSelectFirstOnSameLevel+    it "selects the previous node on the same level as the current node" pending+  describe "forestCursorSelectLastOnSameLevel" $ do+    it "produces valid cursors" $ producesValid $ forestCursorSelectLastOnSameLevel @Bool+    it "is a movement" $ isMovement forestCursorSelectLastOnSameLevel+    it "selects the next node on the same level as the current node" pending   describe "forestCursorSelectFirst" $ do-    it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirst @Bool+    it "produces valid cursors" $ producesValid $ 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 @Bool+    it "produces valid cursors" $ producesValid $ 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 @Bool+    it "produces valid cursors" $ producesValid $ forestCursorSelectAbove @Bool     it "is a movement" $ isMovementM forestCursorSelectAbove     it "selects the parent" pending   describe "forestCursorSelectBelowAtPos" $ do-    it "produces valid cursors" $ producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Bool+    it "produces valid cursors" $ producesValid2 $ forestCursorSelectBelowAtPos @Bool     it "is a movement for any index" $-      forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i+      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 @Bool+    it "produces valid cursors" $ producesValid $ 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 @Bool+    it "produces valid cursors" $ producesValid $ 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 @Bool @Bool+    it "produces valid cursors" $+      producesValid $+        forestCursorOpenCurrentForest @Bool @Bool   describe "forestCursorCloseCurrentForest" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorCloseCurrentForest @Bool @Bool+      producesValid $+        forestCursorCloseCurrentForest @Bool @Bool   describe "forestCursorToggleCurrentForest" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool+      producesValid $+        forestCursorToggleCurrentForest @Bool @Bool   describe "forestCursorOpenCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool+      producesValid $+        forestCursorToggleCurrentForest @Bool @Bool   describe "forestCursorToggleCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $ forestCursorToggleCurrentForestRecursively @Bool @Bool+      producesValid $+        forestCursorToggleCurrentForestRecursively @Bool @Bool  insertSpec :: Spec insertSpec = do   describe "forestCursorInsertEntireTree" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertEntireTree @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorInsertEntireTree @Bool @Bool)     it "inserts a tree cursor before the currently selected tree cursor" pending   describe "forestCursorInsertAndSelectTreeCursor" $ do     it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Bool)+      producesValid2 (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 @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorAppendEntireTree @Bool @Bool)     it "appends a tree after the currently selected tree cursor" pending   describe "forestCursorAppendAndSelectTreeCursor" $ do     it "produces valid cursors" $-      producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Bool)+      producesValid2 (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 @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorInsertTree @Bool @Bool)     it "inserts a tree before the currently selected tree" pending   describe "forestCursorInsertAndSelectTree" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelectTree @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorInsertAndSelectTree @Bool)     it "inserts a tree before the currently selected tree and selects it" pending   describe "forestCursorAppendTree" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendTree @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorAppendTree @Bool @Bool)     it "appends a tree after the currently selected tree " pending   describe "forestCursorAppendAndSelectTree" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelectTree @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorAppendAndSelectTree @Bool)     it "appends a tree after the currently selected tree and selects it" pending   describe "forestCursorInsert" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsert @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorInsert @Bool @Bool)     it "inserts a node before the currently selected node" pending   describe "forestCursorInsertAndSelect" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelect @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorInsertAndSelect @Bool)     it "inserts a node before the currently selected node and selects it" pending+  describe "forestCursorInsertNodeSingleAndSelect" $ do+    it "produces valid cursors" $ producesValid2 (forestCursorInsertNodeSingleAndSelect @Bool)+    it "inserts a node before the currently selected node and selects it" pending+  describe "forestCursorInsertNodeAndSelect" $ do+    it "produces valid cursors" $ producesValid3 (forestCursorInsertNodeAndSelect @Bool)+    it "inserts a node before the currently selected node and selects it" pending   describe "forestCursorAppend" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppend @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorAppend @Bool @Bool)     it "appends a node after the currently selected node" pending   describe "forestCursorAppendAndSelect" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelect @Bool)+    it "produces valid cursors" $ producesValid2 (forestCursorAppendAndSelect @Bool)     it "appends a node after the currently selected node and selects it" pending+  describe "forestCursorAppendNodeSingleAndSelect" $ do+    it "produces valid cursors" $ producesValid2 (forestCursorAppendNodeSingleAndSelect @Bool)+    it "appends a node after the currently selected node and selects it" pending+  describe "forestCursorAppendNodeAndSelect" $ do+    it "produces valid cursors" $ producesValid3 (forestCursorAppendNodeAndSelect @Bool)+    it "appends a node after the currently selected node and selects it" pending   describe "forestCursorAddChildTreeToNodeAtPos" $ do     it "produces valid cursors" $-      producesValidsOnValids3 $ forestCursorAddChildTreeToNodeAtPos @Bool @Bool+      producesValid3 $+        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 @Bool @Bool+      producesValid2 $+        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 @Bool @Bool+      producesValid2 $+        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 @Bool @Bool+      producesValid3 $+        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 @Bool @Bool+      producesValid2 $+        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 @Bool @Bool+      producesValid2 $+        forestCursorAddChildToNodeAtEnd @Bool @Bool     it "adds a child to a node at the end the children of that node" pending+  describe "forestCursorAddChildTreeToNodeAtPosAndSelect" $ do+    it "produces valid cursors" $+      producesValid3 $+        forestCursorAddChildTreeToNodeAtPosAndSelect @Bool+    it "adds a child tree to a node at the given position in the children of that node" pending+  describe "forestCursorAddChildTreeToNodeAtStartAndSelect" $ do+    it "produces valid cursors" $+      producesValid2 $+        forestCursorAddChildTreeToNodeAtStartAndSelect @Bool+    it "adds a child tree to a node at the start the children of that node" pending+  describe "forestCursorAddChildTreeToNodeAtEndAndSelect" $ do+    it "produces valid cursors" $+      producesValid2 $+        forestCursorAddChildTreeToNodeAtEndAndSelect @Bool+    it "adds a child tree to a node at the end the children of that node" pending+  describe "forestCursorAddChildToNodeAtPosAndSelect" $ do+    it "produces valid cursors" $+      producesValid3 $+        forestCursorAddChildToNodeAtPosAndSelect @Bool+    it "adds a child to a node at the given position in the children of that node" pending+  describe "forestCursorAddChildToNodeAtStartAndSelect" $ do+    it "produces valid cursors" $+      producesValid2 $+        forestCursorAddChildToNodeAtStartAndSelect @Bool+    it "adds a child to a node at the start the children of that node" pending+  describe "forestCursorAddChildToNodeAtEndAndSelect" $ do+    it "produces valid cursors" $+      producesValid2 $+        forestCursorAddChildToNodeAtEndAndSelect @Bool+    it "adds a child to a node at the end the children of that node" pending+  describe "forestCursorAddChildNodeSingleToNodeAtPosAndSelect" $ it "produces valid cursors" $ producesValid3 (forestCursorAddChildNodeSingleToNodeAtPosAndSelect @Bool)+  describe "forestCursorAddChildNodeSingleToNodeAtStartAndSelect" $ it "produces valid cursors" $ producesValid2 (forestCursorAddChildNodeSingleToNodeAtStartAndSelect @Bool)+  describe "forestCursorAddChildNodeSingleToNodeAtEndAndSelect" $ it "produces valid cursors" $ producesValid2 (forestCursorAddChildNodeSingleToNodeAtEndAndSelect @Bool)+  describe "forestCursorAddChildNodeToNodeAtPosAndSelect" $ it "produces valid cursors" $ forAllValid $ producesValid3 . (forestCursorAddChildNodeToNodeAtPosAndSelect @Bool)+  describe "forestCursorAddChildNodeToNodeAtStartAndSelect" $ it "produces valid cursors" $ producesValid3 (forestCursorAddChildNodeToNodeAtStartAndSelect @Bool)+  describe "forestCursorAddChildNodeToNodeAtEndAndSelect" $ it "produces valid cursors" $ producesValid3 (forestCursorAddChildNodeToNodeAtEndAndSelect @Bool)   describe "forestCursorAddRoot" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAddRoot @Bool)+    it "produces valid cursors" $ producesValid2 (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 @Bool @Bool)+    it "produces valid cursors" $ producesValid (forestCursorSwapPrev @Bool @Bool)     it "works on the example from the docs" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 'a' emptyCForest]-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [CNode 'a' emptyCForest],+                      nonEmptyCursorCurrent =                         TreeCursor-                          {treeAbove = Nothing, treeCurrent = 'b', treeBelow = emptyCForest}-                    , nonEmptyCursorNext = []+                          { treeAbove = Nothing,+                            treeCurrent = 'b',+                            treeBelow = emptyCForest+                          },+                      nonEmptyCursorNext = []                     }               }           end =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { 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@@ -315,32 +399,38 @@             Just r -> r `forestShouldBe` end     it "swaps the current node with the previous node on the same level" pending     it "reverts forestCursorSwapNext" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (forestCursorSwapNext @Bool @Bool)         (forestCursorSwapPrev @Bool @Bool)   describe "forestCursorSwapNext" $ do-    it "produces valid cursors" $ producesValidsOnValids (forestCursorSwapNext @Bool @Bool)+    it "produces valid cursors" $ producesValid (forestCursorSwapNext @Bool @Bool)     it "works on the example from the docs" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { 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]-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [CNode 'b' emptyCForest],+                      nonEmptyCursorCurrent =                         TreeCursor-                          {treeAbove = Nothing, treeCurrent = 'a', treeBelow = emptyCForest}-                    , nonEmptyCursorNext = []+                          { treeAbove = Nothing,+                            treeCurrent = 'a',+                            treeBelow = emptyCForest+                          },+                      nonEmptyCursorNext = []                     }               }        in case forestCursorSwapNext start of@@ -348,28 +438,28 @@             Just r -> r `forestShouldBe` end     it "swaps the current node with the next node on the same level" pending     it "reverts forestCursorSwapPrev" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (forestCursorSwapPrev @Bool @Bool)         (forestCursorSwapNext @Bool @Bool)  deleteSpec :: Spec deleteSpec = do   describe "forestCursorRemoveElemAndSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Bool)+    it "produces valid cursors" $ producesValid (forestCursorRemoveElemAndSelectPrev @Bool)     it "works for this simple example" $       forAllValid $ \fs ->         let simpleDeleteElemStart =               ForestCursor                 { forestCursorListCursor =                     NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =+                      { nonEmptyCursorPrev = [],+                        nonEmptyCursorCurrent =                           TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 1 :: Int-                            , treeBelow = closedForest [Node 2 fs]-                            }-                      , nonEmptyCursorNext = []+                            { treeAbove = Nothing,+                              treeCurrent = 1 :: Int,+                              treeBelow = closedForest [Node 2 fs]+                            },+                        nonEmptyCursorNext = []                       }                 }          in case forestCursorRemoveElemAndSelectPrev simpleDeleteElemStart of@@ -382,160 +472,163 @@                   "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 @Bool)+    it "produces valid cursors" $ producesValid (forestCursorDeleteElemAndSelectNext @Bool)     it "works for this simple example" $-      forAllValid $ \fs ->-        let simpleDeleteElemStart =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 1-                            , treeBelow = closedForest [Node 2 fs]-                            }-                      , nonEmptyCursorNext = []-                      }-                }-            simpleDeleteElemExpected =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 2 :: Int-                            , treeBelow = closedForest fs-                            }-                      , nonEmptyCursorNext = []-                      }-                }-         in case forestCursorDeleteElemAndSelectNext simpleDeleteElemStart of-              Nothing ->-                expectationFailure "forestCursorDeleteElemAndSelectNext should not have failed."-              Just Deleted ->-                expectationFailure-                  "forestCursorDeleteElemAndSelectNext should not have deleted the entire example forest."-              Just (Updated f) -> f `shouldBe` simpleDeleteElemExpected+      forAllValid $+        \fs ->+          let simpleDeleteElemStart =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 1,+                                treeBelow = closedForest [Node 2 fs]+                              },+                          nonEmptyCursorNext = []+                        }+                  }+              simpleDeleteElemExpected =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 2 :: Int,+                                treeBelow = closedForest fs+                              },+                          nonEmptyCursorNext = []+                        }+                  }+           in case forestCursorDeleteElemAndSelectNext simpleDeleteElemStart of+                Nothing ->+                  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 @Bool)+    it "produces valid cursors" $ producesValid (forestCursorRemoveElem @Bool)     it "works for this simple example" $-      forAllValid $ \fs ->-        let simpleDeleteElemStart =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 1-                            , treeBelow = closedForest [Node 2 fs]-                            }-                      , nonEmptyCursorNext = []-                      }-                }-            simpleDeleteElemExpected =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 2 :: Int-                            , treeBelow = closedForest fs-                            }-                      , nonEmptyCursorNext = []-                      }-                }-         in case forestCursorRemoveElem simpleDeleteElemStart of-              Deleted ->-                expectationFailure-                  "forestCursorRemoveElem should not have deleted the entire example forest."-              Updated f -> f `shouldBe` simpleDeleteElemExpected+      forAllValid $+        \fs ->+          let simpleDeleteElemStart =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 1,+                                treeBelow = closedForest [Node 2 fs]+                              },+                          nonEmptyCursorNext = []+                        }+                  }+              simpleDeleteElemExpected =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 2 :: Int,+                                treeBelow = closedForest fs+                              },+                          nonEmptyCursorNext = []+                        }+                  }+           in case forestCursorRemoveElem simpleDeleteElemStart of+                Deleted ->+                  expectationFailure+                    "forestCursorRemoveElem should not have deleted the entire example forest."+                Updated f -> f `shouldBe` simpleDeleteElemExpected     it "removes the selected element" pending   describe "forestCursorDeleteElem" $ do-    it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteElem @Bool)+    it "produces valid cursors" $ producesValid (forestCursorDeleteElem @Bool)     it "works for this simple example" $-      forAllValid $ \fs ->-        let simpleDeleteElemStart =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 1-                            , treeBelow = closedForest [Node 2 fs]-                            }-                      , nonEmptyCursorNext = []-                      }-                }-            simpleDeleteElemExpected =-              ForestCursor-                { forestCursorListCursor =-                    NonEmptyCursor-                      { nonEmptyCursorPrev = []-                      , nonEmptyCursorCurrent =-                          TreeCursor-                            { treeAbove = Nothing-                            , treeCurrent = 2 :: Int-                            , treeBelow = closedForest fs-                            }-                      , nonEmptyCursorNext = []-                      }-                }-         in case forestCursorDeleteElem simpleDeleteElemStart of-              Deleted ->-                expectationFailure-                  "forestCursorDeleteElem should not have deleted the entire example forest."-              Updated f -> f `shouldBe` simpleDeleteElemExpected+      forAllValid $+        \fs ->+          let simpleDeleteElemStart =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 1,+                                treeBelow = closedForest [Node 2 fs]+                              },+                          nonEmptyCursorNext = []+                        }+                  }+              simpleDeleteElemExpected =+                ForestCursor+                  { forestCursorListCursor =+                      NonEmptyCursor+                        { nonEmptyCursorPrev = [],+                          nonEmptyCursorCurrent =+                            TreeCursor+                              { treeAbove = Nothing,+                                treeCurrent = 2 :: Int,+                                treeBelow = closedForest fs+                              },+                          nonEmptyCursorNext = []+                        }+                  }+           in case forestCursorDeleteElem simpleDeleteElemStart of+                Deleted ->+                  expectationFailure+                    "forestCursorDeleteElem should not have deleted the entire example forest."+                Updated f -> f `shouldBe` simpleDeleteElemExpected     it "deletes the selected element" pending   describe "forestCursorRemoveSubTreeAndSelectPrev" $ do     it "produces valid cursors" $-      producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Bool)+      producesValid (forestCursorRemoveSubTreeAndSelectPrev @Bool)     it "removes the selected subtree and selects the previous tree" pending   describe "forestCursorDeleteSubTreeAndSelectNext" $ do     it "produces valid cursors" $-      producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Bool)+      producesValid (forestCursorDeleteSubTreeAndSelectNext @Bool)     it "deletes the selected subtree and selects the next tree" pending   describe "forestCursorRemoveSubTree" $ do-    it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveSubTree @Bool)+    it "produces valid cursors" $ producesValid (forestCursorRemoveSubTree @Bool)     it "removes the selected subtree" pending   describe "forestCursorDeleteSubTree" $ do-    it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteSubTree @Bool)+    it "produces valid cursors" $ producesValid (forestCursorDeleteSubTree @Bool)     it "deletes the selected subtree" pending  shiftingSpec :: Spec shiftingSpec = do   describe "forestCursorPromoteElem" $ do-    it "produces valids on valids" $ producesValidsOnValids $ forestCursorPromoteElem @Bool+    it "produces valids on valids" $ producesValid $ forestCursorPromoteElem @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]-                                  , treeAboveAbove = Nothing-                                  , treeAboveNode = 'a'-                                  , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]-                                  }-                          , treeCurrent = 'd'-                          , treeBelow = closedForest [Node 'e' []]-                          }-                    , nonEmptyCursorNext = [CNode 'h' emptyCForest]+                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]],+                                    treeAboveAbove = Nothing,+                                    treeAboveNode = 'a',+                                    treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]+                                  },+                            treeCurrent = 'd',+                            treeBelow = closedForest [Node 'e' []]+                          },+                      nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }           expected =@@ -544,16 +637,19 @@                   NonEmptyCursor                     { nonEmptyCursorPrev =                         [ CNode 'a' $-                          openForest-                            [ CNode 'b' $-                              openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest]-                            , CNode 'f' $ closedForest [Node 'g' []]-                            ]-                        ]-                    , nonEmptyCursorCurrent =+                            openForest+                              [ CNode 'b' $+                                  openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest],+                                CNode 'f' $ closedForest [Node 'g' []]+                              ]+                        ],+                      nonEmptyCursorCurrent =                         TreeCursor-                          {treeAbove = Nothing, treeCurrent = 'd', treeBelow = emptyCForest}-                    , nonEmptyCursorNext = [CNode 'h' emptyCForest]+                          { treeAbove = Nothing,+                            treeCurrent = 'd',+                            treeBelow = emptyCForest+                          },+                      nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }        in case forestCursorPromoteElem start of@@ -561,41 +657,41 @@             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 @Bool+    it "produces valids on valids" $ producesValid $ forestCursorDemoteElem @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]]-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]],+                      nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'c'-                          , treeBelow = closedForest [Node 'd' []]-                          }-                    , nonEmptyCursorNext = [CNode 'e' emptyCForest]+                          { treeAbove = Nothing,+                            treeCurrent = 'c',+                            treeBelow = closedForest [Node 'd' []]+                          },+                      nonEmptyCursorNext = [CNode 'e' emptyCForest]                     }               }           expected =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts = [CNode 'b' emptyCForest]-                                  , treeAboveAbove = Nothing-                                  , treeAboveNode = 'a'-                                  , treeAboveRights = [CNode 'd' emptyCForest]-                                  }-                          , treeCurrent = 'c'-                          , treeBelow = emptyCForest-                          }-                    , nonEmptyCursorNext = [CNode 'e' emptyCForest]+                                  { treeAboveLefts = [CNode 'b' emptyCForest],+                                    treeAboveAbove = Nothing,+                                    treeAboveNode = 'a',+                                    treeAboveRights = [CNode 'd' emptyCForest]+                                  },+                            treeCurrent = 'c',+                            treeBelow = emptyCForest+                          },+                      nonEmptyCursorNext = [CNode 'e' emptyCForest]                     }               }        in case forestCursorDemoteElem start of@@ -603,27 +699,27 @@             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 @Bool+    it "produces valids on valids" $ producesValid $ forestCursorPromoteSubTree @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]-                                  , treeAboveAbove = Nothing-                                  , treeAboveNode = 'a'-                                  , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]-                                  }-                          , treeCurrent = 'd'-                          , treeBelow = closedForest [Node 'e' []]-                          }-                    , nonEmptyCursorNext = [CNode 'h' emptyCForest]+                                  { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]],+                                    treeAboveAbove = Nothing,+                                    treeAboveNode = 'a',+                                    treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]+                                  },+                            treeCurrent = 'd',+                            treeBelow = closedForest [Node 'e' []]+                          },+                      nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }           expected =@@ -632,18 +728,18 @@                   NonEmptyCursor                     { nonEmptyCursorPrev =                         [ CNode 'a' $-                          openForest-                            [ CNode 'b' $ closedForest [Node 'c' []]-                            , CNode 'f' $ closedForest [Node 'g' []]-                            ]-                        ]-                    , nonEmptyCursorCurrent =+                            openForest+                              [ CNode 'b' $ closedForest [Node 'c' []],+                                CNode 'f' $ closedForest [Node 'g' []]+                              ]+                        ],+                      nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'd'-                          , treeBelow = closedForest [Node 'e' []]-                          }-                    , nonEmptyCursorNext = [CNode 'h' emptyCForest]+                          { treeAbove = Nothing,+                            treeCurrent = 'd',+                            treeBelow = closedForest [Node 'e' []]+                          },+                      nonEmptyCursorNext = [CNode 'h' emptyCForest]                     }               }        in case forestCursorPromoteSubTree start of@@ -651,41 +747,41 @@             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 @Bool+    it "produces valids on valids" $ producesValid $ forestCursorDemoteSubTree @Bool     it "works on the example from the documentation" $       let start =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]]-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]],+                      nonEmptyCursorCurrent =                         TreeCursor-                          { treeAbove = Nothing-                          , treeCurrent = 'c'-                          , treeBelow = closedForest [Node 'd' []]-                          }-                    , nonEmptyCursorNext = []+                          { treeAbove = Nothing,+                            treeCurrent = 'c',+                            treeBelow = closedForest [Node 'd' []]+                          },+                      nonEmptyCursorNext = []                     }               }           expected =             ForestCursor               { forestCursorListCursor =                   NonEmptyCursor-                    { nonEmptyCursorPrev = []-                    , nonEmptyCursorCurrent =+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =                         TreeCursor                           { treeAbove =                               Just                                 TreeAbove-                                  { treeAboveLefts = [CNode 'b' emptyCForest]-                                  , treeAboveAbove = Nothing-                                  , treeAboveNode = 'a'-                                  , treeAboveRights = []-                                  }-                          , treeCurrent = 'c'-                          , treeBelow = closedForest [Node 'd' []]-                          }-                    , nonEmptyCursorNext = []+                                  { treeAboveLefts = [CNode 'b' emptyCForest],+                                    treeAboveAbove = Nothing,+                                    treeAboveNode = 'a',+                                    treeAboveRights = []+                                  },+                            treeCurrent = 'c',+                            treeBelow = closedForest [Node 'd' []]+                          },+                      nonEmptyCursorNext = []                     }               }        in case forestCursorDemoteSubTree start of@@ -694,80 +790,84 @@     it "demotes the current subtree to the level of its children" pending   describe "forestCursorDemoteElemUnder" $ do     it "produces valids on valids" $-      producesValidsOnValids3 $ forestCursorDemoteElemUnder @Bool @Bool+      producesValid3 $+        forestCursorDemoteElemUnder @Bool @Bool     it "Works on the example from the docs" $-      forAllValid $ \b1 ->-        forAllValid $ \b2 ->-          let demoteStart =-                ForestCursor $-                NonEmptyCursor-                  { nonEmptyCursorPrev = []-                  , nonEmptyCursorCurrent =-                      TreeCursor-                        { treeAbove = Nothing-                        , treeCurrent = 'a'-                        , treeBelow = closedForest [Node 'b' []]-                        }-                  , nonEmptyCursorNext = []-                  }-              demoteEnd =-                ForestCursor $-                NonEmptyCursor-                  { nonEmptyCursorPrev = []-                  , nonEmptyCursorCurrent =-                      TreeCursor-                        { treeAbove =-                            Just-                              TreeAbove-                                { treeAboveLefts = []-                                , treeAboveAbove = Nothing-                                , treeAboveNode = b1-                                , treeAboveRights = []-                                }-                        , treeCurrent = 'a'-                        , treeBelow = emptyCForest-                        }-                  , nonEmptyCursorNext = [CNode b2 $ closedForest [Node 'b' []]]-                  }-           in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe` demoteEnd+      forAllValid $+        \b1 ->+          forAllValid $ \b2 ->+            let demoteStart =+                  ForestCursor $+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove = Nothing,+                              treeCurrent = 'a',+                              treeBelow = closedForest [Node 'b' []]+                            },+                        nonEmptyCursorNext = []+                      }+                demoteEnd =+                  ForestCursor $+                    NonEmptyCursor+                      { nonEmptyCursorPrev = [],+                        nonEmptyCursorCurrent =+                          TreeCursor+                            { treeAbove =+                                Just+                                  TreeAbove+                                    { treeAboveLefts = [],+                                      treeAboveAbove = Nothing,+                                      treeAboveNode = b1,+                                      treeAboveRights = []+                                    },+                              treeCurrent = 'a',+                              treeBelow = emptyCForest+                            },+                        nonEmptyCursorNext = [CNode b2 $ closedForest [Node 'b' []]]+                      }+             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 @Bool @Bool+      producesValid2 $+        forestCursorDemoteSubTreeUnder @Bool @Bool     it "Works on the example from the docs" $-      forAllValid $ \v -> do-        let demoteStart =-              ForestCursor $-              NonEmptyCursor-                { nonEmptyCursorPrev = []-                , nonEmptyCursorCurrent =-                    TreeCursor-                      { treeAbove = Nothing-                      , treeCurrent = 'a'-                      , treeBelow = closedForest [Node 'b' []]-                      }-                , nonEmptyCursorNext = []-                }-            demoteEnd =-              ForestCursor $-              NonEmptyCursor-                { nonEmptyCursorPrev = []-                , nonEmptyCursorCurrent =-                    TreeCursor-                      { treeAbove =-                          Just-                            TreeAbove-                              { treeAboveLefts = []-                              , treeAboveAbove = Nothing-                              , treeAboveNode = v-                              , treeAboveRights = []-                              }-                      , treeCurrent = 'a'-                      , treeBelow = closedForest [Node 'b' []]-                      }-                , nonEmptyCursorNext = []-                }-        forestCursorDemoteSubTreeUnder v demoteStart `forestShouldBe` demoteEnd+      forAllValid $+        \v -> do+          let demoteStart =+                ForestCursor $+                  NonEmptyCursor+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =+                        TreeCursor+                          { treeAbove = Nothing,+                            treeCurrent = 'a',+                            treeBelow = closedForest [Node 'b' []]+                          },+                      nonEmptyCursorNext = []+                    }+              demoteEnd =+                ForestCursor $+                  NonEmptyCursor+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent =+                        TreeCursor+                          { treeAbove =+                              Just+                                TreeAbove+                                  { treeAboveLefts = [],+                                    treeAboveAbove = Nothing,+                                    treeAboveNode = v,+                                    treeAboveRights = []+                                  },+                            treeCurrent = 'a',+                            treeBelow = closedForest [Node 'b' []]+                          },+                      nonEmptyCursorNext = []+                    }+          forestCursorDemoteSubTreeUnder v demoteStart `forestShouldBe` demoteEnd     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@@ -779,13 +879,13 @@         let ne = rebuildForestCursor lec             ne' = rebuildForestCursor lec'          in unless (ne == ne') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show lec-              , "Forest before:  \n" ++ show ne-              , "Cursor after: \n" ++ show lec'-              , "Forest after:   \n" ++ show ne'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show lec,+                    "Forest before:  \n" ++ show ne,+                    "Cursor after: \n" ++ show lec',+                    "Forest after:   \n" ++ show ne'+                  ]  isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property isMovement func =@@ -795,11 +895,11 @@ forestShouldBe :: (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation forestShouldBe actual expected =   unless (actual == expected) $-  expectationFailure $-  unlines-    [ "The following should have been equal."-    , "actual:"-    , drawForestCursor actual-    , "expected:"-    , drawForestCursor expected-    ]+    expectationFailure $+      unlines+        [ "The following should have been equal.",+          "actual:",+          drawForestCursor actual,+          "expected:",+          drawForestCursor expected+        ]

@@ -4,128 +4,143 @@ {-# LANGUAGE TypeFamilies #-}  module Cursor.Simple.List.NonEmptySpec-  ( spec-  ) where+  ( spec,+  )+where +import Control.Monad+import Cursor.Simple.List.NonEmpty+import Cursor.Simple.List.NonEmpty.Gen import Test.Hspec import Test.QuickCheck import Test.Validity import Test.Validity.Optics -import Control.Monad--import Cursor.Simple.List.NonEmpty-import Cursor.Simple.List.NonEmpty.Gen- spec :: Spec spec = do   eqSpec @(NonEmptyCursor Bool)   genValidSpec @(NonEmptyCursor Bool)   describe "makeNonEmptyCursor" $-    it "produces valid cursors" $ producesValidsOnValids (makeNonEmptyCursor @Bool)+    it "produces valid cursors" $+      producesValid (makeNonEmptyCursor @Bool)   describe "makeNonEmptyCursorWithSelection" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Bool)+    it "produces valid cursors" $ producesValid2 (makeNonEmptyCursorWithSelection @Bool)     it "is the inverse of rebuildNonEmptyCursor when using the current selection" $-      forAllValid $ \lec ->-        makeNonEmptyCursorWithSelection-          (nonEmptyCursorSelection @Bool lec)-          (rebuildNonEmptyCursor lec) `shouldBe`-        Just lec+      forAllValid $+        \lec ->+          makeNonEmptyCursorWithSelection+            (nonEmptyCursorSelection @Bool lec)+            (rebuildNonEmptyCursor lec)+            `shouldBe` Just lec   describe "singletonNonEmptyCursor" $-    it "produces valid cursors" $ producesValidsOnValids (singletonNonEmptyCursor @Bool @Bool)+    it "produces valid cursors" $+      producesValid (singletonNonEmptyCursor @Bool @Bool)   describe "rebuildNonEmptyCursor" $ do-    it "produces valid nonempty lists" $ producesValidsOnValids (rebuildNonEmptyCursor @Bool)+    it "produces valid nonempty lists" $ producesValid (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" $-      forAll genUnchecked $ \i ->-        inverseFunctionsIfFirstSucceedsOnValid+      forAllValid $ \i ->+        inverseFunctionsIfFirstSucceeds           (makeNonEmptyCursorWithSelection @Int i)           rebuildNonEmptyCursor-  describe "nonEmptyCursorElemL" $ lensSpecOnValid (nonEmptyCursorElemL @Bool @Bool)+  describe "nonEmptyCursorElemL" $ lensSpec (nonEmptyCursorElemL @Bool @Bool)   describe "nonEmptyCursorSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectPrev @Bool)+    it "produces valid cursors" $ producesValid (nonEmptyCursorSelectPrev @Bool)     it "is a movement" $ isMovementM nonEmptyCursorSelectPrev     it "selects the previous element" pending   describe "nonEmptyCursorSelectNext" $ do-    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectNext @Bool)+    it "produces valid cursors" $ producesValid (nonEmptyCursorSelectNext @Bool)     it "is a movement" $ isMovementM nonEmptyCursorSelectNext     it "selects the next element" pending   describe "nonEmptyCursorSelectFirst" $ do-    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectFirst @Bool)+    it "produces valid cursors" $ producesValid (nonEmptyCursorSelectFirst @Bool)     it "is a movement" $ isMovement nonEmptyCursorSelectFirst-    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Bool)+    it "is idempotent" $ idempotent (nonEmptyCursorSelectFirst @Bool)     it "selects the first element" pending   describe "nonEmptyCursorSelectLast" $ do-    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectLast @Bool)+    it "produces valid cursors" $ producesValid (nonEmptyCursorSelectLast @Bool)     it "is a movement" $ isMovement nonEmptyCursorSelectLast-    it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Bool)+    it "is idempotent" $ idempotent (nonEmptyCursorSelectLast @Bool)     it "selects the last element" pending   describe "nonEmptyCursorSelection" $ do-    it "produces valid ints" $ producesValidsOnValids (nonEmptyCursorSelection @Bool @Bool)+    it "produces valid ints" $ producesValid (nonEmptyCursorSelection @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "nonEmptyCursorSelectIndex" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (nonEmptyCursorSelectIndex @Bool)+    it "produces valid cursors" $ producesValid2 (nonEmptyCursorSelectIndex @Bool)     it "is the identity function when given the current selection" $       forAllValid $ \nec ->-        nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe`-        Just (nec :: NonEmptyCursor Bool)+        nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec+          `shouldBe` 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 @Bool @Bool d)+      forAllValid $+        \d -> producesValid (nonEmptyCursorInsert @Bool @Bool d)     it "inserts a character before the cursor" pending   describe "nonEmptyCursorAppend" $ do     it "produces valid cursors" $-      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppend @Bool @Bool d)+      forAllValid $+        \d -> producesValid (nonEmptyCursorAppend @Bool @Bool d)     it "inserts a character after the cursor" pending   describe "nonEmptyCursorInsertAndSelect" $ do     it "produces valid cursors" $-      forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAndSelect @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool d)+      forAllValid $+        \d -> producesValid (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 @Bool)+    it "produces valid cursors" $ producesValid (nonEmptyCursorRemoveElem @Bool)     it "removes an element" pending   describe "nonEmptyCursorDeleteElem" $-    it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorDeleteElem @Bool)+    it "produces valid cursors" $+      producesValid (nonEmptyCursorDeleteElem @Bool)   describe "nonEmptyCursorSearch" $ do     it "produces valid cursors when looking for an equal element" $-      forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Bool))+      forAllValid $+        \a -> producesValid $ 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 :: Bool)) nec of-            Nothing -> pure ()-            Just e -> nonEmptyCursorCurrent e `shouldBe` a+      forAllValid $+        \a ->+          forAllValid $ \nec ->+            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 :: Bool)) nec of-            Nothing -> expectationFailure "Should not have failed to find the element."-            Just e -> nonEmptyCursorCurrent e `shouldBe` a+      forAllValid $+        \a ->+          forAll (nonEmptyWith a genValid) $ \nec ->+            case nonEmptyCursorSearch (== (a :: Bool)) nec of+              Nothing -> expectationFailure "Should not have failed to find the element."+              Just e -> nonEmptyCursorCurrent e `shouldBe` a   describe "nonEmptyCursorSelectOrAdd" $     it "produces valid cursors when looking for an equal element" $-    forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSelectOrAdd (== a) (a :: Bool)+      forAllValid $+        \a -> producesValid $ nonEmptyCursorSelectOrAdd (== a) (a :: Bool)  isMovementM :: (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property isMovementM func =@@ -136,13 +151,13 @@         let ne = rebuildNonEmptyCursor lec             ne' = rebuildNonEmptyCursor lec'          in unless (ne == ne') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show lec-              , "List before:  \n" ++ show ne-              , "Cursor after: \n" ++ show lec'-              , "List after:   \n" ++ show ne'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show lec,+                    "List before:  \n" ++ show ne,+                    "Cursor after: \n" ++ show lec',+                    "List after:   \n" ++ show ne'+                  ]  isMovement :: (forall a. NonEmptyCursor a -> NonEmptyCursor a) -> Property isMovement func =

@@ -4,41 +4,42 @@ {-# LANGUAGE TypeFamilies #-}  module Cursor.Simple.Map.KeyValueSpec-  ( spec-  ) where+  ( spec,+  )+where +import Cursor.Simple.Map.KeyValue+import Cursor.Simple.Map.KeyValue.Gen () import Test.Hspec import Test.QuickCheck import Test.Validity -import Cursor.Simple.Map.KeyValue-import Cursor.Simple.Map.KeyValue.Gen ()- spec :: Spec spec = do   describe "makeKeyValueCursorKey" $     it "produces valid cursors" $-    producesValidsOnValids2 (makeKeyValueCursorKey @Bool @Bool @Bool @Bool)+      producesValid2 (makeKeyValueCursorKey @Bool @Bool @Bool @Bool)   describe "makeKeyValueCursorValue" $     it "produces valid cursors" $-    producesValidsOnValids2 (makeKeyValueCursorValue @Bool @Bool @Bool @Bool)+      producesValid2 (makeKeyValueCursorValue @Bool @Bool @Bool @Bool)   describe "rebuildKeyValueCursor" $-    it "produces valid tuples" $ producesValidsOnValids (rebuildKeyValueCursor @Bool @Bool)+    it "produces valid tuples" $+      producesValid (rebuildKeyValueCursor @Bool @Bool)   describe "keyValueCursorSelection" $     it "produces valid selections" $-    producesValidsOnValids (keyValueCursorSelection @Bool @Bool @Bool @Bool)+      producesValid (keyValueCursorSelection @Bool @Bool @Bool @Bool)   describe "keyValueCursorSelectKey" $ do-    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectKey @Bool @Bool)+    it "produces valid cursors" $ producesValid (keyValueCursorSelectKey @Bool @Bool)     it "is a movement" $ isMovement keyValueCursorSelectKey   describe "keyValueCursorSelectValue" $ do-    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectValue @Bool @Bool)+    it "produces valid cursors" $ producesValid (keyValueCursorSelectValue @Bool @Bool)     it "is a movement" $ isMovement keyValueCursorSelectValue   describe "keyValueCursorToggleSelected" $ do-    it "produces valid cursors" $ producesValidsOnValids (keyValueCursorToggleSelected @Bool @Bool)+    it "produces valid cursors" $ producesValid (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 Bool Bool) `shouldBe`-    rebuildKeyValueCursor (func lec)+    rebuildKeyValueCursor (lec :: KeyValueCursor Bool Bool)+      `shouldBe` rebuildKeyValueCursor (func lec)

@@ -1,115 +1,124 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.MapSpec-  ( spec-  ) where+  ( spec,+  )+where +import Control.Monad+import Cursor.Simple.Map+import Cursor.Simple.Map.Gen ()+import Lens.Micro import Test.Hspec import Test.QuickCheck import Test.Validity import Test.Validity.Optics -import Lens.Micro--import Control.Monad--import Cursor.Simple.Map-import Cursor.Simple.Map.Gen ()- spec :: Spec spec = do   describe "makeMapCursor" $-    it "produces valid cursors" $ producesValidsOnValids (makeMapCursor @Bool @Bool)+    it "produces valid cursors" $+      producesValid (makeMapCursor @Bool @Bool)   describe "makeMapCursorWithSelection" $-    it "produces valid cursors" $ producesValidsOnValids2 (makeMapCursorWithSelection @Bool @Bool)+    it "produces valid cursors" $+      producesValid2 (makeMapCursorWithSelection @Bool @Bool)   describe "singletonMapCursorKey" $     it "produces valid cursors" $-    producesValidsOnValids2 (singletonMapCursorKey @Bool @Bool @Bool @Bool)+      producesValid2 (singletonMapCursorKey @Bool @Bool @Bool @Bool)   describe "singletonMapCursorValue" $     it "produces valid cursors" $-    producesValidsOnValids2 (singletonMapCursorValue @Bool @Bool @Bool @Bool)+      producesValid2 (singletonMapCursorValue @Bool @Bool @Bool @Bool)   describe "rebuildMapCursor" $ do-    it "produces valid Nonempty lists" $ producesValidsOnValids (rebuildMapCursor @Bool @Bool)+    it "produces valid Nonempty lists" $ producesValid (rebuildMapCursor @Bool @Bool)     it "is the inverse of makeMapCursor for integers" $       inverseFunctions (makeMapCursor @Bool @Bool) rebuildMapCursor   describe "mapCursorNonEmptyCursorL" $-    lensSpecOnValid (mapCursorNonEmptyCursorL @Bool @Bool @Bool @Bool)-  describe "mapCursorElemL" $ lensSpecOnValid (mapCursorElemL @Bool @Bool @Bool @Bool)+    lensSpec (mapCursorNonEmptyCursorL @Bool @Bool @Bool @Bool)+  describe "mapCursorElemL" $ lensSpec (mapCursorElemL @Bool @Bool @Bool @Bool)   describe "mapCursorSelectKey" $-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectKey @Bool @Bool)+    it "produces valid cursors" $+      producesValid (mapCursorSelectKey @Bool @Bool)   describe "mapCursorSelectValue" $-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectValue @Bool @Bool)+    it "produces valid cursors" $+      producesValid (mapCursorSelectValue @Bool @Bool)   describe "mapCursorToggleSelected" $-    it "produces valid cursors" $ producesValidsOnValids (mapCursorToggleSelected @Bool @Bool)+    it "produces valid cursors" $+      producesValid (mapCursorToggleSelected @Bool @Bool)   describe "mapCursorSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectPrev @Bool @Bool)+    it "produces valid cursors" $ producesValid (mapCursorSelectPrev @Bool @Bool)     it "is a movement" $ isMovementM mapCursorSelectPrev     it "selects the previous element" pending   describe "mapCursorSelectNext" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectNext @Bool @Bool)+    it "produces valid cursors" $ producesValid (mapCursorSelectNext @Bool @Bool)     it "is a movement" $ isMovementM mapCursorSelectNext     it "selects the next element" pending   describe "mapCursorSelectFirst" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectFirst @Bool @Bool)+    it "produces valid cursors" $ producesValid (mapCursorSelectFirst @Bool @Bool)     it "is a movement" $ isMovement mapCursorSelectFirst-    it "is idempotent" $ idempotentOnValid (mapCursorSelectFirst @Bool @Bool)+    it "is idempotent" $ idempotent (mapCursorSelectFirst @Bool @Bool)     it "selects the first element" pending   describe "mapCursorSelectLast" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectLast @Bool @Bool)+    it "produces valid cursors" $ producesValid (mapCursorSelectLast @Bool @Bool)     it "is a movement" $ isMovement mapCursorSelectLast-    it "is idempotent" $ idempotentOnValid (mapCursorSelectLast @Bool @Bool)+    it "is idempotent" $ idempotent (mapCursorSelectLast @Bool @Bool)     it "selects the last element" pending   describe "mapCursorSelection" $ do-    it "produces valid ints" $ producesValidsOnValids (mapCursorSelection @Bool @Bool @Bool @Bool)+    it "produces valid ints" $ producesValid (mapCursorSelection @Bool @Bool @Bool @Bool)     it "returns the index of the currently selected element" pending   describe "mapCursorSelectIndex" $ do-    it "produces valid cursors" $ producesValidsOnValids2 (mapCursorSelectIndex @Bool @Bool)+    it "produces valid cursors" $ producesValid2 (mapCursorSelectIndex @Bool @Bool)     it "is the identity function when given the current selection" $-      forAllValid $ \nec ->-        mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe`-        Just (nec :: MapCursor Bool Bool)+      forAllValid $+        \nec ->+          mapCursorSelectIndex (mapCursorSelection nec) nec+            `shouldBe` Just (nec :: MapCursor Bool Bool)     it "returns selects the element at the given index" pending   describe "mapCursorInsert" $ do-    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsert @Bool @Bool @Bool @Bool)+    it "produces valid cursors" $ producesValid3 (mapCursorInsert @Bool @Bool @Bool @Bool)     it "inserts a character before the cursor" pending   describe "mapCursorAppend" $ do-    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppend @Bool @Bool @Bool @Bool)+    it "produces valid cursors" $ producesValid3 (mapCursorAppend @Bool @Bool @Bool @Bool)     it "inserts a character after the cursor" pending   describe "mapCursorInsertAndSelectKey" $-    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsertAndSelectKey @Bool @Bool)+    it "produces valid cursors" $+      producesValid3 (mapCursorInsertAndSelectKey @Bool @Bool)   describe "mapCursorAppendAndSelectKey" $-    it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppendAndSelectKey @Bool @Bool)+    it "produces valid cursors" $+      producesValid3 (mapCursorAppendAndSelectKey @Bool @Bool)   describe "mapCursorInsertAndSelectValue" $     it "produces valid cursors" $-    producesValidsOnValids3 (mapCursorInsertAndSelectValue @Bool @Bool)+      producesValid3 (mapCursorInsertAndSelectValue @Bool @Bool)   describe "mapCursorAppendAndSelectValue" $     it "produces valid cursors" $-    producesValidsOnValids3 (mapCursorAppendAndSelectValue @Bool @Bool)+      producesValid3 (mapCursorAppendAndSelectValue @Bool @Bool)   describe "mapCursorRemoveElem" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorRemoveElem @Bool @Bool)+    it "produces valid cursors" $ producesValid (mapCursorRemoveElem @Bool @Bool)     it "removes an element" pending   describe "mapCursorDeleteElem" $ do-    it "produces valid cursors" $ producesValidsOnValids (mapCursorDeleteElem @Bool @Bool)+    it "produces valid cursors" $ producesValid (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 @Bool @Bool (\k_ v_ -> k_ == k && v_ == v)+      forAllValid $+        \(k, v) ->+          producesValid $ 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 :: Bool, v :: Bool)+      forAllValid $+        \(k, v) ->+          forAllValid $ \nec ->+            case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of+              Nothing -> pure ()+              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 :: Bool) (v :: Bool))+      forAllValid $+        \(k, v) ->+          producesValid $+            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 =@@ -120,13 +129,13 @@         let ne = rebuildMapCursor lec             ne' = rebuildMapCursor lec'          in unless (ne == ne') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show lec-              , "Map before:  \n" ++ show ne-              , "Cursor after: \n" ++ show lec'-              , "Map after:   \n" ++ show ne'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show lec,+                    "Map before:  \n" ++ show ne,+                    "Cursor after: \n" ++ show lec',+                    "Map after:   \n" ++ show ne'+                  ]  isMovement :: (forall k v. MapCursor k v -> MapCursor k v) -> Property isMovement func =

@@ -1,39 +1,44 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Simple.Tree.BaseSpec-  ( spec-  ) where--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import qualified Cursor.Simple.Tree as STC (TreeCursor) import Cursor.Simple.Tree.Gen ()- import Cursor.Simple.Tree.TestUtils+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   eqSpec @(STC.TreeCursor Int)   genValidSpec @(STC.TreeCursor Bool)   describe "makeTreeCursor" $-    it "produces valid cursors" $ producesValidsOnValids (makeTreeCursor @Bool)+    it "produces valid cursors" $+      producesValid (makeTreeCursor @Bool)+  describe "makeNodeTreeCursor" $+    it "produces valid cursors" $+      producesValid2 (makeNodeTreeCursor @Bool @Bool)   describe "makeTreeCursorWithSelection" $-    it "produces valid cursors" $ producesValidsOnValids2 (makeTreeCursorWithSelection @Bool)+    it "produces valid cursors" $+      producesValid2 (makeTreeCursorWithSelection @Bool)   describe "singletonTreeCursor" $-    it "produces valid cursors" $ producesValidsOnValids (singletonTreeCursor @Bool)+    it "produces valid cursors" $+      producesValid (singletonTreeCursor @Bool)   describe "rebuildTreeCursor" $ do-    it "produces valid trees" $ producesValidsOnValids (rebuildTreeCursor @Bool)+    it "produces valid trees" $ producesValid (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 @Bool (treeCursorSelection tc) (rebuildTreeCursor tc) of-          Nothing -> expectationFailure "makeTreeCursorWithSelection should not have failed."-          Just r -> r `treeShouldBe` tc+      forAllValid $+        \tc ->+          case makeTreeCursorWithSelection @Bool (treeCursorSelection tc) (rebuildTreeCursor tc) of+            Nothing -> expectationFailure "makeTreeCursorWithSelection should not have failed."+            Just r -> r `treeShouldBe` tc

@@ -1,30 +1,37 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.CollapseSpec-  ( spec-  ) where--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   describe "treeCursorOpenCurrentForest" $-    it "produces valid cursors" $ producesValidsOnValids $ treeCursorOpenCurrentForest @Bool @Bool+    it "produces valid cursors" $+      producesValid $+        treeCursorOpenCurrentForest @Bool @Bool   describe "treeCursorCloseCurrentForest" $-    it "produces valid cursors" $ producesValidsOnValids $ treeCursorCloseCurrentForest @Bool @Bool+    it "produces valid cursors" $+      producesValid $+        treeCursorCloseCurrentForest @Bool @Bool   describe "treeCursorToggleCurrentForest" $-    it "produces valid cursors" $ producesValidsOnValids $ treeCursorToggleCurrentForest @Bool @Bool+    it "produces valid cursors" $+      producesValid $+        treeCursorToggleCurrentForest @Bool @Bool   describe "treeCursorOpenCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $ treeCursorOpenCurrentForestRecursively @Bool @Bool+      producesValid $+        treeCursorOpenCurrentForestRecursively @Bool @Bool   describe "treeCursorToggleCurrentForestRecursively" $     it "produces valid cursors" $-    producesValidsOnValids $ treeCursorToggleCurrentForestRecursively @Bool @Bool+      producesValid $+        treeCursorToggleCurrentForestRecursively @Bool @Bool

@@ -1,87 +1,98 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.DeleteSpec-  ( spec-  ) where--import Data.Tree--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree (CTree(..), TreeCursor(..), closedForest, openForest)-import Cursor.Types- import Cursor.Simple.Tree.TestUtils+import Cursor.Tree (TreeCursor (..), closedForest, openForest)+import Cursor.Types+import Data.Tree+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectPrevious @Bool+      producesValid $+        treeCursorDeleteSubTreeAndSelectPrevious @Bool     it "deletes the current subtree selects the previous subtree" pending   describe "treeCursorDeleteSubTreeAndSelectNext" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Bool+      producesValid $+        treeCursorDeleteSubTreeAndSelectNext @Bool     it "deletes the current subtree selects the next subtree" pending   describe "treeCursorDeleteSubTreeAndSelectAbove" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Bool+      producesValid $+        treeCursorDeleteSubTreeAndSelectAbove @Bool     it "deletes the current subtree selects the above node" pending   describe "treeCursorRemoveSubTree" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorRemoveSubTree @Bool+    it "produces valids on valids" $ producesValid $ treeCursorRemoveSubTree @Bool     it "removes the current subtree" pending   describe "treeCursorDeleteSubTree" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteSubTree @Bool+    it "produces valids on valids" $ producesValid $ treeCursorDeleteSubTree @Bool     it "deletes the current subtree" pending   describe "treeCursorDeleteElemAndSelectPrevious" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Bool+      producesValid $+        treeCursorDeleteElemAndSelectPrevious @Bool     it "works for this simple example" $-      forAllValid $ \fs ->-        let simpleDeleteElemStart =-              TreeCursor-                {treeAbove = Nothing, treeCurrent = 1 :: Int, treeBelow = closedForest [Node 2 fs]}-         in case treeCursorDeleteElemAndSelectPrevious simpleDeleteElemStart of-              Nothing -> pure ()-              Just Deleted ->-                expectationFailure-                  "treeCursorDeleteElemAndSelectPrevious should not have deleted the entire example tree."-              Just (Updated _) ->-                expectationFailure-                  "treeCursorDeleteElemAndSelectPrevious should not have updated the example tree, but failed instead."+      forAllValid $+        \fs ->+          let simpleDeleteElemStart =+                TreeCursor+                  { treeAbove = Nothing,+                    treeCurrent = 1 :: Int,+                    treeBelow = closedForest [Node 2 fs]+                  }+           in case treeCursorDeleteElemAndSelectPrevious simpleDeleteElemStart of+                Nothing -> pure ()+                Just Deleted ->+                  expectationFailure+                    "treeCursorDeleteElemAndSelectPrevious should not have deleted the entire example tree."+                Just (Updated _) ->+                  expectationFailure+                    "treeCursorDeleteElemAndSelectPrevious should not have updated the example tree, but failed instead."     it "deletes the current element and selects the previous element" pending   describe "treeCursorDeleteElemAndSelectNext" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Bool+      producesValid $+        treeCursorDeleteElemAndSelectNext @Bool     it "works for this simple example" $-      forAllValid $ \fs ->-        let simpleDeleteElemStart =-              TreeCursor {treeAbove = Nothing, treeCurrent = 1, treeBelow = openForest [CNode 2 fs]}-            simpleDeleteElemExpected =-              TreeCursor {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs}-         in case treeCursorDeleteElemAndSelectNext simpleDeleteElemStart of-              Nothing ->-                expectationFailure "treeCursorDeleteElemAndSelectNext should not have failed."-              Just Deleted ->-                expectationFailure-                  "treeCursorDeleteElemAndSelectNext should not have deleted the entire example tree."-              Just (Updated f) -> f `treeShouldBe` simpleDeleteElemExpected+      forAllValid $+        \fs ->+          let simpleDeleteElemStart =+                TreeCursor {treeAbove = Nothing, treeCurrent = 1, treeBelow = openForest [CNode 2 fs]}+              simpleDeleteElemExpected =+                TreeCursor {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs}+           in case treeCursorDeleteElemAndSelectNext simpleDeleteElemStart of+                Nothing ->+                  expectationFailure "treeCursorDeleteElemAndSelectNext should not have failed."+                Just Deleted ->+                  expectationFailure+                    "treeCursorDeleteElemAndSelectNext should not have deleted the entire example tree."+                Just (Updated f) -> f `treeShouldBe` simpleDeleteElemExpected     it "deletes the current element and selects the next element" pending   describe "treeCursorDeleteElemAndSelectAbove" $ do     it "produces valids on valids" $-      producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Bool+      producesValid $+        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 ->@@ -92,8 +103,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 @Bool+    it "produces valids on valids" $ producesValid $ treeCursorRemoveElem @Bool     it "removes the current element" pending   describe "treeCursorDeleteElem" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteElem @Bool+    it "produces valids on valids" $ producesValid $ treeCursorDeleteElem @Bool     it "deletes the current element" pending

@@ -1,169 +1,172 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.DemoteSpec-  ( spec-  ) where--import Data.Tree--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree (TreeAbove(..), TreeCursor(..), closedForest, emptyCForest)- import Cursor.Simple.Tree.TestUtils+import Cursor.Tree (TreeCursor (..), closedForest, emptyCForest)+import Data.Tree+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   functorSpec @DemoteResult   describe "treeCursorDemoteElem" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorDemoteElem @Bool+    it "produces valids on valids" $ producesValid $ treeCursorDemoteElem @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'a' [node 'b' []]]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [node 'e' []]-                      }-              , treeCurrent = 'c'-              , treeBelow = closedForest [Node 'd' []]+                      { treeAboveLefts = [node 'a' [node 'b' []]],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [node 'e' []]+                      },+                treeCurrent = 'c',+                treeBelow = closedForest [Node 'd' []]               }           promoteEnd =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'b' []]-                      , treeAboveAbove =+                      { treeAboveLefts = [node 'b' []],+                        treeAboveAbove =                           Just                             TreeAbove-                              { treeAboveLefts = []-                              , treeAboveAbove = Nothing-                              , treeAboveNode = 'p'-                              , treeAboveRights = [node 'e' []]-                              }-                      , treeAboveNode = 'a'-                      , treeAboveRights = [node 'd' []]-                      }-              , treeCurrent = 'c'-              , treeBelow = emptyCForest+                              { treeAboveLefts = [],+                                treeAboveAbove = Nothing,+                                treeAboveNode = 'p',+                                treeAboveRights = [node 'e' []]+                              },+                        treeAboveNode = 'a',+                        treeAboveRights = [node 'd' []]+                      },+                treeCurrent = 'c',+                treeBelow = emptyCForest               }        in case treeCursorDemoteElem promoteStart of             Demoted tc' -> tc' `treeShouldBe` promoteEnd             _ -> 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 @Bool+    it "produces valids on valids" $ producesValid $ treeCursorDemoteSubTree @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'a' [node 'b' []]]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [node 'e' []]-                      }-              , treeCurrent = 'c'-              , treeBelow = closedForest [Node 'd' []]+                      { treeAboveLefts = [node 'a' [node 'b' []]],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [node 'e' []]+                      },+                treeCurrent = 'c',+                treeBelow = closedForest [Node 'd' []]               }           promoteEnd =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'b' []]-                      , treeAboveAbove =+                      { treeAboveLefts = [node 'b' []],+                        treeAboveAbove =                           Just                             TreeAbove-                              { treeAboveLefts = []-                              , treeAboveAbove = Nothing-                              , treeAboveNode = 'p'-                              , treeAboveRights = [node 'e' []]-                              }-                      , treeAboveNode = 'a'-                      , treeAboveRights = []-                      }-              , treeCurrent = 'c'-              , treeBelow = closedForest [Node 'd' []]+                              { treeAboveLefts = [],+                                treeAboveAbove = Nothing,+                                treeAboveNode = 'p',+                                treeAboveRights = [node 'e' []]+                              },+                        treeAboveNode = 'a',+                        treeAboveRights = []+                      },+                treeCurrent = 'c',+                treeBelow = closedForest [Node 'd' []]               }        in case treeCursorDemoteSubTree promoteStart of             Demoted tc' -> tc' `treeShouldBe` promoteEnd             _ -> 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 @Bool @Bool+    it "produces valids on valids" $ producesValid3 $ treeCursorDemoteElemUnder @Bool @Bool     it "Works on the example from the docs" $-      forAllValid $ \b1 ->-        forAllValid $ \b2 ->+      forAllValid $+        \b1 ->+          forAllValid $ \b2 ->+            let demoteStart =+                  TreeCursor+                    { treeAbove =+                        Just+                          TreeAbove+                            { treeAboveLefts = [],+                              treeAboveAbove = Nothing,+                              treeAboveNode = 'p',+                              treeAboveRights = []+                            },+                      treeCurrent = 'a',+                      treeBelow = closedForest [Node 'b' []]+                    }+                demoteEnd =+                  TreeCursor+                    { treeAbove =+                        Just+                          TreeAbove+                            { treeAboveLefts = [],+                              treeAboveAbove =+                                Just+                                  TreeAbove+                                    { treeAboveLefts = [],+                                      treeAboveAbove = Nothing,+                                      treeAboveNode = 'p',+                                      treeAboveRights = [node b2 [node 'b' []]]+                                    },+                              treeAboveNode = b1,+                              treeAboveRights = []+                            },+                      treeCurrent = 'a',+                      treeBelow = emptyCForest+                    }+             in case treeCursorDemoteElemUnder b1 b2 demoteStart of+                  Just tc' -> tc' `treeShouldBe` demoteEnd+                  _ -> 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" $+      producesValid2 $+        treeCursorDemoteSubTreeUnder @Bool @Bool+    it "Works on the example from the docs" $+      forAllValid $+        \v -> do           let demoteStart =                 TreeCursor-                  { treeAbove =-                      Just-                        TreeAbove-                          { treeAboveLefts = []-                          , treeAboveAbove = Nothing-                          , treeAboveNode = 'p'-                          , treeAboveRights = []-                          }-                  , treeCurrent = 'a'-                  , treeBelow = closedForest [Node 'b' []]+                  { treeAbove = Nothing,+                    treeCurrent = 'a',+                    treeBelow = closedForest [Node 'b' []]                   }               demoteEnd =                 TreeCursor                   { treeAbove =                       Just                         TreeAbove-                          { treeAboveLefts = []-                          , treeAboveAbove =-                              Just-                                TreeAbove-                                  { treeAboveLefts = []-                                  , treeAboveAbove = Nothing-                                  , treeAboveNode = 'p'-                                  , treeAboveRights = [node b2 [node 'b' []]]-                                  }-                          , treeAboveNode = b1-                          , treeAboveRights = []-                          }-                  , treeCurrent = 'a'-                  , treeBelow = emptyCForest+                          { treeAboveLefts = [],+                            treeAboveAbove = Nothing,+                            treeAboveNode = v,+                            treeAboveRights = []+                          },+                    treeCurrent = 'a',+                    treeBelow = closedForest [Node 'b' []]                   }-           in case treeCursorDemoteElemUnder b1 b2 demoteStart of-                Just tc' -> tc' `treeShouldBe` demoteEnd-                _ -> 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 @Bool @Bool-    it "Works on the example from the docs" $-      forAllValid $ \v -> do-        let demoteStart =-              TreeCursor-                {treeAbove = Nothing, treeCurrent = 'a', treeBelow = closedForest [Node 'b' []]}-            demoteEnd =-              TreeCursor-                { treeAbove =-                    Just-                      TreeAbove-                        { treeAboveLefts = []-                        , treeAboveAbove = Nothing-                        , treeAboveNode = v-                        , treeAboveRights = []-                        }-                , treeCurrent = 'a'-                , treeBelow = closedForest [Node 'b' []]-                }-        treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe` demoteEnd+          treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe` demoteEnd     it "demotes the current subtree to the level of its children, by adding a root" pending

@@ -1,39 +1,138 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.InsertSpec-  ( spec-  ) where--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()+import Cursor.Tree.Types+import Data.Tree+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   describe "treeCursorInsert" $ do-    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsert @Bool @Bool+    it "produces valids on valids" $ producesValid2 $ treeCursorInsert @Bool @Bool     it "inserts the element" pending   describe "treeCursorInsertAndSelect" $ do-    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsertAndSelect @Bool+    it "produces valids on valids" $ producesValid2 $ treeCursorInsertAndSelect @Bool     it "inserts and select the element" pending+  describe "treeCursorInsertNodeSingleAndSelect" $ do+    it "produces valids on valids" $ producesValid2 $ treeCursorInsertNodeSingleAndSelect @Bool+    it "inserts and select the element" pending+  describe "treeCursorInsertNodeAndSelect" $ do+    it "produces valids on valids" $ producesValid3 $ treeCursorInsertNodeAndSelect @Bool+    it "inserts and select the element" pending   describe "treeCursorAppend" $ do-    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppend @Bool @Bool+    it "produces valids on valids" $ producesValid2 $ treeCursorAppend @Bool @Bool     it "appends the element" pending   describe "treeCursorAppendAndSelect" $ do-    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppendAndSelect @Bool+    it "produces valids on valids" $ producesValid2 $ treeCursorAppendAndSelect @Bool     it "appends and select the element" pending+  describe "treeCursorAppendNodeSingleAndSelect" $ do+    it "produces valids on valids" $ producesValid2 $ treeCursorAppendNodeSingleAndSelect @Bool+    it "appends and select the element" pending+  describe "treeCursorAppendNodeAndSelect" $ do+    it "produces valids on valids" $ producesValid3 $ treeCursorAppendNodeAndSelect @Bool+    it "appends and select the element" pending   describe "treeCursorAddChildAtPos" $ do-    it "produces valid cursors " $ producesValidsOnValids3 $ treeCursorAddChildAtPos @Bool @Bool+    it "produces valid cursors " $ producesValid3 $ 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 @Bool @Bool+    it "produces valid cursors " $ producesValid2 $ 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 @Bool @Bool+    it "produces valid cursors " $ producesValid2 $ treeCursorAddChildAtEnd @Bool @Bool     it "adds a tree at the end of the children of the current node" pending+  describe "treeCursorAddChildAtPosAndSelect" $ do+    it "produces valid cursors " $ producesValid3 $ treeCursorAddChildAtPosAndSelect @Bool+    it "adds a tree at the given index in theAndSelect children of the current node" pending+  describe "treeCursorAddChildAtStartAndSelect" $ do+    it "producesAndSelect valid cursors " $ producesValid2 $ treeCursorAddChildAtStartAndSelect @Bool+    it "adds a tree at the start of the children of the current node" pending+  describe "treeCursorAddChildAtEndAndSelect" $ do+    it "produces valid cursors " $ producesValid2 $ treeCursorAddChildAtEndAndSelect @Bool+    it "adds a tree at the end of the children of the current node" pending+  describe "treeCursorAddChildNodeSingleAtPosAndSelect" $ it "produces valid cursors" $ producesValid3 (treeCursorAddChildNodeSingleAtPosAndSelect @Bool)+  describe "treeCursorAddChildNodeSingleAtStartAndSelect" $ it "produces valid cursors" $ producesValid2 (treeCursorAddChildNodeSingleAtStartAndSelect @Bool)+  describe "treeCursorAddChildNodeSingleAtEndAndSelect" $ it "produces valid cursors" $ producesValid2 (treeCursorAddChildNodeSingleAtEndAndSelect @Bool)+  describe "treeCursorAddChildNodeAtPosAndSelect" $ it "produces valid cursors" $ forAllValid $ producesValid3 . (treeCursorAddChildNodeAtPosAndSelect @Bool)+  describe "treeCursorAddChildNodeAtStartAndSelect" $ do+    it "produces valid cursors" $ producesValid3 (treeCursorAddChildNodeAtStartAndSelect @Bool)+    it "works for this example" $+      let tc =+            TreeCursor+              { treeAbove =+                  Just+                    TreeAbove+                      { treeAboveLefts = map makeCTree [Node "1" [], Node "2" []],+                        treeAboveAbove = Nothing,+                        treeAboveNode = "bar",+                        treeAboveRights = map makeCTree [Node "3" [], Node "4" []]+                      },+                treeCurrent = "baz",+                treeBelow = makeCForest [Node "a" [], Node "b" []]+              }+          tc' =+            TreeCursor+              { treeAbove =+                  Just+                    TreeAbove+                      { treeAboveLefts = [],+                        treeAboveAbove =+                          Just+                            TreeAbove+                              { treeAboveLefts = map makeCTree [Node "1" [], Node "2" []],+                                treeAboveAbove = Nothing,+                                treeAboveNode = "bar",+                                treeAboveRights = map makeCTree [Node "3" [], Node "4" []]+                              },+                        treeAboveNode = "baz",+                        treeAboveRights = map makeCTree [Node "a" [], Node "b" []]+                      },+                treeCurrent = "new",+                treeBelow = makeCForest []+              }+       in treeCursorAddChildNodeAtStartAndSelect "new" [] tc `shouldBe` tc'+  describe "treeCursorAddChildNodeAtEndAndSelect" $ do+    it "produces valid cursors" $ producesValid3 (treeCursorAddChildNodeAtEndAndSelect @Bool)+    it "works for this example" $+      let tc =+            TreeCursor+              { treeAbove =+                  Just+                    TreeAbove+                      { treeAboveLefts = map makeCTree [Node "1" [], Node "2" []],+                        treeAboveAbove = Nothing,+                        treeAboveNode = "bar",+                        treeAboveRights = map makeCTree [Node "3" [], Node "4" []]+                      },+                treeCurrent = "baz",+                treeBelow = makeCForest [Node "a" [], Node "b" []]+              }+          tc' =+            TreeCursor+              { treeAbove =+                  Just+                    TreeAbove+                      { treeAboveLefts = map makeCTree [Node "b" [], Node "a" []],+                        treeAboveAbove =+                          Just+                            TreeAbove+                              { treeAboveLefts = map makeCTree [Node "1" [], Node "2" []],+                                treeAboveAbove = Nothing,+                                treeAboveNode = "bar",+                                treeAboveRights = map makeCTree [Node "3" [], Node "4" []]+                              },+                        treeAboveNode = "baz",+                        treeAboveRights = []+                      },+                treeCurrent = "new",+                treeBelow = makeCForest []+              }+       in treeCursorAddChildNodeAtEndAndSelect "new" [] tc `shouldBe` tc'

@@ -1,238 +1,252 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.MovementSpec-  ( spec-  ) where+  ( spec,+  )+where  import Control.Monad (unless)--import Text.Show.Pretty--import Test.Hspec--import Test.Validity- import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree (CTree(..), TreeAbove(..), TreeCursor(..), emptyCForest, openForest)- import Cursor.Simple.Tree.TestUtils+import Cursor.Tree (TreeCursor (..), emptyCForest, openForest)+import Test.Hspec+import Test.Validity+import Text.Show.Pretty  spec :: Spec spec = do   describe "treeCursorSelection" $-    it "produces valids on valids" $ producesValidsOnValids (treeCursorSelection @Bool @Bool)+    it "produces valids on valids" $+      producesValid (treeCursorSelection @Bool @Bool)   describe "treeCursorSelect" $ do-    it "produces valids on valids" $ producesValidsOnValids2 (treeCursorSelect @Bool)+    it "produces valids on valids" $ producesValid2 (treeCursorSelect @Bool)     it "is identity with the current selection" $-      forAllValid $ \tc ->-        let sel = treeCursorSelection tc-         in case treeCursorSelect @Bool sel tc of-              Nothing -> expectationFailure "treeCursorSelect should not have failed."-              Just r ->-                unless (r == tc) $-                expectationFailure $-                unlines-                  [ "selection:"-                  , ppShow sel-                  , "expected:"-                  , drawTreeCursor tc-                  , "actual:"-                  , drawTreeCursor r-                  ]+      forAllValid $+        \tc ->+          let sel = treeCursorSelection tc+           in case treeCursorSelect @Bool sel tc of+                Nothing -> expectationFailure "treeCursorSelect should not have failed."+                Just r ->+                  unless (r == tc) $+                    expectationFailure $+                      unlines+                        [ "selection:",+                          ppShow sel,+                          "expected:",+                          drawTreeCursor tc,+                          "actual:",+                          drawTreeCursor r+                        ]   describe "treeCursorSelectPrevOnSameLevel" $ do     testMovementM treeCursorSelectPrevOnSameLevel     it "selects the previous element" pending     it "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (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" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (treeCursorSelectPrevOnSameLevel @Bool)         (treeCursorSelectNextOnSameLevel @Bool)+  describe "treeCursorSelectFirstOnSameLevel" $ do+    testMovement treeCursorSelectFirstOnSameLevel+    it "selects the previous element" pending+  describe "treeCursorSelectNextOnSameLevel" $ do+    testMovement treeCursorSelectLastOnSameLevel+    it "selects the next element" pending   describe "treeCursorSelectAbovePrev" $ do     testMovementM treeCursorSelectAbovePrev     it "Works for this classic example" $-            -- > 0-            --   > 1-            --     > 2-            --       > 3 <- expected end cursor-            --   > 4 <- start cursor-     do-      let start =-            TreeCursor-              { treeAbove =-                  Just-                    (TreeAbove-                       { treeAboveLefts =-                           [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]]-                       , treeAboveAbove = Nothing-                       , treeAboveNode = 0-                       , treeAboveRights = []-                       })-              , treeCurrent = 4 :: Int-              , treeBelow = emptyCForest-              }-          expected =-            TreeCursor-              { treeAbove =-                  Just-                    (TreeAbove-                       { treeAboveLefts = []-                       , treeAboveAbove =-                           Just-                             (TreeAbove-                                { treeAboveLefts = []-                                , treeAboveAbove =-                                    Just-                                      (TreeAbove-                                         { treeAboveLefts = []-                                         , treeAboveAbove = Nothing-                                         , treeAboveNode = 0-                                         , treeAboveRights = [CNode 4 emptyCForest]-                                         })-                                , treeAboveNode = 1-                                , treeAboveRights = []-                                })-                       , treeAboveNode = 2-                       , treeAboveRights = []-                       })-              , treeCurrent = 3-              , treeBelow = emptyCForest-              }-      case treeCursorSelectAbovePrev start of-        Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed"-        Just r -> r `treeShouldBe` expected+      -- > 0+      --   > 1+      --     > 2+      --       > 3 <- expected end cursor+      --   > 4 <- start cursor+      do+        let start =+              TreeCursor+                { treeAbove =+                    Just+                      ( TreeAbove+                          { treeAboveLefts =+                              [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]],+                            treeAboveAbove = Nothing,+                            treeAboveNode = 0,+                            treeAboveRights = []+                          }+                      ),+                  treeCurrent = 4 :: Int,+                  treeBelow = emptyCForest+                }+            expected =+              TreeCursor+                { treeAbove =+                    Just+                      ( TreeAbove+                          { treeAboveLefts = [],+                            treeAboveAbove =+                              Just+                                ( TreeAbove+                                    { treeAboveLefts = [],+                                      treeAboveAbove =+                                        Just+                                          ( TreeAbove+                                              { treeAboveLefts = [],+                                                treeAboveAbove = Nothing,+                                                treeAboveNode = 0,+                                                treeAboveRights = [CNode 4 emptyCForest]+                                              }+                                          ),+                                      treeAboveNode = 1,+                                      treeAboveRights = []+                                    }+                                ),+                            treeAboveNode = 2,+                            treeAboveRights = []+                          }+                      ),+                  treeCurrent = 3,+                  treeBelow = emptyCForest+                }+        case treeCursorSelectAbovePrev start of+          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" $-      forAllValid $ \tc ->-        case treeCursorSelectAboveNext @Bool tc of-          Nothing -> pure ()-          Just tc' ->-            case treeCursorSelectAbovePrev tc' of-              Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed."-              Just tc'' ->-                unless (tc == tc'') $-                expectationFailure $-                unlines-                  [ "treeCursorSelectAboveNext and treeCursorSelectAbovePrev should have round-tripped."-                  , "Started with:"-                  , drawTreeCursor tc-                  , "after treeCursorSelectAboveNext"-                  , drawTreeCursor tc'-                  , "after treeCursorSelectAbovePrev"-                  , drawTreeCursor tc''-                  , "instead of"-                  , drawTreeCursor tc-                  ]+      forAllValid $+        \tc ->+          case treeCursorSelectAboveNext @Bool tc of+            Nothing -> pure ()+            Just tc' ->+              case treeCursorSelectAbovePrev tc' of+                Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed."+                Just tc'' ->+                  unless (tc == tc'') $+                    expectationFailure $+                      unlines+                        [ "treeCursorSelectAboveNext and treeCursorSelectAbovePrev should have round-tripped.",+                          "Started with:",+                          drawTreeCursor tc,+                          "after treeCursorSelectAboveNext",+                          drawTreeCursor tc',+                          "after treeCursorSelectAbovePrev",+                          drawTreeCursor tc'',+                          "instead of",+                          drawTreeCursor tc+                        ]   describe "treeCursorSelectAboveNext" $ do     testMovementM treeCursorSelectAboveNext     it "Works for this classic example" $-            -- > 0-            --   > 1-            --     > 2-            --       > 3 <- start cursor-            --   > 4 <- expected end cursor-     do-      let start =-            TreeCursor-              { treeAbove =-                  Just-                    (TreeAbove-                       { treeAboveLefts = []-                       , treeAboveAbove =-                           Just-                             (TreeAbove-                                { treeAboveLefts = []-                                , treeAboveAbove =-                                    Just-                                      (TreeAbove-                                         { treeAboveLefts = []-                                         , treeAboveAbove = Nothing-                                         , treeAboveNode = 0-                                         , treeAboveRights = [node 4 []]-                                         })-                                , treeAboveNode = 1-                                , treeAboveRights = []-                                })-                       , treeAboveNode = 2-                       , treeAboveRights = []-                       })-              , treeCurrent = 3-              , treeBelow = emptyCForest-              }-          expected =-            TreeCursor-              { treeAbove =-                  Just-                    (TreeAbove-                       { treeAboveLefts =-                           [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]]-                       , treeAboveAbove = Nothing-                       , treeAboveNode = 0-                       , treeAboveRights = []-                       })-              , treeCurrent = 4 :: Int-              , treeBelow = emptyCForest-              }-      case treeCursorSelectAboveNext start of-        Nothing -> expectationFailure "treeCursorSelectAboveNext should not have failed."-        Just r -> r `treeShouldBe` expected+      -- > 0+      --   > 1+      --     > 2+      --       > 3 <- start cursor+      --   > 4 <- expected end cursor+      do+        let start =+              TreeCursor+                { treeAbove =+                    Just+                      ( TreeAbove+                          { treeAboveLefts = [],+                            treeAboveAbove =+                              Just+                                ( TreeAbove+                                    { treeAboveLefts = [],+                                      treeAboveAbove =+                                        Just+                                          ( TreeAbove+                                              { treeAboveLefts = [],+                                                treeAboveAbove = Nothing,+                                                treeAboveNode = 0,+                                                treeAboveRights = [node 4 []]+                                              }+                                          ),+                                      treeAboveNode = 1,+                                      treeAboveRights = []+                                    }+                                ),+                            treeAboveNode = 2,+                            treeAboveRights = []+                          }+                      ),+                  treeCurrent = 3,+                  treeBelow = emptyCForest+                }+            expected =+              TreeCursor+                { treeAbove =+                    Just+                      ( TreeAbove+                          { treeAboveLefts =+                              [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]],+                            treeAboveAbove = Nothing,+                            treeAboveNode = 0,+                            treeAboveRights = []+                          }+                      ),+                  treeCurrent = 4 :: Int,+                  treeBelow = emptyCForest+                }+        case treeCursorSelectAboveNext start of+          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" $-      forAllValid $ \tc ->-        case treeCursorSelectAbovePrev @Bool tc of-          Nothing -> pure ()-          Just tc' ->-            case treeCursorSelectAboveNext tc' of-              Nothing -> pure ()-              Just tc'' ->-                unless (tc == tc'') $-                expectationFailure $-                unlines-                  [ "treeCursorSelectAbovePrev and treeCursorSelectAboveNext should have round-tripped."-                  , "Started with:"-                  , drawTreeCursor tc-                  , "after treeCursorSelectAbovePrev"-                  , drawTreeCursor tc'-                  , "after treeCursorSelectAboveNext"-                  , drawTreeCursor tc''-                  , "instead of"-                  , drawTreeCursor tc-                  ]+      forAllValid $+        \tc ->+          case treeCursorSelectAbovePrev @Bool tc of+            Nothing -> pure ()+            Just tc' ->+              case treeCursorSelectAboveNext tc' of+                Nothing -> pure ()+                Just tc'' ->+                  unless (tc == tc'') $+                    expectationFailure $+                      unlines+                        [ "treeCursorSelectAbovePrev and treeCursorSelectAboveNext should have round-tripped.",+                          "Started with:",+                          drawTreeCursor tc,+                          "after treeCursorSelectAbovePrev",+                          drawTreeCursor tc',+                          "after treeCursorSelectAboveNext",+                          drawTreeCursor tc'',+                          "instead of",+                          drawTreeCursor tc+                        ]   describe "treeCursorSelectPrev" $ do     testMovementM treeCursorSelectPrev     it "selects the previous element" pending     it "after treeCursorSelectNext is identity if they don't fail" $-      inverseFunctionsIfSucceedOnValid (treeCursorSelectNext @Bool) (treeCursorSelectPrev @Bool)+      inverseFunctionsIfSucceed (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" $-      inverseFunctionsIfSucceedOnValid (treeCursorSelectPrev @Bool) (treeCursorSelectNext @Bool)+      inverseFunctionsIfSucceed (treeCursorSelectPrev @Bool) (treeCursorSelectNext @Bool)   describe "treeCursorSelectFirst" $ do     testMovement treeCursorSelectFirst     it "selects the first element" pending-    it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Bool+    it "is idempotent" $ idempotent $ treeCursorSelectFirst @Bool   describe "treeCursorSelectLast" $ do     testMovement treeCursorSelectLast     it "selects the last element" pending-    it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Bool+    it "is idempotent" $ idempotent $ treeCursorSelectLast @Bool   describe "treeCursorSelectAbove" $ do     testMovementM treeCursorSelectAbove     it "selects the element above" pending     it "after treeCursorSelectBelow is identity if they don't fail" $-      inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Bool) $-      treeCursorSelectAbove @Bool+      inverseFunctionsIfSucceed (treeCursorSelectBelowAtStart @Bool) $+        treeCursorSelectAbove @Bool   describe "treeCursorSelectBelowAtPos" $ do-    it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Bool+    it "produces valids on valids" $ producesValid2 $ treeCursorSelectBelowAtPos @Bool     it "is a movement" $ forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n     it "selects the element n-th below" pending   describe "treeCursorSelectBelowAtStart" $ do

@@ -1,30 +1,25 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.PromoteSpec-  ( spec-  ) where--import Data.Tree--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()+import Cursor.Simple.Tree.TestUtils import Cursor.Tree-  ( CTree(..)-  , TreeAbove(..)-  , TreeCursor(..)-  , closedForest-  , emptyCForest-  , openForest+  ( TreeCursor (..),+    closedForest,+    emptyCForest,+    openForest,   )--import Cursor.Simple.Tree.TestUtils+import Data.Tree+import Test.Hspec+import Test.Validity  spec :: Spec spec = do@@ -32,27 +27,27 @@   applicativeSpec @PromoteElemResult   monadSpec @PromoteElemResult   describe "treeCursorPromoteElem" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteElem @Bool+    it "produces valids on valids" $ producesValid $ treeCursorPromoteElem @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'b' [node 'c' []]]-                      , treeAboveAbove =+                      { treeAboveLefts = [node 'b' [node 'c' []]],+                        treeAboveAbove =                           Just                             TreeAbove-                              { treeAboveLefts = []-                              , treeAboveAbove = Nothing-                              , treeAboveNode = 'p'-                              , treeAboveRights = [node 'h' []]-                              }-                      , treeAboveNode = 'a'-                      , treeAboveRights = [node 'f' [node 'g' []]]-                      }-              , treeCurrent = 'd'-              , treeBelow = closedForest [Node 'e' []]+                              { treeAboveLefts = [],+                                treeAboveAbove = Nothing,+                                treeAboveNode = 'p',+                                treeAboveRights = [node 'h' []]+                              },+                        treeAboveNode = 'a',+                        treeAboveRights = [node 'f' [node 'g' []]]+                      },+                treeCurrent = 'd',+                treeBelow = closedForest [Node 'e' []]               }           promoteEnd =             TreeCursor@@ -61,18 +56,18 @@                     TreeAbove                       { treeAboveLefts =                           [ CNode 'a' $-                            openForest-                              [ CNode 'b' $-                                openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest]-                              , CNode 'f' $ closedForest [Node 'g' []]-                              ]-                          ]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [CNode 'h' emptyCForest]-                      }-              , treeCurrent = 'd'-              , treeBelow = emptyCForest+                              openForest+                                [ CNode 'b' $+                                    openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest],+                                  CNode 'f' $ closedForest [Node 'g' []]+                                ]+                          ],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [CNode 'h' emptyCForest]+                      },+                treeCurrent = 'd',+                treeBelow = emptyCForest               }        in case treeCursorPromoteElem promoteStart of             PromotedElem tc' -> tc' `treeShouldBe` promoteEnd@@ -82,27 +77,27 @@   applicativeSpec @PromoteResult   monadSpec @PromoteResult   describe "treeCursorPromoteSubTree" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteSubTree @Bool+    it "produces valids on valids" $ producesValid $ treeCursorPromoteSubTree @Bool     it "Works on the example from the docs" $       let promoteStart =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]]-                      , treeAboveAbove =+                      { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]],+                        treeAboveAbove =                           Just                             TreeAbove-                              { treeAboveLefts = []-                              , treeAboveAbove = Nothing-                              , treeAboveNode = 'p'-                              , treeAboveRights = [node 'h' []]-                              }-                      , treeAboveNode = 'a'-                      , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]-                      }-              , treeCurrent = 'd'-              , treeBelow = closedForest [Node 'e' []]+                              { treeAboveLefts = [],+                                treeAboveAbove = Nothing,+                                treeAboveNode = 'p',+                                treeAboveRights = [node 'h' []]+                              },+                        treeAboveNode = 'a',+                        treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]]+                      },+                treeCurrent = 'd',+                treeBelow = closedForest [Node 'e' []]               }           promoteEnd =             TreeCursor@@ -111,17 +106,17 @@                     TreeAbove                       { treeAboveLefts =                           [ CNode 'a' $-                            openForest-                              [ CNode 'b' $ closedForest [Node 'c' []]-                              , CNode 'f' $ closedForest [Node 'g' []]-                              ]-                          ]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [CNode 'h' $ closedForest []]-                      }-              , treeCurrent = 'd'-              , treeBelow = closedForest [Node 'e' []]+                              openForest+                                [ CNode 'b' $ closedForest [Node 'c' []],+                                  CNode 'f' $ closedForest [Node 'g' []]+                                ]+                          ],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [CNode 'h' $ closedForest []]+                      },+                treeCurrent = 'd',+                treeBelow = closedForest [Node 'e' []]               }        in case treeCursorPromoteSubTree promoteStart of             Promoted tc' -> tc' `treeShouldBe` promoteEnd

@@ -1,96 +1,94 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.Simple.Tree.SwapSpec-  ( spec-  ) where--import Test.Hspec--import Test.Validity+  ( spec,+  )+where  import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree (TreeAbove(..), TreeCursor(..), emptyCForest)- import Cursor.Simple.Tree.TestUtils+import Cursor.Tree (TreeCursor (..), emptyCForest)+import Test.Hspec+import Test.Validity  spec :: Spec spec = do   functorSpec @SwapResult   describe "treeCursorSwapPrev" $ do-    it "produces valids on valids" $ producesValidsOnValids $ treeCursorSwapPrev @Bool @Bool+    it "produces valids on valids" $ producesValid $ treeCursorSwapPrev @Bool @Bool     it "works on the example from the docs" $       let start =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'a' []]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = []-                      }-              , treeCurrent = 'b'-              , treeBelow = emptyCForest+                      { treeAboveLefts = [node 'a' []],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = []+                      },+                treeCurrent = 'b',+                treeBelow = emptyCForest               }           end =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = []-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [node 'a' []]-                      }-              , treeCurrent = 'b'-              , treeBelow = emptyCForest+                      { treeAboveLefts = [],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [node 'a' []]+                      },+                treeCurrent = 'b',+                treeBelow = emptyCForest               }        in case treeCursorSwapPrev start of             Swapped r -> r `treeShouldBe` end             _ -> expectationFailure "treeCursorSwapPrev should not have failed."     it "reverts treeCursorSwapNext" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (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 @Bool @Bool+    it "produces valids on valids" $ producesValid $ treeCursorSwapNext @Bool @Bool     it "works on the example from the docs" $       let start =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = []-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = [node 'b' []]-                      }-              , treeCurrent = 'a'-              , treeBelow = emptyCForest+                      { treeAboveLefts = [],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = [node 'b' []]+                      },+                treeCurrent = 'a',+                treeBelow = emptyCForest               }           end =             TreeCursor               { treeAbove =                   Just                     TreeAbove-                      { treeAboveLefts = [node 'b' []]-                      , treeAboveAbove = Nothing-                      , treeAboveNode = 'p'-                      , treeAboveRights = []-                      }-              , treeCurrent = 'a'-              , treeBelow = emptyCForest+                      { treeAboveLefts = [node 'b' []],+                        treeAboveAbove = Nothing,+                        treeAboveNode = 'p',+                        treeAboveRights = []+                      },+                treeCurrent = 'a',+                treeBelow = emptyCForest               }        in case treeCursorSwapNext start of             Swapped r -> r `treeShouldBe` end             _ -> expectationFailure "treeCursorSwapNext should not have failed."     it "reverts treeCursorSwapNext" $-      inverseFunctionsIfSucceedOnValid+      inverseFunctionsIfSucceed         (treeCursorSwapPrev @Bool @Bool)         (treeCursorSwapNext @Bool @Bool)     it "swaps the current node with the next node" pending

@@ -1,33 +1,29 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Simple.Tree.TestUtils where -import Data.Tree- import Control.Monad (unless)--import Test.Hspec--import Test.QuickCheck-import Test.Validity- import Cursor.Simple.Tree hiding (TreeCursor) import qualified Cursor.Simple.Tree as STC (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree (CTree(..), closedForest)+import Cursor.Tree (closedForest)+import Data.Tree+import Test.Hspec+import Test.QuickCheck+import Test.Validity  testMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Spec testMovement func = do-  it "produces valids on valids" $ producesValidsOnValids $ func @Bool+  it "produces valids on valids" $ producesValid $ func @Bool   it "is a movement" $ isMovement func  testMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec testMovementM func = do-  it "produces valids on valids" $ producesValidsOnValids $ func @Bool+  it "produces valids on valids" $ producesValid $ func @Bool   it "is a movement" $ isMovementM func  isMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property@@ -39,13 +35,13 @@         let ne = rebuildCTree $ rebuildTreeCursor lec             ne' = rebuildCTree $ rebuildTreeCursor lec'          in unless (ne == ne') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ drawTreeCursor lec-              , "Tree before:  \n" ++ drawTree (fmap show ne)-              , "Cursor after: \n" ++ drawTreeCursor lec'-              , "Tree after:   \n" ++ drawTree (fmap show ne')-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ drawTreeCursor lec,+                    "Tree before:  \n" ++ drawTree (fmap show ne),+                    "Cursor after: \n" ++ drawTreeCursor lec',+                    "Tree after:   \n" ++ drawTree (fmap show ne')+                  ]  isMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Property isMovement func =@@ -55,14 +51,14 @@ treeShouldBe :: (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation treeShouldBe actual expected =   unless (actual == expected) $-  expectationFailure $-  unlines-    [ "The following should have been equal."-    , "actual:"-    , drawTreeCursor actual-    , "expected:"-    , drawTreeCursor expected-    ]+    expectationFailure $+      unlines+        [ "The following should have been equal.",+          "actual:",+          drawTreeCursor actual,+          "expected:",+          drawTreeCursor expected+        ]  instance CanFail SwapResult where   hasFailed (Swapped _) = False

@@ -4,161 +4,185 @@ {-# LANGUAGE TypeFamilies #-}  module Cursor.TextFieldSpec-  ( spec-  ) where--import Test.Hspec--import Test.QuickCheck-import Test.Validity---- import Test.Validity.Optics-import Text.Show.Pretty (ppShow)--import qualified Data.Text as T--import qualified Data.List.NonEmpty as NE+  ( spec,+  )+where  import Control.Monad- import Cursor.List.NonEmpty import Cursor.TextField import Cursor.TextField.Gen () import Cursor.Types+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Text.Show.Pretty (ppShow)  spec :: Spec spec = do-  eqSpecOnValid @TextFieldCursor+  eqSpec @TextFieldCursor   genValidSpec @TextFieldCursor   describe "Validity TextFieldCursor" $ do     it "consider a textfield with a newline in the previous lines invalid" $-      forAllValid $ \tc ->-        shouldBeInvalid $-        TextFieldCursor-          { textFieldCursorNonEmpty =-              NonEmptyCursor-                {nonEmptyCursorPrev = ["\n"], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = []}-          }+      forAllValid $+        \tc ->+          shouldBeInvalid $+            TextFieldCursor+              { textFieldCursorNonEmpty =+                  NonEmptyCursor+                    { nonEmptyCursorPrev = ["\n"],+                      nonEmptyCursorCurrent = tc,+                      nonEmptyCursorNext = []+                    }+              }     it "consider a textfield with a newline in the next lines invalid" $-      forAllValid $ \tc ->-        shouldBeInvalid $-        TextFieldCursor-          { textFieldCursorNonEmpty =-              NonEmptyCursor-                {nonEmptyCursorPrev = [], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = ["\n"]}-          }+      forAllValid $+        \tc ->+          shouldBeInvalid $+            TextFieldCursor+              { textFieldCursorNonEmpty =+                  NonEmptyCursor+                    { nonEmptyCursorPrev = [],+                      nonEmptyCursorCurrent = tc,+                      nonEmptyCursorNext = ["\n"]+                    }+              }   describe "makeTextFieldCursor" $ do     it "produces a valid cursor for \"\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n"     it "produces a valid cursor for \"\\n\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n\n"-    it "produces valid cursors" $ producesValidsOnValids makeTextFieldCursor+    it "produces valid cursors" $ producesValid makeTextFieldCursor   describe "makeTextFieldCursorWithSelection" $ do     it "produces a valid cursor for \"\\n\"" $-      forAllValid $ \x ->-        forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n"+      forAllValid $+        \x ->+          forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n"     it "produces a valid cursor for \"\\n\\n\"" $-      forAllValid $ \x ->-        forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n\n"-    it "produces valid cursors" $ producesValidsOnValids3 makeTextFieldCursorWithSelection+      forAllValid $+        \x ->+          forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n\n"+    it "produces valid cursors" $ producesValid3 makeTextFieldCursorWithSelection     it "is the inverse of rebuildTextFieldCursor when using the current selection" $-      forAllValid $ \tfc -> do-        let (x, y) = textFieldCursorSelection tfc-            t = rebuildTextFieldCursor tfc-        case makeTextFieldCursorWithSelection x y t of-          Nothing -> expectationFailure "makeTextFieldCursorWithSelection should not have failed."-          Just tfc' ->-            unless (tfc' == tfc) $-            expectationFailure $-            unlines-              [ "expected"-              , ppShow tfc-              , "actual"-              , ppShow tfc'-              , "The selection of the original (expected) cursor was:"-              , show (x, y)-              , "The rebuild text was:"-              , show t-              ]+      forAllValid $+        \tfc -> do+          let (x, y) = textFieldCursorSelection tfc+              t = rebuildTextFieldCursor tfc+          case makeTextFieldCursorWithSelection x y t of+            Nothing -> expectationFailure "makeTextFieldCursorWithSelection should not have failed."+            Just tfc' ->+              unless (tfc' == tfc) $+                expectationFailure $+                  unlines+                    [ "expected",+                      ppShow tfc,+                      "actual",+                      ppShow tfc',+                      "The selection of the original (expected) cursor was:",+                      show (x, y),+                      "The rebuild text was:",+                      show t+                    ]   describe "rebuildTextFieldCursorLines" $ do-    it "produces valid lists" $ producesValidsOnValids rebuildTextFieldCursorLines+    it "produces valid lists" $ producesValid rebuildTextFieldCursorLines     it "produces texts without newlines" $-      forAllValid $ \tfc -> do-        let ls = NE.toList $ rebuildTextFieldCursorLines tfc-        unless (all (T.all (/= '\n')) ls) $-          expectationFailure $-          unlines $ "Some of the following lines contain a newline:" : map show ls+      forAllValid $+        \tfc -> do+          let ls = NE.toList $ rebuildTextFieldCursorLines tfc+          unless (all (T.all (/= '\n')) ls) $+            expectationFailure $+              unlines $+                "Some of the following lines contain a newline:" : map show ls   describe "rebuildTextFieldCursor" $ do-    it "produces valid texts" $ producesValidsOnValids rebuildTextFieldCursor+    it "produces valid texts" $ producesValid rebuildTextFieldCursor     it "is the inverse of makeTextFieldCursor" $-      inverseFunctionsOnValid makeTextFieldCursor rebuildTextFieldCursor+      inverseFunctions makeTextFieldCursor rebuildTextFieldCursor     it "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $-      forAllValid $ \x ->-        forAllValid $ \y ->-          inverseFunctionsIfFirstSucceedsOnValid-            (makeTextFieldCursorWithSelection x y)-            rebuildTextFieldCursor+      forAllValid $+        \x ->+          forAllValid $ \y ->+            inverseFunctionsIfFirstSucceeds+              (makeTextFieldCursorWithSelection x y)+              rebuildTextFieldCursor   describe "textFieldCursorSelection" $-    it "produces valid tuples" $ producesValidsOnValids textFieldCursorSelection+    it "produces valid tuples" $+      producesValid textFieldCursorSelection   describe "emptyTextFieldCursor" $ it "is valid" $ shouldBeValid emptyTextFieldCursor-  describe "nullTextFieldCursor" $ it "produces valid" $ producesValidsOnValids nullTextFieldCursor+  describe "nullTextFieldCursor" $ it "produces valid" $ producesValid nullTextFieldCursor   describe "textFieldCursorSelectPrevLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectPrevLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectPrevLine     it "is a movement" $ isMovementM textFieldCursorSelectPrevLine     it "selects the previous line" pending   describe "textFieldCursorSelectNextLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectNextLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectNextLine     it "is a movement" $ isMovementM textFieldCursorSelectNextLine     it "selects the next line" pending   describe "textFieldCursorSelectFirstLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectFirstLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectFirstLine     it "is a movement" $ isMovement textFieldCursorSelectFirstLine-    it "is idempotent" $ idempotentOnValid textFieldCursorSelectFirstLine+    it "is idempotent" $ idempotent textFieldCursorSelectFirstLine     it "selects the first line" pending   describe "textFieldCursorSelectLastLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectLastLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectLastLine     it "is a movement" $ isMovement textFieldCursorSelectLastLine-    it "is idempotent" $ idempotentOnValid textFieldCursorSelectLastLine+    it "is idempotent" $ idempotent textFieldCursorSelectLastLine     it "selects the last line" pending   describe "textFieldCursorSelectPrevChar" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectPrevChar+    it "produces valid cursors" $ producesValid textFieldCursorSelectPrevChar     it "selects the previous character on the current line" pending   describe "textFieldCursorSelectNextChar" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectNextChar+    it "produces valid cursors" $ producesValid textFieldCursorSelectNextChar     it "selects the previous character on the current line" pending+  describe "textFieldCursorSelectBeginWord" $+    it "produces valid cursors" $+      producesValid textFieldCursorSelectBeginWord+  describe "textFieldCursorSelectEndWord" $+    it "produces valid cursors" $+      producesValid textFieldCursorSelectEndWord+  describe "textFieldCursorSelectPrevWord" $+    it "produces valid cursors" $+      producesValid textFieldCursorSelectPrevWord+  describe "textFieldCursorSelectNextWord" $+    it "produces valid cursors" $+      producesValid textFieldCursorSelectNextWord   describe "textFieldCursorIndexOnLine" $ do-    it "produces valid indices" $ producesValidsOnValids textFieldCursorIndexOnLine+    it "produces valid indices" $ producesValid textFieldCursorIndexOnLine     it "returns the index on the current line" pending   describe "textFieldCursorSelectIndexOnLine" $ do     it "produces valid cursors for any index" $-      producesValidsOnValids2 textFieldCursorSelectIndexOnLine+      producesValid2 textFieldCursorSelectIndexOnLine     it "selects the given index on the current line" pending   describe "textFieldCursorInsertChar" $ do     it "produces valid cursors" $-      forAllValid $ \d -> producesValidsOnValids (textFieldCursorInsertChar d)+      forAllValid $+        \d -> producesValid (textFieldCursorInsertChar d)     it "inserts a character before the cursor on the current line" pending   describe "textFieldCursorAppendChar" $ do     it "produces valid cursors" $-      forAllValid $ \d -> producesValidsOnValids (textFieldCursorAppendChar d)+      forAllValid $+        \d -> producesValid (textFieldCursorAppendChar d)     it "inserts a character after the cursor on the currrent line" pending   describe "textFieldCursorInsertNewline" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorInsertNewline+    it "produces valid cursors" $ producesValid textFieldCursorInsertNewline     it "inserts a new line" pending   describe "textFieldCursorAppendNewline" $-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorAppendNewline+    it "produces valid cursors" $+      producesValid textFieldCursorAppendNewline   describe "textFieldCursorRemove" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorRemove+    it "produces valid cursors" $ producesValid textFieldCursorRemove     it "removes empty text field cursor" $       textFieldCursorRemove emptyTextFieldCursor `shouldBe` Just Deleted     it "removes a character or a line" pending   describe "textFieldCursorDelete" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorDelete+    it "produces valid cursors" $ producesValid textFieldCursorDelete     it "removes empty text field cursor" $       textFieldCursorDelete emptyTextFieldCursor `shouldBe` Just Deleted     it "deletes a character or a line" pending   describe "textFieldCursorSelectStartOfLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectStartOfLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectStartOfLine     it "selects the start of the current line" pending   describe "textFieldCursorSelectEndOfLine" $ do-    it "produces valid cursors" $ producesValidsOnValids textFieldCursorSelectEndOfLine+    it "produces valid cursors" $ producesValid textFieldCursorSelectEndOfLine     it "selects the end of the current line" pending  isMovementM :: (TextFieldCursor -> Maybe TextFieldCursor) -> Property@@ -170,13 +194,13 @@         let tf = rebuildTextFieldCursor tfc             tf' = rebuildTextFieldCursor tfc'          in unless (tf == tf') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show tfc-              , "TextField before:  \n" ++ show tf-              , "Cursor after: \n" ++ show tfc'-              , "TextField after:   \n" ++ show tf'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show tfc,+                    "TextField before:  \n" ++ show tf,+                    "Cursor after: \n" ++ show tfc',+                    "TextField after:   \n" ++ show tf'+                  ]  isMovement :: (TextFieldCursor -> TextFieldCursor) -> Property isMovement func =

@@ -1,20 +1,22 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}  module Cursor.TextSpec-  ( spec-  ) where--import Test.Hspec-import Test.QuickCheck-import Test.Validity+  ( spec,+  )+where  import Control.Monad- import Cursor.List import Cursor.Text-import Cursor.Text.Gen ()+import Cursor.Text.Gen+import Data.Char+import Data.Text (Text)+import qualified Data.Text as T+import Test.Hspec+import Test.QuickCheck+import Test.Validity  spec :: Spec spec = do@@ -23,88 +25,165 @@   describe "Validity TextCursor" $ do     it "considers a text cursor with a newline in the previous characters invalid" $       shouldBeInvalid $-      TextCursor {textCursorList = ListCursor {listCursorPrev = "\n", listCursorNext = ""}}+        TextCursor {textCursorList = ListCursor {listCursorPrev = "\n", listCursorNext = ""}}     it "considers a text cursor with a newline in the next characters invalid" $       shouldBeInvalid $-      TextCursor {textCursorList = ListCursor {listCursorPrev = "", listCursorNext = "\n"}}+        TextCursor {textCursorList = ListCursor {listCursorPrev = "", listCursorNext = "\n"}}     it "considers a text cursor with an unsafe character in the previous characters invalid" $       shouldBeInvalid $-      TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = ""}}+        TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = ""}}     it "considers a text cursor with an unsafe character in the next characters invalid" $       shouldBeInvalid $-      TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = "\n"}}+        TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = "\n"}}   describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor   describe "makeTextCursor" $-    it "produces valid list cursors" $ producesValidsOnValids makeTextCursor+    it "produces valid list cursors" $+      producesValid makeTextCursor   describe "makeTextCursorWithSelection" $-    it "produces valid list cursors" $ producesValidsOnValids2 makeTextCursorWithSelection+    it "produces valid list cursors" $+      producesValid2 makeTextCursorWithSelection   describe "rebuildTextCursor" $ do-    it "produces valid lists" $ producesValidsOnValids rebuildTextCursor+    it "produces valid lists" $ producesValid rebuildTextCursor     it "is the inverse of makeTextCursor" $-      inverseFunctionsIfFirstSucceedsOnValid makeTextCursor rebuildTextCursor+      inverseFunctionsIfFirstSucceeds makeTextCursor rebuildTextCursor     it "is the inverse of makeTextCursorWithSelection for any index" $-      forAllUnchecked $ \i ->-        inverseFunctionsIfFirstSucceedsOnValid (makeTextCursorWithSelection i) rebuildTextCursor-  describe "textCursorNull" $ it "produces valid bools" $ producesValidsOnValids textCursorNull-  describe "textCursorLength" $ it "produces valid ints" $ producesValidsOnValids textCursorLength-  describe "textCursorIndex" $ it "produces valid indices" $ producesValidsOnValids textCursorIndex+      forAllValid $+        \i ->+          inverseFunctionsIfFirstSucceeds (makeTextCursorWithSelection i) rebuildTextCursor+  describe "textCursorNull" $ it "produces valid bools" $ producesValid textCursorNull+  describe "textCursorLength" $ it "produces valid ints" $ producesValid textCursorLength+  describe "textCursorIndex" $ it "produces valid indices" $ producesValid textCursorIndex   describe "textCursorSelectPrev" $ do-    it "produces valid cursors" $ producesValidsOnValids textCursorSelectPrev+    it "produces valid cursors" $ producesValid textCursorSelectPrev     it "is a movement" $ isMovementM textCursorSelectPrev     it "selects the previous position" pending   describe "textCursorSelectNext" $ do-    it "produces valid cursors" $ producesValidsOnValids textCursorSelectNext+    it "produces valid cursors" $ producesValid textCursorSelectNext     it "is a movement" $ isMovementM textCursorSelectNext     it "selects the next position" pending   describe "textCursorSelectIndex" $ do-    it "produces valid cursors" $ producesValidsOnValids2 textCursorSelectIndex-    it "is a movement" $ forAllUnchecked $ \ix -> isMovement (textCursorSelectIndex ix)+    it "produces valid cursors" $ producesValid2 textCursorSelectIndex+    it "is a movement" $ forAllValid $ \ix -> isMovement (textCursorSelectIndex ix)     it "selects the position at the given index" pending     it "produces a cursor that has the given selection for valid selections in the cursor" $-      forAllValid $ \tc ->-        forAll (choose (0, textCursorLength tc)) $ \i ->-          textCursorIndex (textCursorSelectIndex i tc) `shouldBe` i+      forAllValid $+        \tc ->+          forAll (choose (0, textCursorLength tc)) $ \i ->+            textCursorIndex (textCursorSelectIndex i tc) `shouldBe` i   describe "textCursorSelectStart" $ do-    it "produces valid cursors" $ producesValidsOnValids textCursorSelectStart+    it "produces valid cursors" $ producesValid textCursorSelectStart     it "is a movement" $ isMovement textCursorSelectStart     it "is idempotent" $ idempotent textCursorSelectStart     it "selects the starting position" pending   describe "textCursorSelectEnd" $ do-    it "produces valid cursors" $ producesValidsOnValids textCursorSelectEnd+    it "produces valid cursors" $ producesValid textCursorSelectEnd     it "is a movement" $ isMovement textCursorSelectEnd     it "is idempotent" $ idempotent textCursorSelectEnd     it "selects the end position" pending   describe "textCursorPrevChar" $ do-    it "produces valid items" $ producesValidsOnValids textCursorPrevChar+    it "produces valid items" $ producesValid textCursorPrevChar     it "returns the item before the position" pending   describe "textCursorNextChar" $ do-    it "produces valid items" $ producesValidsOnValids textCursorNextChar+    it "produces valid items" $ producesValid textCursorNextChar     it "returns the item after the position" pending+  describe "textCursorSelectBeginWord" $ do+    it "produces valid items" $ producesValid textCursorSelectBeginWord+    it "is a movement" $ isMovement textCursorSelectBeginWord+    it "is idempotent" $ isIdempotentForSentence textCursorSelectBeginWord+    it "works for this example" $+      textCursorSelectBeginWord (buildTestTextCursor "hell" "o") `shouldBe` buildTestTextCursor "" "hello"+    it "works for this example" $+      textCursorSelectBeginWord (buildTestTextCursor "hello  " " world") `shouldBe` buildTestTextCursor "" "hello   world"+    it "works for this example" $+      textCursorSelectBeginWord (buildTestTextCursor "hello " "world") `shouldBe` buildTestTextCursor "hello " "world"+    it "works for this example" $+      textCursorSelectBeginWord (buildTestTextCursor "" " hello") `shouldBe` buildTestTextCursor "" " hello"+  describe "textCursorSelectEndWord" $ do+    it "produces valid items" $ producesValid textCursorSelectEndWord+    it "is a movement" $ isMovement textCursorSelectEndWord+    it "is idempotent" $ isIdempotentForSentence textCursorSelectEndWord+    it "works for this example" $+      textCursorSelectEndWord (buildTestTextCursor "hell" "o") `shouldBe` buildTestTextCursor "hello" ""+    it "works for this example" $+      textCursorSelectEndWord (buildTestTextCursor "hello  " " world") `shouldBe` buildTestTextCursor "hello   world" ""+    it "works for this example" $+      textCursorSelectEndWord (buildTestTextCursor "hello" " world") `shouldBe` buildTestTextCursor "hello" " world"+    it "works for this example" $+      textCursorSelectEndWord (buildTestTextCursor "hello " "") `shouldBe` buildTestTextCursor "hello " ""+  describe "textCursorSelectNextWord" $ do+    it "produces valid items" $ producesValid textCursorSelectNextWord+    it "is a movement" $ isMovement textCursorSelectNextWord+    it "works for this example" $+      textCursorSelectNextWord (buildTestTextCursor "" "hello") `shouldBe` buildTestTextCursor "hello" ""+    it "works for this example" $+      textCursorSelectNextWord (buildTestTextCursor "hell" "o world") `shouldBe` buildTestTextCursor "hello " "world"+    it "works for this example" $+      textCursorSelectNextWord (buildTestTextCursor "hello" " world") `shouldBe` buildTestTextCursor "hello " "world"+    it "works for this example" $+      textCursorSelectNextWord (buildTestTextCursor "hello " "") `shouldBe` buildTestTextCursor "hello " ""+    it "goes to the end of the cursor" $+      textCursorSelectNextWord (buildTestTextCursor "a\v" "b") `shouldBe` buildTestTextCursor "a\vb" ""+    it "chooses the next word correctly" $+      textCursorSelectNextWord (buildTestTextCursor "a" " b c") `shouldBe` buildTestTextCursor "a " "b c"+  describe "textCursorSelectPrevWord" $ do+    it "produces valid items" $ producesValid textCursorSelectPrevWord+    it "is a movement" $ isMovement textCursorSelectPrevWord+    it "works for this example" $+      textCursorSelectPrevWord (buildTestTextCursor "hello" "") `shouldBe` buildTestTextCursor "" "hello"+    it "works for this example" $+      textCursorSelectPrevWord (buildTestTextCursor "hello w" "orld") `shouldBe` buildTestTextCursor "hello" " world"+    it "works for this example" $+      textCursorSelectPrevWord (buildTestTextCursor "hello " "world") `shouldBe` buildTestTextCursor "hello" " world"+    it "works for this example" $+      textCursorSelectPrevWord (buildTestTextCursor " h" "ello") `shouldBe` buildTestTextCursor "" " hello"+    it "goes to the beginning of the cursor" $+      textCursorSelectPrevWord (buildTestTextCursor "a" "\vb") `shouldBe` buildTestTextCursor "" "a\vb"+    it "chooses the previous word correctly" $+      textCursorSelectPrevWord (buildTestTextCursor "a b" " c") `shouldBe` buildTestTextCursor "a" " b c"   describe "textCursorInsert" $ do-    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)+    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorInsert d)     it "inserts an item before the cursor" pending   describe "textCursorAppend" $ do-    it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)+    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorAppend d)     it "inserts an item after the cursor" pending+  describe "textCursorInsertString" $ do+    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorInsertString d)+    it "works for this example" $+      (makeTextCursor "hello" >>= textCursorInsertString " world")+        `shouldBe` makeTextCursor "hello world"+  describe "textCursorAppendString" $+    it "produces valids" $+      forAllValid $+        \d -> producesValid (textCursorAppendString d)+  describe "textCursorInsertText" $+    it "produces valids" $+      forAllValid $+        \d -> producesValid (textCursorInsertText d)+  describe "textCursorAppendText" $+    it "produces valids" $+      forAllValid $+        \d -> producesValid (textCursorAppendText d)   describe "textCursorRemove" $ do-    it "produces valids" $ validIfSucceedsOnValid textCursorRemove+    it "produces valids" $ validIfSucceeds textCursorRemove     it "removes an item before the cursor" pending   describe "textCursorDelete" $ do-    it "produces valids" $ validIfSucceedsOnValid textCursorDelete+    it "produces valids" $ validIfSucceeds textCursorDelete     it "removes an item before the cursor" pending   describe "textCursorSplit" $ do-    it "produces valids" $ producesValidsOnValids textCursorSplit+    it "produces valids" $ producesValid textCursorSplit     it "produces two list cursors that rebuild to the rebuilding of the original" $-      forAllValid $ \lc ->-        let (lc1, lc2) = textCursorSplit lc-         in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe` rebuildTextCursor lc+      forAllValid $+        \lc ->+          let (lc1, lc2) = textCursorSplit lc+           in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe` rebuildTextCursor lc   describe "textCursorCombine" $ do-    it "produces valids" $ producesValidsOnValids2 textCursorCombine+    it "produces valids" $ producesValid2 textCursorCombine     it "produces a list that rebuilds to the rebuilding of the original two cursors" $-      forAllValid $ \lc1 ->-        forAllValid $ \lc2 ->-          let lc = textCursorCombine lc1 lc2-           in rebuildTextCursor lc `shouldBe` (rebuildTextCursor lc1 <> rebuildTextCursor lc2)+      forAllValid $+        \lc1 ->+          forAllValid $ \lc2 ->+            let lc = textCursorCombine lc1 lc2+             in rebuildTextCursor lc `shouldBe` (rebuildTextCursor lc1 <> rebuildTextCursor lc2)  isMovementM :: (TextCursor -> Maybe TextCursor) -> Property isMovementM func =@@ -115,14 +194,26 @@         let t = rebuildTextCursor tc             t' = rebuildTextCursor tc'          in unless (t == t') $-            expectationFailure $-            unlines-              [ "Cursor before:\n" ++ show tc-              , "Text before:  \n" ++ show t-              , "Cursor after: \n" ++ show tc'-              , "Text after:   \n" ++ show t'-              ]+              expectationFailure $+                unlines+                  [ "Cursor before:\n" ++ show tc,+                    "Text before:  \n" ++ show t,+                    "Cursor after: \n" ++ show tc',+                    "Text after:   \n" ++ show t'+                  ]  isMovement :: (TextCursor -> TextCursor) -> Property isMovement func =   forAllValid $ \lec -> rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)++isIdempotentForSentence :: (TextCursor -> TextCursor) -> Property+isIdempotentForSentence f =+  checkCoverage $+    forAllShrink textCursorSentenceGen shrinkSentence $ \tc ->+      let txt = rebuildTextCursor tc+          numChars = T.length txt+          numSpaces = T.length . T.filter isSpace $ txt+       in cover 50 (numSpaces >= 1 && numChars > 2) "non trivial" $ f (f tc) `shouldBe` f tc++buildTestTextCursor :: Text -> Text -> TextCursor+buildTestTextCursor befores afters = TextCursor {textCursorList = ListCursor {listCursorPrev = T.unpack . T.reverse $ befores, listCursorNext = T.unpack afters}}

@@ -1,21 +1,20 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Cursor.Tree.TypesSpec-  ( spec-  ) where+  ( spec,+  )+where +import Cursor.Tree+import Cursor.Tree.Gen () import Test.Hspec- import Test.Validity import Test.Validity.Optics -import Cursor.Tree-import Cursor.Tree.Gen ()- spec :: Spec spec = do   eqSpec @TreeCursorSelection@@ -42,14 +41,14 @@   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+  describe "treeAboveLeftsL" $ lensSpec $ treeAboveLeftsL @Bool+  describe "treeAboveAboveL" $ lensSpec $ treeAboveAboveL @Bool+  describe "treeAboveNodeL" $ lensSpec $ treeAboveNodeL @Bool+  describe "treeAboveRightsL" $ lensSpec $ 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+  describe "treeCursorAboveL" $ lensSpec $ treeCursorAboveL @Bool @Bool+  describe "treeCursorCurrentL" $ lensSpec $ treeCursorCurrentL @Bool @Bool+  describe "treeCursorBelowL" $ lensSpec $ treeCursorBelowL @Bool @Bool+  describe "treeCursorCurrentSubTreeL" $ lensSpec $ treeCursorCurrentSubTreeL @Bool @Bool