cursor-gen 0.0.0.0 → 0.1.0.0
raw patch · 34 files changed
+2704/−2838 lines, 34 filesdep ~genvaliditydep ~genvalidity-text
Dependency ranges changed: genvalidity, genvalidity-text
Files
- cursor-gen.cabal +31/−30
- src/Cursor/Forest/Gen.hs +6/−6
- src/Cursor/List/Gen.hs +19/−15
- src/Cursor/List/NonEmpty/Gen.hs +44/−38
- src/Cursor/Map/Gen.hs +4/−4
- src/Cursor/Map/KeyValue/Gen.hs +4/−4
- src/Cursor/Simple/Forest/Gen.hs +2/−2
- src/Cursor/Simple/List/NonEmpty/Gen.hs +4/−4
- src/Cursor/Simple/Map/Gen.hs +2/−2
- src/Cursor/Simple/Map/KeyValue/Gen.hs +2/−2
- src/Cursor/Simple/Tree/Gen.hs +2/−2
- src/Cursor/Text/Gen.hs +5/−5
- src/Cursor/TextField/Gen.hs +8/−10
- src/Cursor/Tree/Gen.hs +102/−103
- test/Cursor/List/NonEmptySpec.hs +12/−14
- test/Cursor/ListSpec.hs +116/−119
- test/Cursor/Map/KeyValueSpec.hs +6/−6
- test/Cursor/MapSpec.hs +5/−5
- test/Cursor/Simple/ForestSpec.hs +917/−1008
- test/Cursor/Simple/List/NonEmptySpec.hs +158/−163
- test/Cursor/Simple/Map/KeyValueSpec.hs +32/−33
- test/Cursor/Simple/MapSpec.hs +142/−144
- test/Cursor/Simple/Tree/BaseSpec.hs +28/−30
- test/Cursor/Simple/Tree/CollapseSpec.hs +19/−11
- test/Cursor/Simple/Tree/DeleteSpec.hs +95/−106
- test/Cursor/Simple/Tree/DemoteSpec.hs +147/−152
- test/Cursor/Simple/Tree/InsertSpec.hs +32/−34
- test/Cursor/Simple/Tree/MovementSpec.hs +242/−252
- test/Cursor/Simple/Tree/PromoteSpec.hs +110/−109
- test/Cursor/Simple/Tree/SwapSpec.hs +79/−83
- test/Cursor/Simple/Tree/TestUtils.hs +37/−37
- test/Cursor/TextFieldSpec.hs +145/−152
- test/Cursor/TextSpec.hs +106/−112
- test/Cursor/Tree/TypesSpec.hs +41/−41
cursor-gen.cabal view
@@ -1,11 +1,13 @@--- This file has been generated from package.yaml by hpack version 0.28.2.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack ----- hash: 58018e9f00ff2eb5016098f09115ecf1aad35674f8b0a9ca7a893c923064ab31+-- hash: f0096dc28a739f287cb2c184cec92b05547e888c6a4d33724be642b1f80124b2 name: cursor-gen-version: 0.0.0.0+version: 0.1.0.0 synopsis: Generators for Purely Functional Cursors description: Generators for Purely Functional Cursors for common data structures category: Cursor@@ -16,9 +18,20 @@ license: MIT license-file: LICENSE build-type: Simple-cabal-version: >= 1.10 library+ hs-source-dirs:+ src/+ ghc-options: -Wall+ build-depends:+ QuickCheck+ , base <5+ , containers+ , cursor+ , genvalidity >=0.8+ , genvalidity-containers+ , genvalidity-text >=0.6+ , text exposed-modules: Cursor.Forest.Gen Cursor.List.Gen@@ -35,23 +48,26 @@ Cursor.Tree.Gen other-modules: Paths_cursor_gen+ default-language: Haskell2010++test-suite cursor-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs hs-source-dirs:- src/- ghc-options: -Wall+ test/+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: QuickCheck- , base <5+ , base , containers , cursor- , genvalidity- , genvalidity-containers- , genvalidity-text+ , cursor-gen+ , genvalidity-hspec+ , genvalidity-hspec-optics+ , hspec+ , microlens+ , pretty-show , text- default-language: Haskell2010--test-suite cursor-test- type: exitcode-stdio-1.0- main-is: Spec.hs other-modules: Cursor.List.NonEmptySpec Cursor.ListSpec@@ -74,19 +90,4 @@ Cursor.TextSpec Cursor.Tree.TypesSpec Paths_cursor_gen- hs-source-dirs:- test/- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall- build-depends:- QuickCheck- , base- , containers- , cursor- , cursor-gen- , genvalidity-hspec- , genvalidity-hspec-optics- , hspec- , microlens- , pretty-show- , text default-language: Haskell2010
src/Cursor/Forest/Gen.hs view
@@ -2,8 +2,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Forest.Gen- (- ) where+ (+ ) where import Data.GenValidity import Data.GenValidity.Containers ()@@ -15,9 +15,9 @@ instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (ForestCursor a b) where- genUnchecked = ForestCursor <$> genUnchecked- shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne+ genUnchecked = ForestCursor <$> genUnchecked+ shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne instance (GenValid a, GenValid b) => GenValid (ForestCursor a b) where- genValid = ForestCursor <$> genValid- shrinkValid (ForestCursor ne) = ForestCursor <$> shrinkValid ne+ genValid = ForestCursor <$> genValid+ shrinkValid (ForestCursor ne) = ForestCursor <$> shrinkValid ne
src/Cursor/List/Gen.hs view
@@ -2,9 +2,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.List.Gen- ( listCursorWithGen- , listCursorWithIndex0- ) where+ ( listCursorWithGen+ , listCursorWithIndex0+ ) where import Test.QuickCheck @@ -13,20 +13,24 @@ 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 {..}+ 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)] instance GenValid a => GenValid (ListCursor a) where- genValid =- sized $ \n -> do- (a, b) <- genSplit n- listCursorPrev <- resize a genValid- listCursorNext <- resize b genValid- pure ListCursor {..}+ genValid =+ sized $ \n -> do+ (a, b) <- genSplit n+ listCursorPrev <- resize a genValid+ listCursorNext <- resize b genValid+ pure ListCursor {..}+ shrinkValid (ListCursor prev next) =+ [ListCursor prev' next' | (prev', next') <- shrinkValid (prev, next)] listCursorWithGen :: Gen a -> Gen (ListCursor a) listCursorWithGen gen = ListCursor <$> genListOf gen <*> genListOf gen
src/Cursor/List/NonEmpty/Gen.hs view
@@ -2,10 +2,10 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.List.NonEmpty.Gen- ( nonEmptyElemOf- , nonEmptyWithIndex0- , nonEmptyWith- ) where+ ( nonEmptyElemOf+ , nonEmptyWithIndex0+ , nonEmptyWith+ ) where import Control.Monad @@ -19,34 +19,40 @@ instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (NonEmptyCursor a b) where- genUnchecked =- sized $ \n -> do- part <- arbPartition n- case part of- [] -> singletonNonEmptyCursor <$> resize 0 genUnchecked- (s:ss) -> do- i <- choose (0, length ss)- let (as, bs) = splitAt i ss- nonEmptyCursorPrev <-- forM as $ \s_ -> resize s_ genUnchecked- nonEmptyCursorCurrent <- resize s genUnchecked- nonEmptyCursorNext <-- forM bs $ \s_ -> resize s_ genUnchecked- pure NonEmptyCursor {..}+ genUnchecked =+ sized $ \n -> do+ part <- arbPartition n+ case part of+ [] -> singletonNonEmptyCursor <$> resize 0 genUnchecked+ (s:ss) -> do+ i <- choose (0, length ss)+ let (as, bs) = splitAt i ss+ nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genUnchecked+ nonEmptyCursorCurrent <- resize s genUnchecked+ nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genUnchecked+ pure NonEmptyCursor {..}+ shrinkUnchecked (NonEmptyCursor prev cur next) =+ [ NonEmptyCursor prev' cur' next'+ | (prev', cur', next') <- shrinkUnchecked (prev, cur, next)+ ] instance (GenValid a, GenValid b) => GenValid (NonEmptyCursor a b) where- genValid =- sized $ \n -> do- part <- arbPartition n- case part of- [] -> singletonNonEmptyCursor <$> resize 0 genValid- (s:ss) -> do- i <- choose (0, length ss)- let (as, bs) = splitAt i ss- nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genValid- nonEmptyCursorCurrent <- resize s genValid- nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genValid- pure NonEmptyCursor {..}+ genValid =+ sized $ \n -> do+ part <- arbPartition n+ case part of+ [] -> singletonNonEmptyCursor <$> resize 0 genValid+ (s:ss) -> do+ i <- choose (0, length ss)+ let (as, bs) = splitAt i ss+ nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genValid+ nonEmptyCursorCurrent <- resize s genValid+ nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genValid+ pure NonEmptyCursor {..}+ shrinkValid (NonEmptyCursor prev cur next) =+ [ NonEmptyCursor prev' cur' next'+ | (prev', cur', next') <- shrinkValid (prev, cur, next)+ ] nonEmptyElemOf :: NonEmptyCursor a a -> Gen a nonEmptyElemOf = elements . NE.toList . rebuildNonEmptyCursor id@@ -56,13 +62,13 @@ 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- ]+ oneof+ [ NonEmptyCursor <$> listWithA <*> g <*> genListOf g+ , NonEmptyCursor <$> genListOf g <*> pure a <*> genListOf g+ , NonEmptyCursor <$> genListOf g <*> g <*> listWithA+ ] where listWithA = do- l1 <- genListOf g- l2 <- genListOf g- pure $ l1 ++ [a] ++ l2+ l1 <- genListOf g+ l2 <- genListOf g+ pure $ l1 ++ [a] ++ l2
src/Cursor/Map/Gen.hs view
@@ -2,8 +2,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Map.Gen- (- ) where+ (+ ) where import Data.GenValidity import Data.GenValidity.Containers ()@@ -18,5 +18,5 @@ instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => GenValid (MapCursor kc vc k v) where- genValid = genValidStructurallyWithoutExtraChecking- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
src/Cursor/Map/KeyValue/Gen.hs view
@@ -1,8 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Map.KeyValue.Gen- (- ) where+ (+ ) where import Data.GenValidity @@ -13,8 +13,8 @@ instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => GenValid (KeyValueCursor kc vc k v) where- genValid = genValidStructurallyWithoutExtraChecking- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ genValid = genValidStructurallyWithoutExtraChecking+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked KeyValueToggle
src/Cursor/Simple/Forest/Gen.hs view
@@ -1,5 +1,5 @@ module Cursor.Simple.Forest.Gen- (- ) where+ (+ ) where import Cursor.Forest.Gen ()
src/Cursor/Simple/List/NonEmpty/Gen.hs view
@@ -1,8 +1,8 @@ module Cursor.Simple.List.NonEmpty.Gen- ( nonEmptyElemOf- , nonEmptyWithIndex0- , nonEmptyWith- ) where+ ( nonEmptyElemOf+ , nonEmptyWithIndex0+ , nonEmptyWith+ ) where import Test.QuickCheck
src/Cursor/Simple/Map/Gen.hs view
@@ -1,5 +1,5 @@ module Cursor.Simple.Map.Gen- (- ) where+ (+ ) where import Cursor.Map.Gen ()
src/Cursor/Simple/Map/KeyValue/Gen.hs view
@@ -1,5 +1,5 @@ module Cursor.Simple.Map.KeyValue.Gen- (- ) where+ (+ ) where import Cursor.Map.KeyValue.Gen ()
src/Cursor/Simple/Tree/Gen.hs view
@@ -1,5 +1,5 @@ module Cursor.Simple.Tree.Gen- (- ) where+ (+ ) where import Cursor.Tree.Gen ()
src/Cursor/Text/Gen.hs view
@@ -1,9 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Text.Gen- ( textCursorWithGen- , textCursorWithIndex0- ) where+ ( textCursorWithGen+ , textCursorWithIndex0+ ) where import Test.QuickCheck @@ -17,8 +17,8 @@ instance GenUnchecked TextCursor instance GenValid TextCursor where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally textCursorWithGen :: Gen Char -> Gen TextCursor textCursorWithGen gen = TextCursor <$> listCursorWithGen gen
src/Cursor/TextField/Gen.hs view
@@ -14,14 +14,12 @@ import Cursor.List.NonEmpty.Gen () import Cursor.Text.Gen -instance GenUnchecked TextFieldCursor- instance GenValid TextFieldCursor where- genValid = do- let charGen = genValid `suchThat` (/= '\n')- prevs <- genListOf $ T.pack <$> genListOf charGen- nexts <- genListOf $ T.pack <$> genListOf charGen- cur <- textCursorWithGen charGen- let nec = NonEmptyCursor prevs cur nexts- pure $ TextFieldCursor nec- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ genValid = do+ let charGen = genValid `suchThat` (/= '\n')+ prevs <- genListOf $ T.pack <$> genListOf charGen+ nexts <- genListOf $ T.pack <$> genListOf charGen+ cur <- textCursorWithGen charGen+ let nec = NonEmptyCursor prevs cur nexts+ pure $ TextFieldCursor nec+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
src/Cursor/Tree/Gen.hs view
@@ -3,8 +3,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Tree.Gen- (- ) where+ (+ ) where import qualified Data.List.NonEmpty as NE import Data.Maybe@@ -19,136 +19,135 @@ instance GenUnchecked TreeCursorSelection instance GenValid TreeCursorSelection where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally instance GenUnchecked a => GenUnchecked (SwapResult a) instance GenValid a => GenValid (SwapResult a) where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally instance GenUnchecked a => GenUnchecked (PromoteElemResult a) instance GenValid a => GenValid (PromoteElemResult a) where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally instance GenUnchecked a => GenUnchecked (PromoteResult a) instance GenValid a => GenValid (PromoteResult a) where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally instance GenUnchecked a => GenUnchecked (DemoteResult a) instance GenValid a => GenValid (DemoteResult a) where- genValid = genValidStructurally- shrinkValid = shrinkValidStructurally+ genValid = genValidStructurally+ shrinkValid = shrinkValidStructurally instance GenUnchecked a => GenUnchecked (CTree a) where- genUnchecked =- sized $ \n -> do- s <- upTo n- (a, b) <- genSplit s- val <- resize a genUnchecked- for <- resize b genUnchecked- pure $ CNode val for- shrinkUnchecked (CNode a cf) =- [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)]+ genUnchecked =+ sized $ \n -> do+ s <- upTo n+ (a, b) <- genSplit s+ 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- s <- upTo n- (a, b) <- genSplit s- val <- resize a genValid- for <- resize b genValid- pure $ CNode val for- shrinkValid (CNode a cf) = [CNode a' cf' | (a', cf') <- shrinkValid (a, cf)]+ genValid =+ sized $ \n -> do+ s <- upTo n+ (a, b) <- genSplit s+ val <- resize a genValid+ for <- resize b genValid+ 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 $ \n ->- case n of- 0 -> pure EmptyCForest- _ ->- oneof- [ ClosedForest <$> resize n genUnchecked- , OpenForest <$> resize n genUnchecked- ]- shrinkUnchecked EmptyCForest = []- shrinkUnchecked (ClosedForest ne) =- EmptyCForest : (ClosedForest <$> shrinkUnchecked ne)- shrinkUnchecked (OpenForest ne) =- EmptyCForest :- ClosedForest (NE.map rebuildCTree ne) :- (OpenForest <$> shrinkUnchecked ne)+ genUnchecked =+ sized $ \n ->+ case n of+ 0 -> pure EmptyCForest+ _ ->+ oneof+ [ ClosedForest <$> resize n genUnchecked+ , OpenForest <$> resize n 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 $ \n ->- case n of- 0 -> pure EmptyCForest- _ ->- oneof- [ ClosedForest <$> resize n genValid- , OpenForest <$> resize n genValid- ]- shrinkValid EmptyCForest = []- shrinkValid (ClosedForest ne) =- EmptyCForest : (ClosedForest <$> shrinkValid ne)- shrinkValid (OpenForest ne) =- EmptyCForest :- ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne)+ genValid =+ sized $ \n ->+ case n of+ 0 -> pure EmptyCForest+ _ ->+ oneof+ [ ClosedForest <$> resize n genValid+ , OpenForest <$> resize n genValid+ ]+ shrinkValid EmptyCForest = []+ shrinkValid (ClosedForest ne) =+ EmptyCForest : (ClosedForest <$> shrinkValid ne)+ 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+ 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- s <- upTo n- (a, b, c, d) <- genSplit4 s- treeAbove <- resize (a + b) genValid- treeCurrent <- resize c genValid- treeBelow <- resize d genValid- pure TreeCursor {..}- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ genValid =+ sized $ \n -> do+ s <- upTo n+ (a, b, c, d) <- genSplit4 s+ treeAbove <- resize (a + b) genValid+ treeCurrent <- resize c genValid+ 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 {..}+ 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 =- sized $ \n -> do- s <- upTo n- (a, b, c, d) <- genSplit4 s- treeAboveLefts <- resize a genValid- treeAboveAbove <- resize b genValid- treeAboveNode <- resize c genValid- treeAboveRights <- resize d genValid- pure TreeAbove {..}- shrinkValid = shrinkValidStructurallyWithoutExtraFiltering+ genValid =+ sized $ \n -> do+ s <- upTo n+ (a, b, c, d) <- genSplit4 s+ treeAboveLefts <- resize a genValid+ treeAboveAbove <- resize b genValid+ treeAboveNode <- resize c genValid+ treeAboveRights <- resize d genValid+ pure TreeAbove {..}+ shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
test/Cursor/List/NonEmptySpec.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE TypeFamilies #-} module Cursor.List.NonEmptySpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.Validity@@ -17,15 +17,13 @@ spec :: Spec spec = do- describe "nonemptyPrepend" $- it "is equivalent to regular prepend" $- equivalentWhenFirstSucceeds- (\(ls1, ls2) ->- (NE.toList . nonemptyPrepend ls1) <$> NE.nonEmpty ls2)- (uncurry (++) :: ([Int], [Int]) -> [Int])- describe "nonemptyAppend" $- it "is equivalent to regular append" $- equivalentWhenFirstSucceeds- (\(ls1, ls2) ->- (NE.toList . (`nonemptyAppend` ls2)) <$> NE.nonEmpty ls1)- (uncurry (++) :: ([Int], [Int]) -> [Int])+ describe "nonemptyPrepend" $+ it "is equivalent to regular prepend" $+ equivalentWhenFirstSucceeds+ (\(ls1, ls2) -> (NE.toList . nonemptyPrepend ls1) <$> NE.nonEmpty ls2)+ (uncurry (++) :: ([Int], [Int]) -> [Int])+ describe "nonemptyAppend" $+ it "is equivalent to regular append" $+ equivalentWhenFirstSucceeds+ (\(ls1, ls2) -> (NE.toList . (`nonemptyAppend` ls2)) <$> NE.nonEmpty ls1)+ (uncurry (++) :: ([Int], [Int]) -> [Int])
test/Cursor/ListSpec.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE RankNTypes #-} module Cursor.ListSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -17,126 +17,123 @@ spec :: Spec spec = do- eqSpec @(ListCursor Int)- functorSpec @ListCursor- genValidSpec @(ListCursor Double)- describe "emptyListCursor" $- it "is valid" $ shouldBeValid (emptyListCursor @Int)- describe "makeListCursor" $- it "produces valid list cursors" $- producesValidsOnValids (makeListCursor @Double)- describe "makeListCursorWithSelection" $- it "produces valid list cursors" $- producesValidsOnValids2 (makeListCursorWithSelection @Double)- describe "rebuildListCursor" $ do- it "produces valid lists" $- producesValidsOnValids (rebuildListCursor @Double)- it "is the inverse of makeListCursor" $- inverseFunctions (makeListCursor @Int) rebuildListCursor- it "is the inverse of makeListCursorWithSelection for any index" $- forAllUnchecked $ \i ->- inverseFunctionsIfFirstSucceeds- (makeListCursorWithSelection @Int i)- rebuildListCursor- describe "listCursorNull" $- it "produces valid bools" $- producesValidsOnValids (listCursorNull @Double)- describe "listCursorLength" $- it "produces valid bools" $- producesValidsOnValids (listCursorLength @Double)- describe "listCursorIndex" $- it "produces valid indices" $- producesValidsOnValids (listCursorIndex @Double)- describe "listCursorSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids (listCursorSelectPrev @Double)- it "is a movement" $ isMovementM listCursorSelectPrev- it "selects the previous position" pending- describe "listCursorSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids (listCursorSelectNext @Double)- it "is a movement" $ isMovementM listCursorSelectNext- it "selects the next position" pending- describe "listCursorSelectIndex" $ do- it "produces valid cursors" $- producesValidsOnValids2 (listCursorSelectIndex @Double)- it "is a movement" $- forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)- it "selects the position at the given index" pending- describe "listCursorPrevItem" $ do- it "produces valid items" $- producesValidsOnValids (listCursorPrevItem @Double)- it "returns the item before the position" pending- describe "listCursorNextItem" $ do- it "produces valid items" $- producesValidsOnValids (listCursorNextItem @Double)- it "returns the item after the position" pending- describe "listCursorSelectStart" $ do- it "produces valid cursors" $- producesValidsOnValids (listCursorSelectStart @Double)- it "is a movement" $ isMovement listCursorSelectStart- it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Double)- it "selects the starting position" pending- describe "listCursorSelectEnd" $ do- it "produces valid cursors" $- producesValidsOnValids (listCursorSelectEnd @Double)- it "is a movement" $ isMovement listCursorSelectEnd- it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Double)- it "selects the end position" pending- describe "listCursorInsert" $ do- it "produces valids" $- forAllValid $ \d ->- producesValidsOnValids (listCursorInsert @Double d)- it "inserts an item before the cursor" $ pending- describe "listCursorAppend" $ do- it "produces valids" $- forAllValid $ \d ->- producesValidsOnValids (listCursorAppend @Double d)- it "inserts an item after the cursor" $ pending- describe "listCursorRemove" $ do- it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Double)- it "removes an item before the cursor" $ pending- describe "listCursorDelete" $ do- it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Double)- it "removes an item before the cursor" $ pending- describe "listCursorSplit" $ do- it "produces valids" $ producesValidsOnValids (listCursorSplit @Double)- it- "produces two list cursors that rebuild to the rebuilding of the original" $- forAllValid $ \lc ->- let (lc1, lc2) = listCursorSplit (lc :: ListCursor Double)- in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe`- rebuildListCursor lc- describe "listCursorCombine" $ do- it "produces valids" $- producesValidsOnValids2 (listCursorCombine @Double)- it- "produces a list that rebuilds to the rebuilding of the original two cursors" $- forAllValid $ \lc1 ->- forAllValid $ \lc2 ->- let lc = listCursorCombine lc1 (lc2 :: ListCursor Double)- in rebuildListCursor lc `shouldBe`- (rebuildListCursor lc1 ++ rebuildListCursor lc2)+ eqSpec @(ListCursor Int)+ functorSpec @ListCursor+ genValidSpec @(ListCursor Rational)+ describe "emptyListCursor" $+ it "is valid" $ shouldBeValid (emptyListCursor @Int)+ describe "makeListCursor" $+ it "produces valid list cursors" $+ producesValidsOnValids (makeListCursor @Rational)+ describe "makeListCursorWithSelection" $+ it "produces valid list cursors" $+ producesValidsOnValids2 (makeListCursorWithSelection @Rational)+ describe "rebuildListCursor" $ do+ it "produces valid lists" $+ producesValidsOnValids (rebuildListCursor @Rational)+ it "is the inverse of makeListCursor" $+ inverseFunctions (makeListCursor @Int) rebuildListCursor+ it "is the inverse of makeListCursorWithSelection for any index" $+ forAllUnchecked $ \i ->+ inverseFunctionsIfFirstSucceeds+ (makeListCursorWithSelection @Int i)+ rebuildListCursor+ describe "listCursorNull" $+ it "produces valid bools" $+ producesValidsOnValids (listCursorNull @Rational)+ describe "listCursorLength" $+ it "produces valid bools" $+ producesValidsOnValids (listCursorLength @Rational)+ describe "listCursorIndex" $+ it "produces valid indices" $+ producesValidsOnValids (listCursorIndex @Rational)+ describe "listCursorSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (listCursorSelectPrev @Rational)+ it "is a movement" $ isMovementM listCursorSelectPrev+ it "selects the previous position" pending+ describe "listCursorSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (listCursorSelectNext @Rational)+ it "is a movement" $ isMovementM listCursorSelectNext+ it "selects the next position" pending+ describe "listCursorSelectIndex" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (listCursorSelectIndex @Rational)+ it "is a movement" $+ forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)+ it "selects the position at the given index" pending+ describe "listCursorPrevItem" $ do+ it "produces valid items" $+ producesValidsOnValids (listCursorPrevItem @Rational)+ it "returns the item before the position" pending+ describe "listCursorNextItem" $ do+ it "produces valid items" $+ producesValidsOnValids (listCursorNextItem @Rational)+ it "returns the item after the position" pending+ describe "listCursorSelectStart" $ do+ it "produces valid cursors" $+ producesValidsOnValids (listCursorSelectStart @Rational)+ it "is a movement" $ isMovement listCursorSelectStart+ it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Rational)+ it "selects the starting position" pending+ describe "listCursorSelectEnd" $ do+ it "produces valid cursors" $+ producesValidsOnValids (listCursorSelectEnd @Rational)+ it "is a movement" $ isMovement listCursorSelectEnd+ it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Rational)+ it "selects the end position" pending+ describe "listCursorInsert" $ do+ it "produces valids" $+ forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Rational d)+ it "inserts an item before the cursor" $ pending+ describe "listCursorAppend" $ do+ it "produces valids" $+ forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Rational d)+ it "inserts an item after the cursor" $ pending+ describe "listCursorRemove" $ do+ it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Rational)+ it "removes an item before the cursor" $ pending+ describe "listCursorDelete" $ do+ it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Rational)+ it "removes an item before the cursor" $ pending+ describe "listCursorSplit" $ do+ it "produces valids" $ producesValidsOnValids (listCursorSplit @Rational)+ it+ "produces two list cursors that rebuild to the rebuilding of the original" $+ forAllValid $ \lc ->+ let (lc1, lc2) = listCursorSplit (lc :: ListCursor Rational)+ in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe`+ rebuildListCursor lc+ describe "listCursorCombine" $ do+ it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Rational)+ it+ "produces a list that rebuilds to the rebuilding of the original two cursors" $+ forAllValid $ \lc1 ->+ forAllValid $ \lc2 ->+ let lc = listCursorCombine lc1 (lc2 :: ListCursor Rational)+ in rebuildListCursor lc `shouldBe`+ (rebuildListCursor lc1 ++ rebuildListCursor lc2) isMovementM :: (forall a. ListCursor a -> Maybe (ListCursor a)) -> Property isMovementM func =- forAllValid $ \lec ->- case func (lec :: ListCursor Int) of- Nothing -> pure () -- Fine- Just lec' ->- 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'- ]+ forAllValid $ \lec ->+ case func (lec :: ListCursor Int) of+ Nothing -> pure () -- Fine+ Just lec' ->+ 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'+ ] isMovement :: (forall a. ListCursor a -> ListCursor a) -> Property isMovement func =- forAllValid $ \lec ->- rebuildListCursor (lec :: ListCursor Int) `shouldBe`- rebuildListCursor (func lec)+ forAllValid $ \lec ->+ rebuildListCursor (lec :: ListCursor Int) `shouldBe`+ rebuildListCursor (func lec)
test/Cursor/Map/KeyValueSpec.hs view
@@ -1,8 +1,8 @@ {-# LANGUAGE TypeApplications #-} module Cursor.Map.KeyValueSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -13,7 +13,7 @@ spec :: Spec spec = do- eqSpec @(KeyValueCursor Int Int Int Int)- genValidSpec @(KeyValueCursor Double Double Double Double)- eqSpec @KeyValueToggle- genValidSpec @KeyValueToggle+ eqSpec @(KeyValueCursor Int Int Int Int)+ genValidSpec @(KeyValueCursor Double Double Double Double)+ eqSpec @KeyValueToggle+ genValidSpec @KeyValueToggle
test/Cursor/MapSpec.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE RankNTypes #-} module Cursor.MapSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.Validity@@ -14,6 +14,6 @@ spec :: Spec spec = do- eqSpec @(MapCursor Word Int Bool Ordering)- genValidSpec @(MapCursor Double Rational Int Bool)- shrinkValidSpec @(MapCursor Double Rational Int Bool)+ eqSpec @(MapCursor Word Int Bool Ordering)+ genValidSpec @(MapCursor Double Rational Int Bool)+ shrinkValidSpec @(MapCursor Double Rational Int Bool)
test/Cursor/Simple/ForestSpec.hs view
@@ -4,1011 +4,920 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.ForestSpec- ( spec- ) where--import Data.Tree--import Control.Monad (unless)--import Test.Hspec--import Test.QuickCheck-import Test.Validity-import Test.Validity.Optics--import Cursor.Forest (ForestCursor(..))-import Cursor.List.NonEmpty-import Cursor.Simple.Forest hiding (ForestCursor)-import qualified Cursor.Simple.Forest as SFC (ForestCursor)-import Cursor.Tree-import Cursor.Types--import Cursor.Simple.Forest.Gen ()--spec :: Spec-spec = do- eqSpec @(SFC.ForestCursor Int)- genValidSpec @(SFC.ForestCursor Double)- shrinkValidSpecWithLimit @(SFC.ForestCursor Double) 100- describe "makeForestCursor" $- it "produces valid cursors" $- producesValidsOnValids (makeForestCursor @Double)- describe "rebuildForestCursor" $ do- it "produces valid forests" $- producesValidsOnValids (rebuildForestCursor @Double)- it "is the inverse of makeForestCursor for integers" $- inverseFunctions (makeForestCursor @Int) rebuildForestCursor- describe "forestCursorLestCursorL" $- lensSpecOnValid (forestCursorListCursorL @Double @Double)- describe "forestCursorSelectedTreeL" $- lensSpecOnValid (forestCursorSelectedTreeL @Double @Double)- describe "forestCursorSelection" $ do- it "produces valid ints" $- producesValidsOnValids (forestCursorSelection @Double @Double)- it "returns the index of the currently selected element" pending- describe "forestCursorSelectIndex" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorSelectIndex @Double)- it "is the identity function when given the current selection" $- forAllValid $ \fc ->- forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe`- Just (fc :: SFC.ForestCursor Double)- it "returns selects the element at the given index" pending- movementsSpec- collapseSpec- insertSpec- swapSpec- deleteSpec- shiftingSpec--movementsSpec :: Spec-movementsSpec = do- describe "forestCursorSelectPrevTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Double- it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor- it "selects the previous tree cursor" pending- describe "forestCursorSelectNextTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectNextTreeCursor @Double- it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor- it "selects the next tree" pending- describe "forestCursorSelectFirstTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Double- it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor- it "selects the first tree" pending- describe "forestCursorSelectLastTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectLastTreeCursor @Double- it "is a movement" $ isMovement forestCursorSelectLastTreeCursor- it "selects the last tree" pending- describe "forestCursorSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectPrev @Double- it "is a movement" $ isMovementM forestCursorSelectPrev- it "selects the previous node" pending- -- 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- describe "forestCursorSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectNext @Double- 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- describe "forestCursorSelectPrevOnSameLevel" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Double- 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 @Double- it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel- it "selects the next node on the same level as the current node" pending- describe "forestCursorSelectFirst" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectFirst @Double- it "is a movement" $ isMovement forestCursorSelectFirst- it "selects the first node in the forest" pending- describe "forestCursorSelectLast" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectLast @Double- it "is a movement" $ isMovement forestCursorSelectLast- it "selects the last node in the forest" pending- describe "forestCursorSelectBelowAtPos" $ do- it "produces valid cursors" $- producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Double- it "is a movement for any index" $- forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i- it- "selects the child of the selected node at the given position"- pending- describe "forestCursorSelectBelowAtStart" $ do- it "produces valid cursors" $- producesValidsOnValids $ forestCursorSelectBelowAtStart @Double- 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 @Double- 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 @Double @Double- describe "forestCursorCloseCurrentForest" $- it "produces valid cursors" $- producesValidsOnValids $ forestCursorCloseCurrentForest @Double @Double- describe "forestCursorToggleCurrentForest" $- it "produces valid cursors" $- producesValidsOnValids $ forestCursorToggleCurrentForest @Double @Double--insertSpec :: Spec-insertSpec = do- describe "forestCursorInsertEntireTree" $ do- it "produces valid cursors" $- producesValidsOnValids2- (forestCursorInsertEntireTree @Double @Double)- it- "inserts a tree cursor before the currently selected tree cursor"- pending- describe "forestCursorInsertAndSelectTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids2- (forestCursorInsertAndSelectTreeCursor @Double)- it- "inserts a tree cursor before the currently selected tree cursor and selects it"- pending- describe "forestCursorAppendEntireTree" $ do- it "produces valid cursors" $- producesValidsOnValids2- (forestCursorAppendEntireTree @Double @Double)- it "appends a tree after the currently selected tree cursor" pending- describe "forestCursorAppendAndSelectTreeCursor" $ do- it "produces valid cursors" $- producesValidsOnValids2- (forestCursorAppendAndSelectTreeCursor @Double)- it- "appends a tree cursor after the currently selected tree cursor and selects it"- pending- describe "forestCursorInsertTree" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorInsertTree @Double @Double)- it "inserts a tree before the currently selected tree" pending- describe "forestCursorInsertAndSelectTree" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorInsertAndSelectTree @Double)- it- "inserts a tree before the currently selected tree and selects it"- pending- describe "forestCursorAppendTree" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorAppendTree @Double @Double)- it "appends a tree after the currently selected tree " pending- describe "forestCursorAppendAndSelectTree" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorAppendAndSelectTree @Double)- it- "appends a tree after the currently selected tree and selects it"- pending- describe "forestCursorInsert" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorInsert @Double @Double)- it "inserts a node before the currently selected node" pending- describe "forestCursorInsertAndSelect" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorInsertAndSelect @Double)- it- "inserts a node before the currently selected node and selects it"- pending- describe "forestCursorAppend" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorAppend @Double @Double)- it "appends a node after the currently selected node" pending- describe "forestCursorAppendAndSelect" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorAppendAndSelect @Double)- it- "appends a node after the currently selected node and selects it"- pending- describe "forestCursorAddChildTreeToNodeAtPos" $ do- it "produces valid cursors" $- producesValidsOnValids3 $- forestCursorAddChildTreeToNodeAtPos @Double @Double- 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 @Double @Double- 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 @Double @Double- 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 @Double @Double- 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 @Double @Double- 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 @Double @Double- it "adds a child to a node at the end the children of that node" pending- describe "forestCursorAddRoot" $ do- it "produces valid cursors" $- producesValidsOnValids2 (forestCursorAddRoot @Double)- it "houses the entire forest under the given node" pending--swapSpec :: Spec-swapSpec = do- describe "forestCursorSwapPrev" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorSwapPrev @Double @Double)- it "works on the example from the docs" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [CNode 'a' $ emptyCForest]- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'b'- , treeBelow = emptyCForest- }- , nonEmptyCursorNext = []- }- }- end =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev = []- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'b'- , treeBelow = emptyCForest- }- , nonEmptyCursorNext =- [CNode 'a' $ emptyCForest]- }- }- in case forestCursorSwapPrev start of- Nothing ->- expectationFailure- "forestCursorSwapPrev should not have failed."- Just r -> r `forestShouldBe` end- it- "swaps the current node with the previous node on the same level"- pending- it "reverts forestCursorSwapNext" $- inverseFunctionsIfSucceedOnValid- (forestCursorSwapNext @Double @Double)- (forestCursorSwapPrev @Double @Double)- describe "forestCursorSwapNext" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorSwapNext @Double @Double)- it "works on the example from the docs" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev = []- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'a'- , treeBelow = emptyCForest- }- , nonEmptyCursorNext =- [CNode 'b' $ emptyCForest]- }- }- end =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [CNode 'b' $ emptyCForest]- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'a'- , treeBelow = emptyCForest- }- , nonEmptyCursorNext = []- }- }- in case forestCursorSwapNext start of- Nothing ->- expectationFailure- "forestCursorSwapNext should not have failed."- Just r -> r `forestShouldBe` end- it "swaps the current node with the next node on the same level" pending- it "reverts forestCursorSwapPrev" $- inverseFunctionsIfSucceedOnValid- (forestCursorSwapPrev @Double @Double)- (forestCursorSwapNext @Double @Double)--deleteSpec :: Spec-deleteSpec = do- describe "forestCursorRemoveElemAndSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Double)- it "works for this simple example" $- forAllValid $ \fs ->- let simpleDeleteElemStart =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev = []- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 1 :: Int- , treeBelow =- closedForest [Node 2 fs]- }- , nonEmptyCursorNext = []- }- }- in case forestCursorRemoveElemAndSelectPrev- simpleDeleteElemStart of- Nothing -> pure ()- Just Deleted ->- expectationFailure- "forestCursorRemoveElemAndSelectPrev should not have deleted the entire example forest."- Just (Updated _) ->- expectationFailure- "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 @Double)- 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- it "deletes the selected element and selects the next element" pending- describe "forestCursorRemoveElem" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorRemoveElem @Double)- 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- it "removes the selected element" pending- describe "forestCursorDeleteElem" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorDeleteElem @Double)- 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- it "deletes the selected element" pending- describe "forestCursorRemoveSubTreeAndSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids- (forestCursorRemoveSubTreeAndSelectPrev @Double)- it "removes the selected subtree and selects the previous tree" pending- describe "forestCursorDeleteSubTreeAndSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids- (forestCursorDeleteSubTreeAndSelectNext @Double)- it "deletes the selected subtree and selects the next tree" pending- describe "forestCursorRemoveSubTree" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorRemoveSubTree @Double)- it "removes the selected subtree" pending- describe "forestCursorDeleteSubTree" $ do- it "produces valid cursors" $- producesValidsOnValids (forestCursorDeleteSubTree @Double)- it "deletes the selected subtree" pending--shiftingSpec :: Spec-shiftingSpec = do- describe "forestCursorPromoteElem" $ do- it "produces valids on valids" $- producesValidsOnValids $ forestCursorPromoteElem @Double- it "works on the example from the documentation" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { 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]- }- }- expected =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [ CNode 'a' $- 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]- }- }- in case forestCursorPromoteElem start of- Nothing ->- expectationFailure- "forestCursorPromoteElem should not have failed."- Just f -> f `forestShouldBe` expected- it "promotes the current node to the level of its parent" pending- describe "forestCursorDemoteElem" $ do- it "produces valids on valids" $- producesValidsOnValids $ forestCursorDemoteElem @Double- it "works on the example from the documentation" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [CNode 'a' $ closedForest [Node 'b' []]]- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'c'- , treeBelow =- closedForest [Node 'd' []]- }- , nonEmptyCursorNext =- [CNode 'e' emptyCForest]- }- }- expected =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { 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]- }- }- in case forestCursorDemoteElem start of- Nothing ->- expectationFailure- "forestCursorDemoteElem should not have failed."- Just f -> f `forestShouldBe` expected- it "demotes the current node to the level of its children" pending- describe "forestCursorPromoteSubTree" $ do- it "produces valids on valids" $- producesValidsOnValids $ forestCursorPromoteSubTree @Double- it "works on the example from the documentation" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { 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]- }- }- expected =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [ CNode 'a' $- 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]- }- }- in case forestCursorPromoteSubTree start of- Nothing ->- expectationFailure- "forestCursorPromoteSubTree should not have failed."- Just f -> f `forestShouldBe` expected- it "promotes the current subtree to the level of its parent" pending- describe "forestCursorDemoteSubTree" $ do- it "produces valids on valids" $- producesValidsOnValids $ forestCursorDemoteSubTree @Double- it "works on the example from the documentation" $- let start =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev =- [CNode 'a' $ closedForest [Node 'b' []]]- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 'c'- , treeBelow =- closedForest [Node 'd' []]- }- , nonEmptyCursorNext = []- }- }- expected =- ForestCursor- { forestCursorListCursor =- NonEmptyCursor- { nonEmptyCursorPrev = []- , nonEmptyCursorCurrent =- TreeCursor- { treeAbove =- Just- TreeAbove- { treeAboveLefts =- [ CNode- 'b'- emptyCForest- ]- , treeAboveAbove =- Nothing- , treeAboveNode = 'a'- , treeAboveRights = []- }- , treeCurrent = 'c'- , treeBelow =- closedForest [Node 'd' []]- }- , nonEmptyCursorNext = []- }- }- in case forestCursorDemoteSubTree start of- Nothing ->- expectationFailure- "forestCursorDemoteSubTree should not have failed."- Just f -> f `forestShouldBe` expected- it "demotes the current subtree to the level of its children" pending- describe "forestCursorDemoteElemUnder" $ do- it "produces valids on valids" $- producesValidsOnValids3 $- forestCursorDemoteElemUnder @Double @Double- 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- it "demotes the current node to the level of its children" pending- describe "forestCursorDemoteSubTreeUnder" $ do- it "produces valids on valids" $- producesValidsOnValids2 $- forestCursorDemoteSubTreeUnder @Double @Double- 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- it- "demotes the current subtree to the level of its children, by adding a root"- pending--isMovementM ::- (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property-isMovementM func =- forAllValid @(SFC.ForestCursor Int) $ \lec ->- case func lec of- Nothing -> pure () -- Fine- Just lec' ->- 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'- ]--isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property-isMovement func =- forAllValid $ \lec ->- rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe`- rebuildForestCursor (func lec)--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- ]+ ( spec+ ) where++import Data.Tree++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.List.NonEmpty+import Cursor.Simple.Forest hiding (ForestCursor)+import qualified Cursor.Simple.Forest as SFC (ForestCursor)+import Cursor.Tree+import Cursor.Types++import Cursor.Simple.Forest.Gen ()++spec :: Spec+spec = do+ eqSpec @(SFC.ForestCursor Int)+ genValidSpec @(SFC.ForestCursor Rational)+ modifyMaxSize (`quot` 2) $+ modifyMaxSuccess (`quot` 2) $+ shrinkValidSpecWithLimit @(SFC.ForestCursor Rational) 10+ describe "makeForestCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (makeForestCursor @Rational)+ describe "rebuildForestCursor" $ do+ it "produces valid forests" $+ producesValidsOnValids (rebuildForestCursor @Rational)+ it "is the inverse of makeForestCursor for integers" $+ inverseFunctions (makeForestCursor @Int) rebuildForestCursor+ describe "forestCursorLestCursorL" $+ lensSpecOnValid (forestCursorListCursorL @Rational @Rational)+ describe "forestCursorSelectedTreeL" $+ lensSpecOnValid (forestCursorSelectedTreeL @Rational @Rational)+ describe "forestCursorSelection" $ do+ it "produces valid ints" $+ producesValidsOnValids (forestCursorSelection @Rational @Rational)+ it "returns the index of the currently selected element" pending+ describe "forestCursorSelectIndex" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorSelectIndex @Rational)+ it "is the identity function when given the current selection" $+ forAllValid $ \fc ->+ forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe`+ Just (fc :: SFC.ForestCursor Rational)+ it "returns selects the element at the given index" pending+ movementsSpec+ collapseSpec+ insertSpec+ swapSpec+ deleteSpec+ shiftingSpec++movementsSpec :: Spec+movementsSpec = do+ describe "forestCursorSelectPrevTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Rational+ it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor+ it "selects the previous tree cursor" pending+ describe "forestCursorSelectNextTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectNextTreeCursor @Rational+ it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor+ it "selects the next tree" pending+ describe "forestCursorSelectFirstTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Rational+ it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor+ it "selects the first tree" pending+ describe "forestCursorSelectLastTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectLastTreeCursor @Rational+ it "is a movement" $ isMovement forestCursorSelectLastTreeCursor+ it "selects the last tree" pending+ describe "forestCursorSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectPrev @Rational+ it "is a movement" $ isMovementM forestCursorSelectPrev+ it "selects the previous node" pending+ -- 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+ describe "forestCursorSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectNext @Rational+ 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+ describe "forestCursorSelectPrevOnSameLevel" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Rational+ it "is a movement" $ isMovementM forestCursorSelectPrevOnSameLevel+ it "selects the previous node on the same level as the current node" pending+ describe "forestCursorSelectNextOnSameLevel" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Rational+ it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel+ it "selects the next node on the same level as the current node" pending+ describe "forestCursorSelectFirst" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectFirst @Rational+ it "is a movement" $ isMovement forestCursorSelectFirst+ it "selects the first node in the forest" pending+ describe "forestCursorSelectLast" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectLast @Rational+ it "is a movement" $ isMovement forestCursorSelectLast+ it "selects the last node in the forest" pending+ describe "forestCursorSelectAbove" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectAbove @Rational+ it "is a movement" $ isMovementM forestCursorSelectAbove+ it "selects the parent" pending+ describe "forestCursorSelectBelowAtPos" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Rational+ it "is a movement for any index" $+ forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i+ it "selects the child of the selected node at the given position" pending+ describe "forestCursorSelectBelowAtStart" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectBelowAtStart @Rational+ it "is a movement" $ isMovementM forestCursorSelectBelowAtStart+ it "selects the first child of the selected node" pending+ describe "forestCursorSelectBelowAtEnd" $ do+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorSelectBelowAtEnd @Rational+ it "is a movement" $ isMovementM forestCursorSelectBelowAtEnd+ it "selects the first child of the selected node" pending++collapseSpec :: Spec+collapseSpec = do+ describe "forestCursorOpenCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorOpenCurrentForest @Rational @Rational+ describe "forestCursorCloseCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorCloseCurrentForest @Rational @Rational+ describe "forestCursorToggleCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorToggleCurrentForest @Double @Double+ describe "forestCursorOpenCurrentForestRecursively" $+ it "produces valid cursors" $+ producesValidsOnValids $ forestCursorToggleCurrentForest @Rational @Rational+ describe "forestCursorToggleCurrentForestRecursively" $+ it "produces valid cursors" $+ producesValidsOnValids $+ forestCursorToggleCurrentForestRecursively @Rational @Rational++insertSpec :: Spec+insertSpec = do+ describe "forestCursorInsertEntireTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsertEntireTree @Rational @Rational)+ it "inserts a tree cursor before the currently selected tree cursor" pending+ describe "forestCursorInsertAndSelectTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Rational)+ it+ "inserts a tree cursor before the currently selected tree cursor and selects it"+ pending+ describe "forestCursorAppendEntireTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppendEntireTree @Rational @Rational)+ it "appends a tree after the currently selected tree cursor" pending+ describe "forestCursorAppendAndSelectTreeCursor" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Rational)+ it+ "appends a tree cursor after the currently selected tree cursor and selects it"+ pending+ describe "forestCursorInsertTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsertTree @Rational @Rational)+ it "inserts a tree before the currently selected tree" pending+ describe "forestCursorInsertAndSelectTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsertAndSelectTree @Rational)+ it+ "inserts a tree before the currently selected tree and selects it"+ pending+ describe "forestCursorAppendTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppendTree @Rational @Rational)+ it "appends a tree after the currently selected tree " pending+ describe "forestCursorAppendAndSelectTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppendAndSelectTree @Rational)+ it "appends a tree after the currently selected tree and selects it" pending+ describe "forestCursorInsert" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsert @Rational @Rational)+ it "inserts a node before the currently selected node" pending+ describe "forestCursorInsertAndSelect" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorInsertAndSelect @Rational)+ it+ "inserts a node before the currently selected node and selects it"+ pending+ describe "forestCursorAppend" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppend @Rational @Rational)+ it "appends a node after the currently selected node" pending+ describe "forestCursorAppendAndSelect" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAppendAndSelect @Rational)+ it "appends a node after the currently selected node and selects it" pending+ describe "forestCursorAddChildTreeToNodeAtPos" $ do+ it "produces valid cursors" $+ producesValidsOnValids3 $+ forestCursorAddChildTreeToNodeAtPos @Rational @Rational+ it+ "adds a child tree to a node at the given position in the children of that node"+ pending+ describe "forestCursorAddChildTreeToNodeAtStart" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 $+ forestCursorAddChildTreeToNodeAtStart @Rational @Rational+ it+ "adds a child tree to a node at the start the children of that node"+ pending+ describe "forestCursorAddChildTreeToNodeAtEnd" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 $+ forestCursorAddChildTreeToNodeAtEnd @Rational @Rational+ it+ "adds a child tree to a node at the end the children of that node"+ pending+ describe "forestCursorAddChildToNodeAtPos" $ do+ it "produces valid cursors" $+ producesValidsOnValids3 $+ forestCursorAddChildToNodeAtPos @Rational @Rational+ it+ "adds a child to a node at the given position in the children of that node"+ pending+ describe "forestCursorAddChildToNodeAtStart" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 $+ forestCursorAddChildToNodeAtStart @Rational @Rational+ it "adds a child to a node at the start the children of that node" pending+ describe "forestCursorAddChildToNodeAtEnd" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 $+ forestCursorAddChildToNodeAtEnd @Rational @Rational+ it "adds a child to a node at the end the children of that node" pending+ describe "forestCursorAddRoot" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (forestCursorAddRoot @Rational)+ it "houses the entire forest under the given node" pending++swapSpec :: Spec+swapSpec = do+ describe "forestCursorSwapPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorSwapPrev @Rational @Rational)+ it "works on the example from the docs" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = [CNode 'a' $ emptyCForest]+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'b'+ , treeBelow = emptyCForest+ }+ , nonEmptyCursorNext = []+ }+ }+ end =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = []+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'b'+ , treeBelow = emptyCForest+ }+ , nonEmptyCursorNext = [CNode 'a' $ emptyCForest]+ }+ }+ in case forestCursorSwapPrev start of+ Nothing ->+ expectationFailure "forestCursorSwapPrev should not have failed."+ Just r -> r `forestShouldBe` end+ it "swaps the current node with the previous node on the same level" pending+ it "reverts forestCursorSwapNext" $+ inverseFunctionsIfSucceedOnValid+ (forestCursorSwapNext @Rational @Rational)+ (forestCursorSwapPrev @Rational @Rational)+ describe "forestCursorSwapNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorSwapNext @Rational @Rational)+ it "works on the example from the docs" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = []+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'a'+ , treeBelow = emptyCForest+ }+ , nonEmptyCursorNext = [CNode 'b' $ emptyCForest]+ }+ }+ end =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = [CNode 'b' $ emptyCForest]+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'a'+ , treeBelow = emptyCForest+ }+ , nonEmptyCursorNext = []+ }+ }+ in case forestCursorSwapNext start of+ Nothing ->+ expectationFailure "forestCursorSwapNext should not have failed."+ Just r -> r `forestShouldBe` end+ it "swaps the current node with the next node on the same level" pending+ it "reverts forestCursorSwapPrev" $+ inverseFunctionsIfSucceedOnValid+ (forestCursorSwapPrev @Rational @Rational)+ (forestCursorSwapNext @Rational @Rational)++deleteSpec :: Spec+deleteSpec = do+ describe "forestCursorRemoveElemAndSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Rational)+ it "works for this simple example" $+ forAllValid $ \fs ->+ let simpleDeleteElemStart =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = []+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 1 :: Int+ , treeBelow = closedForest [Node 2 fs]+ }+ , nonEmptyCursorNext = []+ }+ }+ in case forestCursorRemoveElemAndSelectPrev simpleDeleteElemStart of+ Nothing -> pure ()+ Just Deleted ->+ expectationFailure+ "forestCursorRemoveElemAndSelectPrev should not have deleted the entire example forest."+ Just (Updated _) ->+ expectationFailure+ "forestCursorRemoveElemAndSelectPrev should not have updated the forest cursor, but failed instead."+ it "removes the selected element and selects the previous element" pending+ describe "forestCursorDeleteElemAndSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Rational)+ it "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+ it "deletes the selected element and selects the next element" pending+ describe "forestCursorRemoveElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorRemoveElem @Rational)+ 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+ it "removes the selected element" pending+ describe "forestCursorDeleteElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorDeleteElem @Rational)+ 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+ it "deletes the selected element" pending+ describe "forestCursorRemoveSubTreeAndSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Rational)+ it "removes the selected subtree and selects the previous tree" pending+ describe "forestCursorDeleteSubTreeAndSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Rational)+ it "deletes the selected subtree and selects the next tree" pending+ describe "forestCursorRemoveSubTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorRemoveSubTree @Rational)+ it "removes the selected subtree" pending+ describe "forestCursorDeleteSubTree" $ do+ it "produces valid cursors" $+ producesValidsOnValids (forestCursorDeleteSubTree @Rational)+ it "deletes the selected subtree" pending++shiftingSpec :: Spec+shiftingSpec = do+ describe "forestCursorPromoteElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ forestCursorPromoteElem @Rational+ it "works on the example from the documentation" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { 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]+ }+ }+ expected =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev =+ [ CNode 'a' $+ 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]+ }+ }+ in case forestCursorPromoteElem start of+ Nothing ->+ expectationFailure+ "forestCursorPromoteElem should not have failed."+ Just f -> f `forestShouldBe` expected+ it "promotes the current node to the level of its parent" pending+ describe "forestCursorDemoteElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ forestCursorDemoteElem @Rational+ it "works on the example from the documentation" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev =+ [CNode 'a' $ closedForest [Node 'b' []]]+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'c'+ , treeBelow = closedForest [Node 'd' []]+ }+ , nonEmptyCursorNext = [CNode 'e' emptyCForest]+ }+ }+ expected =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { 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]+ }+ }+ in case forestCursorDemoteElem start of+ Nothing ->+ expectationFailure+ "forestCursorDemoteElem should not have failed."+ Just f -> f `forestShouldBe` expected+ it "demotes the current node to the level of its children" pending+ describe "forestCursorPromoteSubTree" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ forestCursorPromoteSubTree @Rational+ it "works on the example from the documentation" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { 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]+ }+ }+ expected =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev =+ [ CNode 'a' $+ 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]+ }+ }+ in case forestCursorPromoteSubTree start of+ Nothing ->+ expectationFailure+ "forestCursorPromoteSubTree should not have failed."+ Just f -> f `forestShouldBe` expected+ it "promotes the current subtree to the level of its parent" pending+ describe "forestCursorDemoteSubTree" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ forestCursorDemoteSubTree @Rational+ it "works on the example from the documentation" $+ let start =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev =+ [CNode 'a' $ closedForest [Node 'b' []]]+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 'c'+ , treeBelow = closedForest [Node 'd' []]+ }+ , nonEmptyCursorNext = []+ }+ }+ expected =+ ForestCursor+ { forestCursorListCursor =+ NonEmptyCursor+ { nonEmptyCursorPrev = []+ , nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = [CNode 'b' emptyCForest]+ , treeAboveAbove = Nothing+ , treeAboveNode = 'a'+ , treeAboveRights = []+ }+ , treeCurrent = 'c'+ , treeBelow = closedForest [Node 'd' []]+ }+ , nonEmptyCursorNext = []+ }+ }+ in case forestCursorDemoteSubTree start of+ Nothing ->+ expectationFailure+ "forestCursorDemoteSubTree should not have failed."+ Just f -> f `forestShouldBe` expected+ it "demotes the current subtree to the level of its children" pending+ describe "forestCursorDemoteElemUnder" $ do+ it "produces valids on valids" $+ producesValidsOnValids3 $ forestCursorDemoteElemUnder @Rational @Rational+ 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+ it "demotes the current node to the level of its children" pending+ describe "forestCursorDemoteSubTreeUnder" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $+ forestCursorDemoteSubTreeUnder @Rational @Rational+ 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+ it+ "demotes the current subtree to the level of its children, by adding a root"+ pending++isMovementM ::+ (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property+isMovementM func =+ forAllValid @(SFC.ForestCursor Int) $ \lec ->+ case func lec of+ Nothing -> pure () -- Fine+ Just lec' ->+ 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'+ ]++isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property+isMovement func =+ forAllValid $ \lec ->+ rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe`+ rebuildForestCursor (func lec)++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+ ]
test/Cursor/Simple/List/NonEmptySpec.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE TypeFamilies #-} module Cursor.Simple.List.NonEmptySpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -20,170 +20,165 @@ spec :: Spec spec = do- eqSpec @(NonEmptyCursor Int)- genValidSpec @(NonEmptyCursor Double)- shrinkValidSpec @(NonEmptyCursor Double)- describe "makeNonEmptyCursor" $- it "produces valid cursors" $- producesValidsOnValids (makeNonEmptyCursor @Double)- describe "makeNonEmptyCursorWithSelection" $ do- it "produces valid cursors" $- producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Double)- it- "is the inverse of rebuildNonEmptyCursor when using the current selection" $- forAllValid $ \lec ->- makeNonEmptyCursorWithSelection- (nonEmptyCursorSelection @Double lec)- (rebuildNonEmptyCursor lec) `shouldBe`- Just lec- describe "singletonNonEmptyCursor" $- it "produces valid cursors" $- producesValidsOnValids (singletonNonEmptyCursor @Double @Double)- describe "rebuildNonEmptyCursor" $ do- it "produces valid nonempty lists" $- producesValidsOnValids (rebuildNonEmptyCursor @Double)- 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- (makeNonEmptyCursorWithSelection @Int i)- rebuildNonEmptyCursor- describe "nonEmptyCursorElemL" $- lensSpecOnValid (nonEmptyCursorElemL @Double @Double)- describe "nonEmptyCursorSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorSelectPrev @Double)- it "is a movement" $ isMovementM nonEmptyCursorSelectPrev- it "selects the previous element" pending- describe "nonEmptyCursorSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorSelectNext @Double)- it "is a movement" $ isMovementM nonEmptyCursorSelectNext- it "selects the next element" pending- describe "nonEmptyCursorSelectFirst" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorSelectFirst @Double)- it "is a movement" $ isMovement nonEmptyCursorSelectFirst- it "is idempotent" $- idempotentOnValid (nonEmptyCursorSelectFirst @Double)- it "selects the first element" pending- describe "nonEmptyCursorSelectLast" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorSelectLast @Double)- it "is a movement" $ isMovement nonEmptyCursorSelectLast- it "is idempotent" $- idempotentOnValid (nonEmptyCursorSelectLast @Double)- it "selects the last element" pending- describe "nonEmptyCursorSelection" $ do- it "produces valid ints" $- producesValidsOnValids (nonEmptyCursorSelection @Double @Double)- it "returns the index of the currently selected element" pending- describe "nonEmptyCursorSelectIndex" $ do- it "produces valid cursors" $- producesValidsOnValids2 (nonEmptyCursorSelectIndex @Double)- it "is the identity function when given the current selection" $- forAllValid $ \nec ->- nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe`- Just (nec :: NonEmptyCursor Double)- it "returns selects the element at the given index" pending- describe "nonEmptyCursorInsert" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids (nonEmptyCursorInsert @Double @Double d)- it "inserts a character before the cursor" pending- describe "nonEmptyCursorAppend" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids (nonEmptyCursorAppend @Double @Double d)- it "inserts a character after the cursor" pending- describe "nonEmptyCursorInsertAndSelect" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids (nonEmptyCursorInsertAndSelect @Double d)- it "inserts a character before the cursor and selects it" pending- describe "nonEmptyCursorAppendAndSelect" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids (nonEmptyCursorAppendAndSelect @Double d)- it "appends a character before the cursor and selects it" pending- describe "nonEmptyCursorInsertAtStart" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids- (nonEmptyCursorInsertAtStart @Double @Double d)- it "inserts a character at the start of the list" pending- describe "nonEmptyCursorAppendAtEnd" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids- (nonEmptyCursorAppendAtEnd @Double @Double d)- it "inserts a character at the end of the list" pending- describe "nonEmptyCursorInsertAtStartAndSelect" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids- (nonEmptyCursorInsertAtStartAndSelect @Double 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 @Double d)- it "appends a character at the end of the list and selects it" pending- describe "nonEmptyCursorRemoveElem" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorRemoveElem @Double)- it "removes an element" pending- describe "nonEmptyCursorDeleteElem" $ do- it "produces valid cursors" $- producesValidsOnValids (nonEmptyCursorDeleteElem @Double)- describe "nonEmptyCursorSearch" $ do- it "produces valid cursors when looking for an equal element" $- forAllValid $ \a ->- producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Double))- 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 :: Double)) 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 :: Double)) nec of- Nothing ->- expectationFailure- "Should not have failed to find the element."- Just e -> nonEmptyCursorCurrent e `shouldBe` a- describe "nonEmptyCursorSelectOrAdd" $ do- it "produces valid cursors when looking for an equal element" $- forAllValid $ \a ->- producesValidsOnValids $- nonEmptyCursorSelectOrAdd (== a) (a :: Double)+ eqSpec @(NonEmptyCursor Int)+ genValidSpec @(NonEmptyCursor Rational)+ shrinkValidSpec @(NonEmptyCursor Rational)+ describe "makeNonEmptyCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (makeNonEmptyCursor @Rational)+ describe "makeNonEmptyCursorWithSelection" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Rational)+ it+ "is the inverse of rebuildNonEmptyCursor when using the current selection" $+ forAllValid $ \lec ->+ makeNonEmptyCursorWithSelection+ (nonEmptyCursorSelection @Rational lec)+ (rebuildNonEmptyCursor lec) `shouldBe`+ Just lec+ describe "singletonNonEmptyCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (singletonNonEmptyCursor @Rational @Rational)+ describe "rebuildNonEmptyCursor" $ do+ it "produces valid nonempty lists" $+ producesValidsOnValids (rebuildNonEmptyCursor @Rational)+ 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+ (makeNonEmptyCursorWithSelection @Int i)+ rebuildNonEmptyCursor+ describe "nonEmptyCursorElemL" $+ lensSpecOnValid (nonEmptyCursorElemL @Rational @Rational)+ describe "nonEmptyCursorSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorSelectPrev @Rational)+ it "is a movement" $ isMovementM nonEmptyCursorSelectPrev+ it "selects the previous element" pending+ describe "nonEmptyCursorSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorSelectNext @Rational)+ it "is a movement" $ isMovementM nonEmptyCursorSelectNext+ it "selects the next element" pending+ describe "nonEmptyCursorSelectFirst" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorSelectFirst @Rational)+ it "is a movement" $ isMovement nonEmptyCursorSelectFirst+ it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Rational)+ it "selects the first element" pending+ describe "nonEmptyCursorSelectLast" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorSelectLast @Rational)+ it "is a movement" $ isMovement nonEmptyCursorSelectLast+ it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Rational)+ it "selects the last element" pending+ describe "nonEmptyCursorSelection" $ do+ it "produces valid ints" $+ producesValidsOnValids (nonEmptyCursorSelection @Rational @Rational)+ it "returns the index of the currently selected element" pending+ describe "nonEmptyCursorSelectIndex" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (nonEmptyCursorSelectIndex @Rational)+ it "is the identity function when given the current selection" $+ forAllValid $ \nec ->+ nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe`+ Just (nec :: NonEmptyCursor Rational)+ it "returns selects the element at the given index" pending+ describe "nonEmptyCursorInsert" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorInsert @Rational @Rational d)+ it "inserts a character before the cursor" pending+ describe "nonEmptyCursorAppend" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorAppend @Rational @Rational d)+ it "inserts a character after the cursor" pending+ describe "nonEmptyCursorInsertAndSelect" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorInsertAndSelect @Rational d)+ it "inserts a character before the cursor and selects it" pending+ describe "nonEmptyCursorAppendAndSelect" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorAppendAndSelect @Rational d)+ it "appends a character before the cursor and selects it" pending+ describe "nonEmptyCursorInsertAtStart" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids+ (nonEmptyCursorInsertAtStart @Rational @Rational d)+ it "inserts a character at the start of the list" pending+ describe "nonEmptyCursorAppendAtEnd" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorAppendAtEnd @Rational @Rational d)+ it "inserts a character at the end of the list" pending+ describe "nonEmptyCursorInsertAtStartAndSelect" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids+ (nonEmptyCursorInsertAtStartAndSelect @Rational d)+ it "inserts a character at the start of the list and selects it" pending+ describe "nonEmptyCursorAppendAtEndAndSelect" $ do+ it "produces valid cursors" $+ forAllValid $ \d ->+ producesValidsOnValids (nonEmptyCursorAppendAtEndAndSelect @Rational d)+ it "appends a character at the end of the list and selects it" pending+ describe "nonEmptyCursorRemoveElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorRemoveElem @Rational)+ it "removes an element" pending+ describe "nonEmptyCursorDeleteElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (nonEmptyCursorDeleteElem @Rational)+ describe "nonEmptyCursorSearch" $ do+ it "produces valid cursors when looking for an equal element" $+ forAllValid $ \a ->+ producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Rational))+ it+ "is indeed the right value when it finds a value and is looking for an equal element" $+ forAllValid $ \a ->+ forAllValid $ \nec ->+ case nonEmptyCursorSearch (== (a :: Rational)) nec of+ Nothing -> pure ()+ Just e -> nonEmptyCursorCurrent e `shouldBe` a+ it "finds an element if it is in there" $+ forAllValid $ \a ->+ forAll (nonEmptyWith a genValid) $ \nec ->+ case nonEmptyCursorSearch (== (a :: Rational)) nec of+ Nothing ->+ expectationFailure "Should not have failed to find the element."+ Just e -> nonEmptyCursorCurrent e `shouldBe` a+ describe "nonEmptyCursorSelectOrAdd" $ do+ it "produces valid cursors when looking for an equal element" $+ forAllValid $ \a ->+ producesValidsOnValids $+ nonEmptyCursorSelectOrAdd (== a) (a :: Rational) isMovementM ::- (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property+ (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property isMovementM func =- forAllValid $ \lec ->- case func (lec :: NonEmptyCursor Double) of- Nothing -> pure () -- Fine- Just lec' ->- 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'- ]+ forAllValid $ \lec ->+ case func (lec :: NonEmptyCursor Rational) of+ Nothing -> pure () -- Fine+ Just lec' ->+ 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'+ ] isMovement :: (forall a. NonEmptyCursor a -> NonEmptyCursor a) -> Property isMovement func =- forAllValid $ \lec ->- rebuildNonEmptyCursor (lec :: NonEmptyCursor Double) `shouldBe`- rebuildNonEmptyCursor (func lec)+ forAllValid $ \lec ->+ rebuildNonEmptyCursor (lec :: NonEmptyCursor Rational) `shouldBe`+ rebuildNonEmptyCursor (func lec)
test/Cursor/Simple/Map/KeyValueSpec.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE TypeFamilies #-} module Cursor.Simple.Map.KeyValueSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -17,37 +17,36 @@ spec :: Spec spec = do- describe "makeKeyValueCursorKey" $- it "produces valid cursors" $- producesValidsOnValids2- (makeKeyValueCursorKey @Double @Rational @Double @Rational)- describe "makeKeyValueCursorValue" $- it "produces valid cursors" $- producesValidsOnValids2- (makeKeyValueCursorValue @Double @Rational @Double @Rational)- describe "rebuildKeyValueCursor" $- it "produces valid tuples" $- producesValidsOnValids (rebuildKeyValueCursor @Double @Rational)- describe "keyValueCursorSelection" $- it "produces valid selections" $- producesValidsOnValids- (keyValueCursorSelection @Double @Rational @Double @Rational)- describe "keyValueCursorSelectKey" $ do- it "produces valid cursors" $- producesValidsOnValids (keyValueCursorSelectKey @Double @Rational)- it "is a movement" $ isMovement keyValueCursorSelectKey- describe "keyValueCursorSelectValue" $ do- it "produces valid cursors" $- producesValidsOnValids (keyValueCursorSelectValue @Double @Rational)- it "is a movement" $ isMovement keyValueCursorSelectValue- describe "keyValueCursorToggleSelected" $ do- it "produces valid cursors" $- producesValidsOnValids- (keyValueCursorToggleSelected @Double @Rational)- it "is a movement" $ isMovement keyValueCursorToggleSelected+ describe "makeKeyValueCursorKey" $+ it "produces valid cursors" $+ producesValidsOnValids2+ (makeKeyValueCursorKey @Rational @Rational @Rational @Rational)+ describe "makeKeyValueCursorValue" $+ it "produces valid cursors" $+ producesValidsOnValids2+ (makeKeyValueCursorValue @Rational @Rational @Rational @Rational)+ describe "rebuildKeyValueCursor" $+ it "produces valid tuples" $+ producesValidsOnValids (rebuildKeyValueCursor @Rational @Rational)+ describe "keyValueCursorSelection" $+ it "produces valid selections" $+ producesValidsOnValids+ (keyValueCursorSelection @Rational @Rational @Rational @Rational)+ describe "keyValueCursorSelectKey" $ do+ it "produces valid cursors" $+ producesValidsOnValids (keyValueCursorSelectKey @Rational @Rational)+ it "is a movement" $ isMovement keyValueCursorSelectKey+ describe "keyValueCursorSelectValue" $ do+ it "produces valid cursors" $+ producesValidsOnValids (keyValueCursorSelectValue @Rational @Rational)+ it "is a movement" $ isMovement keyValueCursorSelectValue+ describe "keyValueCursorToggleSelected" $ do+ it "produces valid cursors" $+ producesValidsOnValids (keyValueCursorToggleSelected @Rational @Rational)+ it "is a movement" $ isMovement keyValueCursorToggleSelected isMovement :: (forall k v. KeyValueCursor k v -> KeyValueCursor k v) -> Property isMovement func =- forAllValid $ \lec ->- rebuildKeyValueCursor (lec :: KeyValueCursor Double Rational) `shouldBe`- rebuildKeyValueCursor (func lec)+ forAllValid $ \lec ->+ rebuildKeyValueCursor (lec :: KeyValueCursor Rational Rational) `shouldBe`+ rebuildKeyValueCursor (func lec)
test/Cursor/Simple/MapSpec.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE RankNTypes #-} module Cursor.Simple.MapSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -20,151 +20,149 @@ spec :: Spec spec = do- describe "makeMapCursor" $- it "produces valid cursors" $- producesValidsOnValids (makeMapCursor @Double @Rational)- describe "makeMapCursorWithSelection" $- it "produces valid cursors" $- producesValidsOnValids2 (makeMapCursorWithSelection @Double @Rational)- describe "singletonMapCursorKey" $- it "produces valid cursors" $- producesValidsOnValids2- (singletonMapCursorKey @Double @Rational @Double @Rational)- describe "singletonMapCursorValue" $- it "produces valid cursors" $- producesValidsOnValids2- (singletonMapCursorValue @Double @Rational @Double @Rational)- describe "rebuildMapCursor" $ do- it "produces valid Nonempty lists" $- producesValidsOnValids (rebuildMapCursor @Double @Rational)- it "is the inverse of makeMapCursor for integers" $- inverseFunctions (makeMapCursor @Int @Int) rebuildMapCursor- describe "mapCursorNonEmptyCursorL" $- lensSpecOnValid- (mapCursorNonEmptyCursorL @Double @Rational @Double @Rational)- describe "mapCursorElemL" $- lensSpecOnValid (mapCursorElemL @Double @Rational @Double @Rational)- describe "mapCursorSelectKey" $- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectKey @Double @Rational)- describe "mapCursorSelectValue" $- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectValue @Double @Rational)- describe "mapCursorToggleSelected" $- it "produces valid cursors" $- producesValidsOnValids (mapCursorToggleSelected @Double @Rational)- describe "mapCursorSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectPrev @Double @Rational)- it "is a movement" $ isMovementM mapCursorSelectPrev- it "selects the previous element" pending- describe "mapCursorSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectNext @Double @Rational)- it "is a movement" $ isMovementM mapCursorSelectNext- it "selects the next element" pending- describe "mapCursorSelectFirst" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectFirst @Double @Rational)- it "is a movement" $ isMovement mapCursorSelectFirst- it "is idempotent" $- idempotentOnValid (mapCursorSelectFirst @Double @Rational)- it "selects the first element" pending- describe "mapCursorSelectLast" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorSelectLast @Double @Rational)- it "is a movement" $ isMovement mapCursorSelectLast- it "is idempotent" $- idempotentOnValid (mapCursorSelectLast @Double @Rational)- it "selects the last element" pending- describe "mapCursorSelection" $ do- it "produces valid ints" $- producesValidsOnValids- (mapCursorSelection @Double @Rational @Double @Rational)- it "returns the index of the currently selected element" pending- describe "mapCursorSelectIndex" $ do- it "produces valid cursors" $- producesValidsOnValids2 (mapCursorSelectIndex @Double @Rational)- it "is the identity function when given the current selection" $- forAllValid $ \nec ->- mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe`- Just (nec :: MapCursor Double Rational)- it "returns selects the element at the given index" pending- describe "mapCursorInsert" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorInsert @Double @Rational @Double @Rational)- it "inserts a character before the cursor" pending- describe "mapCursorAppend" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorAppend @Double @Rational @Double @Rational)- it "inserts a character after the cursor" pending- describe "mapCursorInsertAndSelectKey" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorInsertAndSelectKey @Double @Rational)- describe "mapCursorAppendAndSelectKey" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorAppendAndSelectKey @Double @Rational)- describe "mapCursorInsertAndSelectValue" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorInsertAndSelectValue @Double @Rational)- describe "mapCursorAppendAndSelectValue" $ do- it "produces valid cursors" $- producesValidsOnValids3- (mapCursorAppendAndSelectValue @Double @Rational)- describe "mapCursorRemoveElem" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorRemoveElem @Double @Rational)- it "removes an element" pending- describe "mapCursorDeleteElem" $ do- it "produces valid cursors" $- producesValidsOnValids (mapCursorDeleteElem @Double @Rational)- it "deletes an element" pending- describe "mapCursorSearch" $ do- it "produces valid cursors when looking for an equal pair" $- forAllValid $ \(k, v) ->- producesValidsOnValids $- mapCursorSearch @Double @Rational (\k_ v_ -> k_ == k && v_ == v)- it- "is indeed the right value when it finds a value and is looking for an equal element" $- forAllValid $ \(k, v) ->- forAllValid $ \nec ->- case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of- Nothing -> pure ()- Just e ->- rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe`- (k :: Double, v :: Rational)- describe "mapCursorSelectOrAdd" $ do- it "produces valid cursors when looking for an equal element" $- forAllValid $ \(k, v) ->- producesValidsOnValids $- mapCursorSelectOrAdd- (\k_ v_ -> k_ == k && v_ == v)- (makeKeyValueCursorKey (k :: Double) (v :: Rational))+ describe "makeMapCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (makeMapCursor @Rational @Rational)+ describe "makeMapCursorWithSelection" $+ it "produces valid cursors" $+ producesValidsOnValids2 (makeMapCursorWithSelection @Rational @Rational)+ describe "singletonMapCursorKey" $+ it "produces valid cursors" $+ producesValidsOnValids2+ (singletonMapCursorKey @Rational @Rational @Rational @Rational)+ describe "singletonMapCursorValue" $+ it "produces valid cursors" $+ producesValidsOnValids2+ (singletonMapCursorValue @Rational @Rational @Rational @Rational)+ describe "rebuildMapCursor" $ do+ it "produces valid Nonempty lists" $+ producesValidsOnValids (rebuildMapCursor @Rational @Rational)+ it "is the inverse of makeMapCursor for integers" $+ inverseFunctions (makeMapCursor @Int @Int) rebuildMapCursor+ describe "mapCursorNonEmptyCursorL" $+ lensSpecOnValid+ (mapCursorNonEmptyCursorL @Rational @Rational @Rational @Rational)+ describe "mapCursorElemL" $+ lensSpecOnValid (mapCursorElemL @Rational @Rational @Rational @Rational)+ describe "mapCursorSelectKey" $+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectKey @Rational @Rational)+ describe "mapCursorSelectValue" $+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectValue @Rational @Rational)+ describe "mapCursorToggleSelected" $+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorToggleSelected @Rational @Rational)+ describe "mapCursorSelectPrev" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectPrev @Rational @Rational)+ it "is a movement" $ isMovementM mapCursorSelectPrev+ it "selects the previous element" pending+ describe "mapCursorSelectNext" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectNext @Rational @Rational)+ it "is a movement" $ isMovementM mapCursorSelectNext+ it "selects the next element" pending+ describe "mapCursorSelectFirst" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectFirst @Rational @Rational)+ it "is a movement" $ isMovement mapCursorSelectFirst+ it "is idempotent" $+ idempotentOnValid (mapCursorSelectFirst @Rational @Rational)+ it "selects the first element" pending+ describe "mapCursorSelectLast" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorSelectLast @Rational @Rational)+ it "is a movement" $ isMovement mapCursorSelectLast+ it "is idempotent" $+ idempotentOnValid (mapCursorSelectLast @Rational @Rational)+ it "selects the last element" pending+ describe "mapCursorSelection" $ do+ it "produces valid ints" $+ producesValidsOnValids+ (mapCursorSelection @Rational @Rational @Rational @Rational)+ it "returns the index of the currently selected element" pending+ describe "mapCursorSelectIndex" $ do+ it "produces valid cursors" $+ producesValidsOnValids2 (mapCursorSelectIndex @Rational @Rational)+ it "is the identity function when given the current selection" $+ forAllValid $ \nec ->+ mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe`+ Just (nec :: MapCursor Rational Rational)+ it "returns selects the element at the given index" pending+ describe "mapCursorInsert" $ do+ it "produces valid cursors" $+ producesValidsOnValids3+ (mapCursorInsert @Rational @Rational @Rational @Rational)+ it "inserts a character before the cursor" pending+ describe "mapCursorAppend" $ do+ it "produces valid cursors" $+ producesValidsOnValids3+ (mapCursorAppend @Rational @Rational @Rational @Rational)+ it "inserts a character after the cursor" pending+ describe "mapCursorInsertAndSelectKey" $ do+ it "produces valid cursors" $+ producesValidsOnValids3 (mapCursorInsertAndSelectKey @Rational @Rational)+ describe "mapCursorAppendAndSelectKey" $ do+ it "produces valid cursors" $+ producesValidsOnValids3 (mapCursorAppendAndSelectKey @Rational @Rational)+ describe "mapCursorInsertAndSelectValue" $ do+ it "produces valid cursors" $+ producesValidsOnValids3+ (mapCursorInsertAndSelectValue @Rational @Rational)+ describe "mapCursorAppendAndSelectValue" $ do+ it "produces valid cursors" $+ producesValidsOnValids3+ (mapCursorAppendAndSelectValue @Rational @Rational)+ describe "mapCursorRemoveElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorRemoveElem @Rational @Rational)+ it "removes an element" pending+ describe "mapCursorDeleteElem" $ do+ it "produces valid cursors" $+ producesValidsOnValids (mapCursorDeleteElem @Rational @Rational)+ it "deletes an element" pending+ describe "mapCursorSearch" $ do+ it "produces valid cursors when looking for an equal pair" $+ forAllValid $ \(k, v) ->+ producesValidsOnValids $+ mapCursorSearch @Rational @Rational (\k_ v_ -> k_ == k && v_ == v)+ it+ "is indeed the right value when it finds a value and is looking for an equal element" $+ forAllValid $ \(k, v) ->+ forAllValid $ \nec ->+ case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of+ Nothing -> pure ()+ Just e ->+ rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe`+ (k :: Rational, v :: Rational)+ describe "mapCursorSelectOrAdd" $ do+ it "produces valid cursors when looking for an equal element" $+ forAllValid $ \(k, v) ->+ producesValidsOnValids $+ mapCursorSelectOrAdd+ (\k_ v_ -> k_ == k && v_ == v)+ (makeKeyValueCursorKey (k :: Rational) (v :: Rational)) isMovementM :: (forall k v. MapCursor k v -> Maybe (MapCursor k v)) -> Property isMovementM func =- forAllValid $ \lec ->- case func (lec :: MapCursor Double Double) of- Nothing -> pure () -- Fine- Just lec' ->- 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'- ]+ forAllValid $ \lec ->+ case func (lec :: MapCursor Rational Rational) of+ Nothing -> pure () -- Fine+ Just lec' ->+ 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'+ ] isMovement :: (forall k v. MapCursor k v -> MapCursor k v) -> Property isMovement func =- forAllValid $ \lec ->- rebuildMapCursor (lec :: MapCursor Int Int) `shouldBe`- rebuildMapCursor (func lec)+ forAllValid $ \lec ->+ rebuildMapCursor (lec :: MapCursor Int Int) `shouldBe`+ rebuildMapCursor (func lec)
test/Cursor/Simple/Tree/BaseSpec.hs view
@@ -5,9 +5,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Simple.Tree.BaseSpec- ( spec- ) where-+ ( spec+ ) where import Test.Hspec @@ -21,30 +20,29 @@ spec :: Spec spec = do- eqSpec @(STC.TreeCursor Int)- genValidSpec @(STC.TreeCursor Double)- describe "makeTreeCursor" $- it "produces valid cursors" $- producesValidsOnValids (makeTreeCursor @Double)- describe "makeTreeCursorWithSelection" $- it "produces valid cursors" $- producesValidsOnValids2 (makeTreeCursorWithSelection @Double)- describe "singletonTreeCursor" $- it "produces valid cursors" $- producesValidsOnValids (singletonTreeCursor @Double)- describe "rebuildTreeCursor" $ do- it "produces valid trees" $- producesValidsOnValids (rebuildTreeCursor @Double)- 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- @Double- (treeCursorSelection tc)- (rebuildTreeCursor tc) of- Nothing ->- expectationFailure- "makeTreeCursorWithSelection should not have failed."- Just r -> r `treeShouldBe` tc+ eqSpec @(STC.TreeCursor Int)+ genValidSpec @(STC.TreeCursor Rational)+ describe "makeTreeCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (makeTreeCursor @Rational)+ describe "makeTreeCursorWithSelection" $+ it "produces valid cursors" $+ producesValidsOnValids2 (makeTreeCursorWithSelection @Rational)+ describe "singletonTreeCursor" $+ it "produces valid cursors" $+ producesValidsOnValids (singletonTreeCursor @Rational)+ describe "rebuildTreeCursor" $ do+ it "produces valid trees" $+ producesValidsOnValids (rebuildTreeCursor @Rational)+ it "is the inverse of makeTreeCursor for integers" $+ inverseFunctions (makeTreeCursor @Int) rebuildTreeCursor+ it "is the inverse of makeTreeCursorWithSelection for the current selection" $+ forAllValid $ \tc ->+ case makeTreeCursorWithSelection+ @Rational+ (treeCursorSelection tc)+ (rebuildTreeCursor tc) of+ Nothing ->+ expectationFailure+ "makeTreeCursorWithSelection should not have failed."+ Just r -> r `treeShouldBe` tc
test/Cursor/Simple/Tree/CollapseSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.CollapseSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -16,12 +16,20 @@ spec :: Spec spec = do- describe "treeCursorOpenCurrentForest" $- it "produces valid cursors" $- producesValidsOnValids $ treeCursorOpenCurrentForest @Double @Double- describe "treeCursorCloseCurrentForest" $- it "produces valid cursors" $- producesValidsOnValids $ treeCursorCloseCurrentForest @Double @Double- describe "treeCursorToggleCurrentForest" $- it "produces valid cursors" $- producesValidsOnValids $ treeCursorToggleCurrentForest @Double @Double+ describe "treeCursorOpenCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ treeCursorOpenCurrentForest @Rational @Rational+ describe "treeCursorCloseCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ treeCursorCloseCurrentForest @Rational @Rational+ describe "treeCursorToggleCurrentForest" $+ it "produces valid cursors" $+ producesValidsOnValids $ treeCursorToggleCurrentForest @Rational @Rational+ describe "treeCursorOpenCurrentForestRecursively" $+ it "produces valid cursors" $+ producesValidsOnValids $+ treeCursorOpenCurrentForestRecursively @Double @Double+ describe "treeCursorToggleCurrentForestRecursively" $+ it "produces valid cursors" $+ producesValidsOnValids $+ treeCursorToggleCurrentForestRecursively @Double @Double
test/Cursor/Simple/Tree/DeleteSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.DeleteSpec- ( spec- ) where+ ( spec+ ) where import Data.Tree @@ -15,113 +15,102 @@ import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree- (CTree(..), TreeCursor(..), closedForest, openForest)+import Cursor.Tree (CTree(..), TreeCursor(..), closedForest, openForest) import Cursor.Types import Cursor.Simple.Tree.TestUtils spec :: Spec spec = do- describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do- it "produces valids on valids" $- producesValidsOnValids $- treeCursorDeleteSubTreeAndSelectPrevious @Double- it "deletes the current subtree selects the previous subtree" pending- describe "treeCursorDeleteSubTreeAndSelectNext" $ do- it "produces valids on valids" $- producesValidsOnValids $- treeCursorDeleteSubTreeAndSelectNext @Double- it "deletes the current subtree selects the next subtree" pending- describe "treeCursorDeleteSubTreeAndSelectAbove" $ do- it "produces valids on valids" $- producesValidsOnValids $- treeCursorDeleteSubTreeAndSelectAbove @Double- it "deletes the current subtree selects the above node" pending- describe "treeCursorRemoveSubTree" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorRemoveSubTree @Double- it "removes the current subtree" pending- describe "treeCursorDeleteSubTree" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorDeleteSubTree @Double- it "deletes the current subtree" pending- describe "treeCursorDeleteElemAndSelectPrevious" $ do- it "produces valids on valids" $- producesValidsOnValids $- treeCursorDeleteElemAndSelectPrevious @Double- 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."- it- "deletes the current element and selects the previous element"- pending- describe "treeCursorDeleteElemAndSelectNext" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Double- 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- it "deletes the current element and selects the next element" pending- describe "treeCursorDeleteElemAndSelectAbove" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Double- it "works for this simple example" $- forAllValid $ \fs ->- let simpleDeleteElemStart =- TreeCursor- { treeAbove = Nothing- , treeCurrent = 1 :: Int- , treeBelow = closedForest [Node 2 fs]- }- in case treeCursorDeleteElemAndSelectAbove simpleDeleteElemStart of- Nothing -> pure ()- Just Deleted ->- expectationFailure- "treeCursorDeleteElemAndSelectAbove should not have deleted the entire example tree."- Just (Updated _) ->- expectationFailure- "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 @Double- it "removes the current element" pending- describe "treeCursorDeleteElem" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorDeleteElem @Double- it "deletes the current element" pending+ describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do+ it "produces valids on valids" $+ producesValidsOnValids $+ treeCursorDeleteSubTreeAndSelectPrevious @Rational+ it "deletes the current subtree selects the previous subtree" pending+ describe "treeCursorDeleteSubTreeAndSelectNext" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Rational+ it "deletes the current subtree selects the next subtree" pending+ describe "treeCursorDeleteSubTreeAndSelectAbove" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Rational+ it "deletes the current subtree selects the above node" pending+ describe "treeCursorRemoveSubTree" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorRemoveSubTree @Rational+ it "removes the current subtree" pending+ describe "treeCursorDeleteSubTree" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteSubTree @Rational+ it "deletes the current subtree" pending+ describe "treeCursorDeleteElemAndSelectPrevious" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Rational+ 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."+ it "deletes the current element and selects the previous element" pending+ describe "treeCursorDeleteElemAndSelectNext" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Rational+ 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+ it "deletes the current element and selects the next element" pending+ describe "treeCursorDeleteElemAndSelectAbove" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Rational+ it "works for this simple example" $+ forAllValid $ \fs ->+ let simpleDeleteElemStart =+ TreeCursor+ { treeAbove = Nothing+ , treeCurrent = 1 :: Int+ , treeBelow = closedForest [Node 2 fs]+ }+ in case treeCursorDeleteElemAndSelectAbove simpleDeleteElemStart of+ Nothing -> pure ()+ Just Deleted ->+ expectationFailure+ "treeCursorDeleteElemAndSelectAbove should not have deleted the entire example tree."+ Just (Updated _) ->+ expectationFailure+ "treeCursorDeleteElemAndSelectAbove should not have updated the example tree, but failed instead."+ it "deletes the current element and selects the above element" pending+ describe "treeCursorRemoveElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorRemoveElem @Rational+ it "removes the current element" pending+ describe "treeCursorDeleteElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDeleteElem @Rational+ it "deletes the current element" pending
test/Cursor/Simple/Tree/DemoteSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.DemoteSpec- ( spec- ) where+ ( spec+ ) where import Data.Tree @@ -15,173 +15,168 @@ import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen ()-import Cursor.Tree- (TreeAbove(..), TreeCursor(..), closedForest, emptyCForest)+import Cursor.Tree (TreeAbove(..), TreeCursor(..), closedForest, emptyCForest) import Cursor.Simple.Tree.TestUtils spec :: Spec spec = do- functorSpec @DemoteResult- describe "treeCursorDemoteElem" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorDemoteElem @Double- it "Works on the example from the docs" $- let promoteStart =- TreeCursor- { treeAbove =+ functorSpec @DemoteResult+ describe "treeCursorDemoteElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorDemoteElem @Rational+ 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' []]+ }+ promoteEnd =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = [node 'b' []]+ , treeAboveAbove = Just- TreeAbove- { treeAboveLefts = [node 'a' [node 'b' []]]+ TreeAbove+ { treeAboveLefts = [] , treeAboveAbove = Nothing , treeAboveNode = 'p' , treeAboveRights = [node 'e' []] }- , treeCurrent = 'c'- , treeBelow = closedForest [Node 'd' []]- }- promoteEnd =- TreeCursor- { treeAbove =- Just- TreeAbove- { treeAboveLefts = [node 'b' []]- , treeAboveAbove =- Just- TreeAbove- { 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 @Double- it "Works on the example from the docs" $- let promoteStart =- TreeCursor- { treeAbove =+ , 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 @Rational+ 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' []]+ }+ promoteEnd =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = [node 'b' []]+ , treeAboveAbove = Just- TreeAbove- { treeAboveLefts = [node 'a' [node 'b' []]]+ TreeAbove+ { treeAboveLefts = [] , treeAboveAbove = Nothing , treeAboveNode = 'p' , treeAboveRights = [node 'e' []] }- , treeCurrent = 'c'- , treeBelow = closedForest [Node 'd' []]- }- promoteEnd =- TreeCursor- { treeAbove =- Just- TreeAbove- { treeAboveLefts = [node 'b' []]- , treeAboveAbove =- Just- TreeAbove- { 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 @Double @Double- it "Works on the example from the docs" $- 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" $- producesValidsOnValids2 $- treeCursorDemoteSubTreeUnder @Double @Double- 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 =+ , 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 @Rational @Rational+ it "Works on the example from the docs" $+ 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+ TreeAbove { treeAboveLefts = [] , treeAboveAbove = Nothing- , treeAboveNode = v- , treeAboveRights = []+ , treeAboveNode = 'p'+ , treeAboveRights = [node b2 [node 'b' []]] }- , treeCurrent = 'a'- , treeBelow = closedForest [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" $+ producesValidsOnValids2 $ treeCursorDemoteSubTreeUnder @Rational @Rational+ 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 = [] }- treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe`- demoteEnd- it- "demotes the current subtree to the level of its children, by adding a root"- pending+ , treeCurrent = 'a'+ , treeBelow = closedForest [Node 'b' []]+ }+ treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe` demoteEnd+ it+ "demotes the current subtree to the level of its children, by adding a root"+ pending
test/Cursor/Simple/Tree/InsertSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.InsertSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -16,35 +16,33 @@ spec :: Spec spec = do- describe "treeCursorInsert" $ do- it "produces valids on valids" $- producesValidsOnValids2 $ treeCursorInsert @Double @Double- it "inserts the element" pending- describe "treeCursorInsertAndSelect" $ do- it "produces valids on valids" $- producesValidsOnValids2 $ treeCursorInsertAndSelect @Double- it "inserts and select the element" pending- describe "treeCursorAppend" $ do- it "produces valids on valids" $- producesValidsOnValids2 $ treeCursorAppend @Double @Double- it "appends the element" pending- describe "treeCursorAppendAndSelect" $ do- it "produces valids on valids" $- producesValidsOnValids2 $ treeCursorAppendAndSelect @Double- it "appends and select the element" pending- describe "treeCursorAddChildAtPos" $ do- it "produces valid cursors " $- producesValidsOnValids3 $ treeCursorAddChildAtPos @Double @Double- 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 @Double @Double- it- "adds a tree at the start of the children of the current node"- pending- describe "treeCursorAddChildAtEnd" $ do- it "produces valid cursors " $- producesValidsOnValids2 $ treeCursorAddChildAtEnd @Double @Double- it "adds a tree at the end of the children of the current node" pending+ describe "treeCursorInsert" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $ treeCursorInsert @Rational @Rational+ it "inserts the element" pending+ describe "treeCursorInsertAndSelect" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $ treeCursorInsertAndSelect @Rational+ it "inserts and select the element" pending+ describe "treeCursorAppend" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $ treeCursorAppend @Rational @Rational+ it "appends the element" pending+ describe "treeCursorAppendAndSelect" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $ treeCursorAppendAndSelect @Rational+ it "appends and select the element" pending+ describe "treeCursorAddChildAtPos" $ do+ it "produces valid cursors " $+ producesValidsOnValids3 $ treeCursorAddChildAtPos @Rational @Rational+ it+ "adds a tree at the given index in the children of the current node"+ pending+ describe "treeCursorAddChildAtStart" $ do+ it "produces valid cursors " $+ producesValidsOnValids2 $ treeCursorAddChildAtStart @Rational @Rational+ it "adds a tree at the start of the children of the current node" pending+ describe "treeCursorAddChildAtEnd" $ do+ it "produces valid cursors " $+ producesValidsOnValids2 $ treeCursorAddChildAtEnd @Rational @Rational+ it "adds a tree at the end of the children of the current node" pending
test/Cursor/Simple/Tree/MovementSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.MovementSpec- ( spec- ) where+ ( spec+ ) where import Control.Monad (unless) @@ -18,268 +18,258 @@ import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen () import Cursor.Tree- (CTree(..), TreeAbove(..), TreeCursor(..), emptyCForest,- openForest)+ ( CTree(..)+ , TreeAbove(..)+ , TreeCursor(..)+ , emptyCForest+ , openForest+ ) import Cursor.Simple.Tree.TestUtils spec :: Spec spec = do- describe "treeCursorSelection" $- it "produces valids on valids" $- producesValidsOnValids (treeCursorSelection @Double @Double)- describe "treeCursorSelect" $ do- it "produces valids on valids" $- producesValidsOnValids2 (treeCursorSelect @Double)- it "is identity with the current selection" $- forAllValid $ \tc ->- let sel = treeCursorSelection tc- in case treeCursorSelect @Double 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" $ do- inverseFunctionsIfSucceedOnValid- (treeCursorSelectNextOnSameLevel @Double)- (treeCursorSelectPrevOnSameLevel @Double)- describe "treeCursorSelectNextOnSameLevel" $ do- testMovementM treeCursorSelectNextOnSameLevel- it "selects the next element" pending- it- "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ do- inverseFunctionsIfSucceedOnValid- (treeCursorSelectPrevOnSameLevel @Double)- (treeCursorSelectNextOnSameLevel @Double)- describe "treeCursorSelectAbovePrev" $ do- testMovementM treeCursorSelectAbovePrev- it "Works for this classic example" $+ describe "treeCursorSelection" $+ it "produces valids on valids" $+ producesValidsOnValids (treeCursorSelection @Rational @Rational)+ describe "treeCursorSelect" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 (treeCursorSelect @Rational)+ it "is identity with the current selection" $+ forAllValid $ \tc ->+ let sel = treeCursorSelection tc+ in case treeCursorSelect @Rational sel tc of+ Nothing ->+ expectationFailure "treeCursorSelect should not have failed."+ 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" $ do+ inverseFunctionsIfSucceedOnValid+ (treeCursorSelectNextOnSameLevel @Rational)+ (treeCursorSelectPrevOnSameLevel @Rational)+ describe "treeCursorSelectNextOnSameLevel" $ do+ testMovementM treeCursorSelectNextOnSameLevel+ it "selects the next element" pending+ it "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ do+ inverseFunctionsIfSucceedOnValid+ (treeCursorSelectPrevOnSameLevel @Rational)+ (treeCursorSelectNextOnSameLevel @Rational)+ 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- it "selects the previous element" pending- it "after treeCursorSelectAboveNext is identity if they don't fail" $ do- forAllValid $ \tc ->- case treeCursorSelectAboveNext @Double 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" $+ 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" $ do+ forAllValid $ \tc ->+ case treeCursorSelectAboveNext @Rational 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- it "selects the next element" pending- it "after treeCursorSelectAbovePrev is identity if they don't fail" $ do- forAllValid $ \tc ->- case treeCursorSelectAbovePrev @Double 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" $ do- inverseFunctionsIfSucceedOnValid- (treeCursorSelectNext @Double)- (treeCursorSelectPrev @Double)- describe "treeCursorSelectNext" $ do- testMovementM treeCursorSelectNext- it "selects the next element" pending- it "after treeCursorSelectPrev is identity if they don't fail" $ do- inverseFunctionsIfSucceedOnValid- (treeCursorSelectPrev @Double)- (treeCursorSelectNext @Double)- describe "treeCursorSelectFirst" $ do- testMovement treeCursorSelectFirst- it "selects the first element" pending- it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Double- describe "treeCursorSelectLast" $ do- testMovement treeCursorSelectLast- it "selects the last element" pending- it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Double- describe "treeCursorSelectAbove" $ do- testMovementM treeCursorSelectAbove- it "selects the element above" pending- it "after treeCursorSelectBelow is identity if they don't fail" $ do- inverseFunctionsIfSucceedOnValid- (treeCursorSelectBelowAtStart @Double) $- treeCursorSelectAbove @Double- describe "treeCursorSelectBelowAtPos" $ do- it "produces valids on valids" $- producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Double- it "is a movement" $- forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n- it "selects the element n-th below" pending- describe "treeCursorSelectBelowAtStart" $ do- testMovementM treeCursorSelectBelowAtStart- it "selects the first child below" pending- describe "treeCursorSelectBelowAtEnd" $ do- testMovementM treeCursorSelectBelowAtEnd- it "selects the last child below" pending- describe "treeCursorSelectBelowAtStartRecursively" $ do- testMovementM treeCursorSelectBelowAtStartRecursively- it "selects the first child below, recursively" pending- describe "treeCursorSelectBelowAtEndRecursively" $ do- testMovementM treeCursorSelectBelowAtEndRecursively- it "selects the last child below, recursively" pending+ 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" $ do+ forAllValid $ \tc ->+ case treeCursorSelectAbovePrev @Rational 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" $ do+ inverseFunctionsIfSucceedOnValid+ (treeCursorSelectNext @Rational)+ (treeCursorSelectPrev @Rational)+ describe "treeCursorSelectNext" $ do+ testMovementM treeCursorSelectNext+ it "selects the next element" pending+ it "after treeCursorSelectPrev is identity if they don't fail" $ do+ inverseFunctionsIfSucceedOnValid+ (treeCursorSelectPrev @Rational)+ (treeCursorSelectNext @Rational)+ describe "treeCursorSelectFirst" $ do+ testMovement treeCursorSelectFirst+ it "selects the first element" pending+ it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Rational+ describe "treeCursorSelectLast" $ do+ testMovement treeCursorSelectLast+ it "selects the last element" pending+ it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Rational+ describe "treeCursorSelectAbove" $ do+ testMovementM treeCursorSelectAbove+ it "selects the element above" pending+ it "after treeCursorSelectBelow is identity if they don't fail" $ do+ inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Rational) $+ treeCursorSelectAbove @Rational+ describe "treeCursorSelectBelowAtPos" $ do+ it "produces valids on valids" $+ producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Rational+ it "is a movement" $+ forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n+ it "selects the element n-th below" pending+ describe "treeCursorSelectBelowAtStart" $ do+ testMovementM treeCursorSelectBelowAtStart+ it "selects the first child below" pending+ describe "treeCursorSelectBelowAtEnd" $ do+ testMovementM treeCursorSelectBelowAtEnd+ it "selects the last child below" pending+ describe "treeCursorSelectBelowAtStartRecursively" $ do+ testMovementM treeCursorSelectBelowAtStartRecursively+ it "selects the first child below, recursively" pending+ describe "treeCursorSelectBelowAtEndRecursively" $ do+ testMovementM treeCursorSelectBelowAtEndRecursively+ it "selects the last child below, recursively" pending
test/Cursor/Simple/Tree/PromoteSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.PromoteSpec- ( spec- ) where+ ( spec+ ) where import Data.Tree @@ -16,123 +16,124 @@ import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen () import Cursor.Tree- ( CTree(..), TreeAbove(..), TreeCursor(..),- closedForest, emptyCForest, openForest)+ ( CTree(..)+ , TreeAbove(..)+ , TreeCursor(..)+ , closedForest+ , emptyCForest+ , openForest+ ) import Cursor.Simple.Tree.TestUtils spec :: Spec spec = do- functorSpec @PromoteElemResult- applicativeSpec @PromoteElemResult- monadSpec @PromoteElemResult- describe "treeCursorPromoteElem" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorPromoteElem @Double- it "Works on the example from the docs" $- let promoteStart =- TreeCursor- { treeAbove =- Just- TreeAbove- { 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' []]- }- promoteEnd =- TreeCursor- { treeAbove =+ functorSpec @PromoteElemResult+ applicativeSpec @PromoteElemResult+ monadSpec @PromoteElemResult+ describe "treeCursorPromoteElem" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorPromoteElem @Rational+ it "Works on the example from the docs" $+ let promoteStart =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = [node 'b' [node 'c' []]]+ , treeAboveAbove = Just- TreeAbove- { treeAboveLefts =- [ CNode 'a' $- openForest- [ CNode 'b' $- openForest- [ CNode 'c' emptyCForest- , CNode 'e' emptyCForest- ]- , CNode 'f' $- closedForest [Node 'g' []]- ]- ]+ TreeAbove+ { treeAboveLefts = [] , treeAboveAbove = Nothing , treeAboveNode = 'p'- , treeAboveRights = [CNode 'h' emptyCForest]- }- , treeCurrent = 'd'- , treeBelow = emptyCForest- }- in case treeCursorPromoteElem promoteStart of- PromotedElem tc' -> tc' `treeShouldBe` promoteEnd- _ ->- expectationFailure- "treeCursorPromoteElem should not have failed"- it "promotes the current node to the level of its parent" pending- functorSpec @PromoteResult- applicativeSpec @PromoteResult- monadSpec @PromoteResult- describe "treeCursorPromoteSubTree" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorPromoteSubTree @Double- it "Works on the example from the docs" $- let promoteStart =- TreeCursor- { treeAbove =- Just- TreeAbove- { 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' []]]+ , treeAboveRights = [node 'h' []] }- , treeCurrent = 'd'- , treeBelow = closedForest [Node 'e' []]- }- promoteEnd =- TreeCursor- { treeAbove =+ , treeAboveNode = 'a'+ , treeAboveRights = [node 'f' [node 'g' []]]+ }+ , treeCurrent = 'd'+ , treeBelow = closedForest [Node 'e' []]+ }+ promoteEnd =+ TreeCursor+ { treeAbove =+ Just+ 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+ }+ in case treeCursorPromoteElem promoteStart of+ PromotedElem tc' -> tc' `treeShouldBe` promoteEnd+ _ ->+ expectationFailure "treeCursorPromoteElem should not have failed"+ it "promotes the current node to the level of its parent" pending+ functorSpec @PromoteResult+ applicativeSpec @PromoteResult+ monadSpec @PromoteResult+ describe "treeCursorPromoteSubTree" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorPromoteSubTree @Rational+ it "Works on the example from the docs" $+ let promoteStart =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts =+ [CNode 'b' $ closedForest [Node 'c' []]]+ , treeAboveAbove = Just- TreeAbove- { treeAboveLefts =- [ CNode 'a' $- openForest- [ CNode 'b' $- closedForest [Node 'c' []]- , CNode 'f' $- closedForest [Node 'g' []]- ]- ]+ TreeAbove+ { treeAboveLefts = [] , treeAboveAbove = Nothing , treeAboveNode = 'p'- , treeAboveRights = [CNode 'h' $ closedForest []]+ , treeAboveRights = [node 'h' []] }- , treeCurrent = 'd'- , treeBelow = closedForest [Node 'e' []]- }- in case treeCursorPromoteSubTree promoteStart of- Promoted tc' -> tc' `treeShouldBe` promoteEnd- _ ->- expectationFailure- "treeCursorPromoteSubTree should not have failed"- it "promotes the current subtree to the level of its parent" pending+ , treeAboveNode = 'a'+ , treeAboveRights =+ [CNode 'f' $ closedForest [Node 'g' []]]+ }+ , treeCurrent = 'd'+ , treeBelow = closedForest [Node 'e' []]+ }+ promoteEnd =+ TreeCursor+ { treeAbove =+ Just+ 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' []]+ }+ in case treeCursorPromoteSubTree promoteStart of+ Promoted tc' -> tc' `treeShouldBe` promoteEnd+ _ ->+ expectationFailure+ "treeCursorPromoteSubTree should not have failed"+ it "promotes the current subtree to the level of its parent" pending
test/Cursor/Simple/Tree/SwapSpec.hs view
@@ -4,8 +4,8 @@ {-# LANGUAGE ScopedTypeVariables #-} module Cursor.Simple.Tree.SwapSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -19,84 +19,80 @@ spec :: Spec spec = do- functorSpec @SwapResult- describe "treeCursorSwapPrev" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorSwapPrev @Double @Double- 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- }- end =- TreeCursor- { treeAbove =- Just- TreeAbove- { 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- (treeCursorSwapNext @Double @Double)- (treeCursorSwapPrev @Double @Double)- it "swaps the current node with the previous node" pending- describe "treeCursorSwapNext" $ do- it "produces valids on valids" $- producesValidsOnValids $ treeCursorSwapNext @Double @Double- 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- }- end =- TreeCursor- { treeAbove =- Just- TreeAbove- { 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- (treeCursorSwapPrev @Double @Double)- (treeCursorSwapNext @Double @Double)- it "swaps the current node with the next node" pending+ functorSpec @SwapResult+ describe "treeCursorSwapPrev" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorSwapPrev @Rational @Rational+ 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+ }+ end =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { 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+ (treeCursorSwapNext @Rational @Rational)+ (treeCursorSwapPrev @Rational @Rational)+ it "swaps the current node with the previous node" pending+ describe "treeCursorSwapNext" $ do+ it "produces valids on valids" $+ producesValidsOnValids $ treeCursorSwapNext @Rational @Rational+ 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+ }+ end =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { 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+ (treeCursorSwapPrev @Rational @Rational)+ (treeCursorSwapNext @Rational @Rational)+ it "swaps the current node with the next node" pending
test/Cursor/Simple/Tree/TestUtils.hs view
@@ -22,57 +22,57 @@ testMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Spec testMovement func = do- it "produces valids on valids" $ producesValidsOnValids $ func @Double- it "is a movement" $ isMovement func+ it "produces valids on valids" $ producesValidsOnValids $ func @Rational+ it "is a movement" $ isMovement func testMovementM ::- (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec+ (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec testMovementM func = do- it "produces valids on valids" $ producesValidsOnValids $ func @Double- it "is a movement" $ isMovementM func+ it "produces valids on valids" $ producesValidsOnValids $ func @Rational+ it "is a movement" $ isMovementM func isMovementM ::- (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property+ (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property isMovementM func =- forAllValid @(STC.TreeCursor Int) $ \lec ->- case func lec of- Nothing -> pure () -- Fine- Just lec' ->- 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')- ]+ forAllValid @(STC.TreeCursor Int) $ \lec ->+ case func lec of+ Nothing -> pure () -- Fine+ Just lec' ->+ 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')+ ] isMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Property isMovement func =- forAllValid $ \lec ->- rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe`- rebuildTreeCursor (func lec)+ forAllValid $ \lec ->+ rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe`+ rebuildTreeCursor (func lec) treeShouldBe ::- (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation+ (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- ]+ unless (actual == expected) $+ expectationFailure $+ unlines+ [ "The following should have been equal."+ , "actual:"+ , drawTreeCursor actual+ , "expected:"+ , drawTreeCursor expected+ ] instance CanFail SwapResult where- hasFailed (Swapped _) = False- hasFailed _ = True- resultIfSucceeded (Swapped a) = Just a- resultIfSucceeded _ = Nothing+ hasFailed (Swapped _) = False+ hasFailed _ = True+ resultIfSucceeded (Swapped a) = Just a+ resultIfSucceeded _ = Nothing node :: a -> [CTree a] -> CTree a node a ts = CNode a $ closedForest $ map rebuildCTree ts
test/Cursor/TextFieldSpec.hs view
@@ -5,8 +5,8 @@ {-# LANGUAGE TypeFamilies #-} module Cursor.TextFieldSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -28,159 +28,152 @@ spec :: Spec spec = do- eqSpec @TextFieldCursor- genValidSpec @TextFieldCursor- describe "makeTextFieldCursor" $- it "produces valid cursors" $ producesValidsOnValids makeTextFieldCursor- describe "makeTextFieldCursorWithSelection" $ do- it "produces valid cursors" $- producesValidsOnValids3 makeTextFieldCursorWithSelection- it- "is the inverse of rebuildTextFieldCursor when using the current selection" $- 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 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- describe "rebuildTextFieldCursor" $ do- it "produces valid texts" $- producesValidsOnValids rebuildTextFieldCursor- it "is the inverse of makeTextFieldCursor for integers" $- inverseFunctionsOnValid makeTextFieldCursor rebuildTextFieldCursor- it- "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $- forAllValid $ \x ->- forAllValid $ \y ->- inverseFunctionsIfFirstSucceedsOnValid- (makeTextFieldCursorWithSelection x y)- rebuildTextFieldCursor- describe "textFieldCursorSelection" $- it "produces valid tuples" $- producesValidsOnValids textFieldCursorSelection- describe "emptyTextFieldCursor" $- it "is valid" $ shouldBeValid emptyTextFieldCursor- describe "nullTextFieldCursor" $- it "produces valid" $ producesValidsOnValids nullTextFieldCursor- describe "textFieldCursorSelectPrevLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectPrevLine- it "is a movement" $ isMovementM textFieldCursorSelectPrevLine- it "selects the previous line" pending- describe "textFieldCursorSelectNextLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectNextLine- it "is a movement" $ isMovementM textFieldCursorSelectNextLine- it "selects the next line" pending- describe "textFieldCursorSelectFirstLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectFirstLine- it "is a movement" $ isMovement textFieldCursorSelectFirstLine- it "is idempotent" $ idempotentOnValid textFieldCursorSelectFirstLine- it "selects the first line" pending- describe "textFieldCursorSelectLastLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectLastLine- it "is a movement" $ isMovement textFieldCursorSelectLastLine- it "is idempotent" $ idempotentOnValid textFieldCursorSelectLastLine- it "selects the last line" pending- describe "textFieldCursorSelectPrevChar" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectPrevChar- it "selects the previous character on the current line" pending- describe "textFieldCursorSelectNextChar" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectNextChar- it "selects the previous character on the current line" pending- describe "textFieldCursorIndexOnLine" $ do- it "produces valid indices" $- producesValidsOnValids textFieldCursorIndexOnLine- it "returns the index on the current line" pending- describe "textFieldCursorSelectIndexOnLine" $ do- it "produces valid cursors for any index" $- producesValidsOnValids2 textFieldCursorSelectIndexOnLine- it "selects the given index on the current line" pending- describe "textFieldCursorInsertChar" $ do- it "produces valid cursors" $- forAllValid $ \d ->- producesValidsOnValids (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)- it "inserts a character after the cursor on the currrent line" pending- describe "textFieldCursorInsertNewline" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorInsertNewline- it "inserts a new line" pending- describe "textFieldCursorAppendNewline" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorAppendNewline- describe "textFieldCursorRemove" $ do- it "produces valid cursors" $- producesValidsOnValids 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 "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 "selects the start of the current line" pending- describe "textFieldCursorSelectEndOfLine" $ do- it "produces valid cursors" $- producesValidsOnValids textFieldCursorSelectEndOfLine- it "selects the end of the current line" pending+ eqSpecOnValid @TextFieldCursor+ genValidSpec @TextFieldCursor+ describe "makeTextFieldCursor" $+ it "produces valid cursors" $ producesValidsOnValids makeTextFieldCursor+ describe "makeTextFieldCursorWithSelection" $ do+ it "produces valid cursors" $+ producesValidsOnValids3 makeTextFieldCursorWithSelection+ it+ "is the inverse of rebuildTextFieldCursor when using the current selection" $+ 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 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+ describe "rebuildTextFieldCursor" $ do+ it "produces valid texts" $ producesValidsOnValids rebuildTextFieldCursor+ it "is the inverse of makeTextFieldCursor for integers" $+ inverseFunctionsOnValid makeTextFieldCursor rebuildTextFieldCursor+ it+ "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $+ forAllValid $ \x ->+ forAllValid $ \y ->+ inverseFunctionsIfFirstSucceedsOnValid+ (makeTextFieldCursorWithSelection x y)+ rebuildTextFieldCursor+ describe "textFieldCursorSelection" $+ it "produces valid tuples" $ producesValidsOnValids textFieldCursorSelection+ describe "emptyTextFieldCursor" $+ it "is valid" $ shouldBeValid emptyTextFieldCursor+ describe "nullTextFieldCursor" $+ it "produces valid" $ producesValidsOnValids nullTextFieldCursor+ describe "textFieldCursorSelectPrevLine" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectPrevLine+ it "is a movement" $ isMovementM textFieldCursorSelectPrevLine+ it "selects the previous line" pending+ describe "textFieldCursorSelectNextLine" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectNextLine+ it "is a movement" $ isMovementM textFieldCursorSelectNextLine+ it "selects the next line" pending+ describe "textFieldCursorSelectFirstLine" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectFirstLine+ it "is a movement" $ isMovement textFieldCursorSelectFirstLine+ it "is idempotent" $ idempotentOnValid textFieldCursorSelectFirstLine+ it "selects the first line" pending+ describe "textFieldCursorSelectLastLine" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectLastLine+ it "is a movement" $ isMovement textFieldCursorSelectLastLine+ it "is idempotent" $ idempotentOnValid textFieldCursorSelectLastLine+ it "selects the last line" pending+ describe "textFieldCursorSelectPrevChar" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectPrevChar+ it "selects the previous character on the current line" pending+ describe "textFieldCursorSelectNextChar" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectNextChar+ it "selects the previous character on the current line" pending+ describe "textFieldCursorIndexOnLine" $ do+ it "produces valid indices" $+ producesValidsOnValids textFieldCursorIndexOnLine+ it "returns the index on the current line" pending+ describe "textFieldCursorSelectIndexOnLine" $ do+ it "produces valid cursors for any index" $+ producesValidsOnValids2 textFieldCursorSelectIndexOnLine+ it "selects the given index on the current line" pending+ describe "textFieldCursorInsertChar" $ do+ it "produces valid cursors" $+ forAllValid $ \d -> producesValidsOnValids (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)+ it "inserts a character after the cursor on the currrent line" pending+ describe "textFieldCursorInsertNewline" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorInsertNewline+ it "inserts a new line" pending+ describe "textFieldCursorAppendNewline" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorAppendNewline+ describe "textFieldCursorRemove" $ do+ it "produces valid cursors" $ producesValidsOnValids 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 "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 "selects the start of the current line" pending+ describe "textFieldCursorSelectEndOfLine" $ do+ it "produces valid cursors" $+ producesValidsOnValids textFieldCursorSelectEndOfLine+ it "selects the end of the current line" pending isMovementM :: (TextFieldCursor -> Maybe TextFieldCursor) -> Property isMovementM func =- forAllValid $ \tfc ->- case func tfc of- Nothing -> pure () -- Fine- Just tfc' ->- 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'- ]+ forAllValid $ \tfc ->+ case func tfc of+ Nothing -> pure () -- Fine+ Just tfc' ->+ 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'+ ] isMovement :: (TextFieldCursor -> TextFieldCursor) -> Property isMovement func =- forAllValid $ \tfc ->- rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)+ forAllValid $ \tfc ->+ rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)
test/Cursor/TextSpec.hs view
@@ -3,8 +3,8 @@ {-# LANGUAGE RankNTypes #-} module Cursor.TextSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec import Test.QuickCheck@@ -17,119 +17,113 @@ spec :: Spec spec = do- eqSpec @TextCursor- genValidSpec @TextCursor- describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor- describe "makeTextCursor" $- it "produces valid list cursors" $ producesValidsOnValids makeTextCursor- describe "makeTextCursorWithSelection" $- it "produces valid list cursors" $- producesValidsOnValids2 makeTextCursorWithSelection- describe "rebuildTextCursor" $ do- it "produces valid lists" $ producesValidsOnValids rebuildTextCursor- it "is the inverse of makeTextCursor" $- inverseFunctionsIfFirstSucceedsOnValid- makeTextCursor- rebuildTextCursor- it "is the inverse of makeTextCursorWithSelection for any index" $- forAllUnchecked $ \i ->- inverseFunctionsIfFirstSucceedsOnValid- (makeTextCursorWithSelection i)- rebuildTextCursor- describe "textCursorNull" $- it "produces valid bools" $ producesValidsOnValids textCursorNull- describe "textCursorLength" $- it "produces valid ints" $ producesValidsOnValids textCursorLength- describe "textCursorIndex" $- it "produces valid indices" $ producesValidsOnValids textCursorIndex- describe "textCursorSelectPrev" $ do- it "produces valid cursors" $- producesValidsOnValids textCursorSelectPrev- it "is a movement" $ isMovementM textCursorSelectPrev- it "selects the previous position" pending- describe "textCursorSelectNext" $ do- it "produces valid cursors" $- producesValidsOnValids 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 "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- describe "textCursorSelectStart" $ do- it "produces valid cursors" $- producesValidsOnValids 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 "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 "returns the item before the position" pending- describe "textCursorNextChar" $ do- it "produces valid items" $ producesValidsOnValids textCursorNextChar- it "returns the item after the position" pending- describe "textCursorInsert" $ do- it "produces valids" $- forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)- it "inserts an item before the cursor" $ pending- describe "textCursorAppend" $ do- it "produces valids" $- forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)- it "inserts an item after the cursor" $ pending- describe "textCursorRemove" $ do- it "produces valids" $ validIfSucceedsOnValid textCursorRemove- it "removes an item before the cursor" $ pending- describe "textCursorDelete" $ do- it "produces valids" $ validIfSucceedsOnValid textCursorDelete- it "removes an item before the cursor" $ pending- describe "textCursorSplit" $ do- it "produces valids" $ producesValidsOnValids textCursorSplit- it- "produces two list cursors that rebuild to the rebuilding of the original" $- 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 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)+ eqSpec @TextCursor+ genValidSpec @TextCursor+ describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor+ describe "makeTextCursor" $+ it "produces valid list cursors" $ producesValidsOnValids makeTextCursor+ describe "makeTextCursorWithSelection" $+ it "produces valid list cursors" $+ producesValidsOnValids2 makeTextCursorWithSelection+ describe "rebuildTextCursor" $ do+ it "produces valid lists" $ producesValidsOnValids rebuildTextCursor+ it "is the inverse of makeTextCursor" $+ inverseFunctionsIfFirstSucceedsOnValid makeTextCursor rebuildTextCursor+ it "is the inverse of makeTextCursorWithSelection for any index" $+ forAllUnchecked $ \i ->+ inverseFunctionsIfFirstSucceedsOnValid+ (makeTextCursorWithSelection i)+ rebuildTextCursor+ describe "textCursorNull" $+ it "produces valid bools" $ producesValidsOnValids textCursorNull+ describe "textCursorLength" $+ it "produces valid ints" $ producesValidsOnValids textCursorLength+ describe "textCursorIndex" $+ it "produces valid indices" $ producesValidsOnValids textCursorIndex+ describe "textCursorSelectPrev" $ do+ it "produces valid cursors" $ producesValidsOnValids textCursorSelectPrev+ it "is a movement" $ isMovementM textCursorSelectPrev+ it "selects the previous position" pending+ describe "textCursorSelectNext" $ do+ it "produces valid cursors" $ producesValidsOnValids 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 "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+ describe "textCursorSelectStart" $ do+ it "produces valid cursors" $ producesValidsOnValids 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 "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 "returns the item before the position" pending+ describe "textCursorNextChar" $ do+ it "produces valid items" $ producesValidsOnValids textCursorNextChar+ it "returns the item after the position" pending+ describe "textCursorInsert" $ do+ it "produces valids" $+ forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)+ it "inserts an item before the cursor" $ pending+ describe "textCursorAppend" $ do+ it "produces valids" $+ forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)+ it "inserts an item after the cursor" $ pending+ describe "textCursorRemove" $ do+ it "produces valids" $ validIfSucceedsOnValid textCursorRemove+ it "removes an item before the cursor" $ pending+ describe "textCursorDelete" $ do+ it "produces valids" $ validIfSucceedsOnValid textCursorDelete+ it "removes an item before the cursor" $ pending+ describe "textCursorSplit" $ do+ it "produces valids" $ producesValidsOnValids textCursorSplit+ it+ "produces two list cursors that rebuild to the rebuilding of the original" $+ 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 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) isMovementM :: (TextCursor -> Maybe TextCursor) -> Property isMovementM func =- forAllValid $ \tc ->- case func tc of- Nothing -> pure () -- Fine- Just tc' ->- 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'- ]+ forAllValid $ \tc ->+ case func tc of+ Nothing -> pure () -- Fine+ Just tc' ->+ 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'+ ] isMovement :: (TextCursor -> TextCursor) -> Property isMovement func =- forAllValid $ \lec ->- rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)+ forAllValid $ \lec ->+ rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)
test/Cursor/Tree/TypesSpec.hs view
@@ -5,8 +5,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Tree.TypesSpec- ( spec- ) where+ ( spec+ ) where import Test.Hspec @@ -18,42 +18,42 @@ spec :: Spec spec = do- eqSpec @TreeCursorSelection- genValidSpec @TreeCursorSelection- shrinkValidSpecWithLimit @TreeCursorSelection 100- eqSpec @(SwapResult Int)- genValidSpec @(SwapResult Double)- shrinkValidSpecWithLimit @(SwapResult Int) 100- eqSpec @(PromoteElemResult Int)- genValidSpec @(PromoteElemResult Double)- shrinkValidSpecWithLimit @(PromoteElemResult Int) 100- eqSpec @(PromoteResult Int)- genValidSpec @(PromoteResult Double)- shrinkValidSpecWithLimit @(PromoteResult Int) 100- eqSpec @(DemoteResult Int)- genValidSpec @(DemoteResult Double)- shrinkValidSpecWithLimit @(DemoteResult Int) 100- eqSpec @(CTree Int)- genValidSpec @(CTree Double)- shrinkValidSpecWithLimit @(CTree Int) 100- eqSpec @(CForest Int)- genValidSpec @(CForest Double)- shrinkValidSpecWithLimit @(CForest Int) 100- eqSpec @(TreeAbove Int)- genValidSpec @(TreeAbove Double)- shrinkValidSpecWithLimit @(TreeAbove Int) 100- describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Double- describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Double- describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Double- describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Double- eqSpec @(TreeCursor Int Word)- genValidSpec @(TreeCursor Float Double)- shrinkValidSpecWithLimit @(TreeCursor Word Int) 100- describe "treeCursorAboveL" $- lensSpecOnValid $ treeCursorAboveL @Float @Double- describe "treeCursorCurrentL" $- lensSpecOnValid $ treeCursorCurrentL @Float @Double- describe "treeCursorBelowL" $- lensSpecOnValid $ treeCursorBelowL @Float @Double- describe "treeCursorCurrentSubTreeL" $- lensSpecOnValid $ treeCursorCurrentSubTreeL @Float @Double+ eqSpec @TreeCursorSelection+ genValidSpec @TreeCursorSelection+ shrinkValidSpecWithLimit @TreeCursorSelection 10+ eqSpec @(SwapResult Int)+ genValidSpec @(SwapResult Rational)+ shrinkValidSpecWithLimit @(SwapResult Int) 10+ eqSpec @(PromoteElemResult Int)+ genValidSpec @(PromoteElemResult Rational)+ shrinkValidSpecWithLimit @(PromoteElemResult Int) 10+ eqSpec @(PromoteResult Int)+ genValidSpec @(PromoteResult Rational)+ shrinkValidSpecWithLimit @(PromoteResult Int) 10+ eqSpec @(DemoteResult Int)+ genValidSpec @(DemoteResult Rational)+ shrinkValidSpecWithLimit @(DemoteResult Int) 10+ eqSpec @(CTree Int)+ genValidSpec @(CTree Rational)+ shrinkValidSpecWithLimit @(CTree Int) 10+ eqSpec @(CForest Int)+ genValidSpec @(CForest Rational)+ shrinkValidSpecWithLimit @(CForest Int) 10+ eqSpec @(TreeAbove Int)+ genValidSpec @(TreeAbove Rational)+ shrinkValidSpecWithLimit @(TreeAbove Int) 10+ describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Rational+ describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Rational+ describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Rational+ describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Rational+ eqSpec @(TreeCursor Int Word)+ genValidSpec @(TreeCursor Rational Rational)+ shrinkValidSpecWithLimit @(TreeCursor Word Int) 10+ describe "treeCursorAboveL" $+ lensSpecOnValid $ treeCursorAboveL @Rational @Rational+ describe "treeCursorCurrentL" $+ lensSpecOnValid $ treeCursorCurrentL @Rational @Rational+ describe "treeCursorBelowL" $+ lensSpecOnValid $ treeCursorBelowL @Rational @Rational+ describe "treeCursorCurrentSubTreeL" $+ lensSpecOnValid $ treeCursorCurrentSubTreeL @Rational @Rational