diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## [Unreleased] +## [0.3.0.0] - 2020-02-14 + +* Benchmarks for cursor generation + ## [0.2.0.0] - 2019-09-23 * Fixed the generator for `TextFieldCursor` to be compatible with the new validity constraint in cursor-0.2.0.0. diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,44 @@ +{-# LANGUAGE TypeApplications #-} + +module Main where + +import Criterion.Main as Criterion + +import Data.GenValidity.Criterion + +import Cursor.Forest.Gen () +import Cursor.List.Gen () +import Cursor.List.NonEmpty.Gen () +import Cursor.Map.Gen () +import Cursor.Map.KeyValue.Gen () +import Cursor.Text.Gen () +import Cursor.TextField.Gen () +import Cursor.Tree.Gen () + +import Cursor.List +import Cursor.Simple.Forest +import Cursor.Simple.List.NonEmpty +import Cursor.Simple.Map +import Cursor.Simple.Tree +import Cursor.Text +import Cursor.TextField + +main :: IO () +main = + Criterion.defaultMain + [ genValidBench @(ListCursor Bool) + , genValidBench @(NonEmptyCursor Bool) + , genValidBench @(KeyValueCursor Bool Bool) + , genValidBench @(MapCursor Bool Bool) + , genValidBench @(SwapResult Bool) + , genValidBench @(PromoteElemResult Bool) + , genValidBench @(PromoteResult Bool) + , genValidBench @(DemoteResult Bool) + , genValidBench @(CTree Bool) + , genValidBench @(CForest Bool) + , genValidBench @(TreeAbove Bool) + , genValidBench @(TreeCursor Bool) + , genValidBench @(ForestCursor Bool) + , genValidBench @TextCursor + , genValidBench @TextFieldCursor + ] diff --git a/cursor-gen.cabal b/cursor-gen.cabal --- a/cursor-gen.cabal +++ b/cursor-gen.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 0b391e9de9acd52641e27e356268ffac18998a48a689258da3a53a8cb083571d +-- hash: ca8f0d880d4a2aa40bc3c0de55b6c000b047b412f701f38af7d0da3f5c4346a2 name: cursor-gen -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Generators for Purely Functional Cursors description: Generators for Purely Functional Cursors for common data structures category: Cursor @@ -22,18 +22,6 @@ CHANGELOG.md library - hs-source-dirs: - src/ - ghc-options: -Wall - build-depends: - QuickCheck - , base <5 - , containers - , cursor >=0.2 - , genvalidity >=0.8 - , genvalidity-containers - , genvalidity-text >=0.6 - , text exposed-modules: Cursor.Forest.Gen Cursor.List.Gen @@ -50,26 +38,23 @@ Cursor.Tree.Gen other-modules: Paths_cursor_gen - default-language: Haskell2010 - -test-suite cursor-test - type: exitcode-stdio-1.0 - main-is: Spec.hs hs-source-dirs: - test/ - ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + src/ + ghc-options: -Wall build-depends: QuickCheck - , base + , base <5 , containers - , cursor - , cursor-gen - , genvalidity-hspec - , genvalidity-hspec-optics - , hspec - , microlens - , pretty-show + , cursor >=0.2 + , genvalidity >=0.8 + , genvalidity-containers + , genvalidity-text >=0.6 , text + default-language: Haskell2010 + +test-suite cursor-test + type: exitcode-stdio-1.0 + main-is: Spec.hs other-modules: Cursor.List.NonEmptySpec Cursor.ListSpec @@ -92,4 +77,35 @@ Cursor.TextSpec Cursor.Tree.TypesSpec Paths_cursor_gen + hs-source-dirs: + test/ + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + QuickCheck + , base <5 + , containers + , cursor + , cursor-gen + , genvalidity-hspec + , genvalidity-hspec-optics + , hspec + , microlens + , pretty-show + , text + default-language: Haskell2010 + +benchmark cursor-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Paths_cursor_gen + hs-source-dirs: + bench/ + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base <5 + , criterion + , cursor + , cursor-gen + , genvalidity-criterion default-language: Haskell2010 diff --git a/src/Cursor/Forest/Gen.hs b/src/Cursor/Forest/Gen.hs --- a/src/Cursor/Forest/Gen.hs +++ b/src/Cursor/Forest/Gen.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Forest.Gen @@ -13,8 +12,7 @@ import Cursor.List.NonEmpty.Gen () import Cursor.Tree.Gen () -instance (GenUnchecked a, GenUnchecked b) => - GenUnchecked (ForestCursor a b) where +instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (ForestCursor a b) where genUnchecked = ForestCursor <$> genUnchecked shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne diff --git a/src/Cursor/List/NonEmpty/Gen.hs b/src/Cursor/List/NonEmpty/Gen.hs --- a/src/Cursor/List/NonEmpty/Gen.hs +++ b/src/Cursor/List/NonEmpty/Gen.hs @@ -2,7 +2,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.List.NonEmpty.Gen - ( nonEmptyElemOf + ( genNonEmptyCursorBy + , nonEmptyElemOf , nonEmptyWithIndex0 , nonEmptyWith ) where @@ -17,42 +18,29 @@ import Cursor.List.NonEmpty -instance (GenUnchecked a, GenUnchecked b) => - GenUnchecked (NonEmptyCursor a b) where - genUnchecked = - sized $ \n -> do - part <- arbPartition n - case part of - [] -> singletonNonEmptyCursor <$> resize 0 genUnchecked - (s:ss) -> do - i <- choose (0, length ss) - let (as, bs) = splitAt i ss - nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genUnchecked - nonEmptyCursorCurrent <- resize s genUnchecked - nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genUnchecked - pure NonEmptyCursor {..} +instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (NonEmptyCursor a b) where + genUnchecked = genNonEmptyCursorBy genUnchecked genUnchecked shrinkUnchecked (NonEmptyCursor prev cur next) = - [ NonEmptyCursor prev' cur' next' - | (prev', cur', next') <- shrinkUnchecked (prev, cur, next) - ] + [NonEmptyCursor prev' cur' next' | (prev', cur', next') <- shrinkUnchecked (prev, cur, next)] instance (GenValid a, GenValid b) => GenValid (NonEmptyCursor a b) where - genValid = - sized $ \n -> do - part <- arbPartition n - case part of - [] -> singletonNonEmptyCursor <$> resize 0 genValid - (s:ss) -> do - i <- choose (0, length ss) - let (as, bs) = splitAt i ss - nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genValid - nonEmptyCursorCurrent <- resize s genValid - nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genValid - pure NonEmptyCursor {..} + genValid = genNonEmptyCursorBy genValid genValid shrinkValid (NonEmptyCursor prev cur next) = - [ NonEmptyCursor prev' cur' next' - | (prev', cur', next') <- shrinkValid (prev, cur, next) - ] + [NonEmptyCursor prev' cur' next' | (prev', cur', next') <- shrinkValid (prev, cur, next)] + +genNonEmptyCursorBy :: Gen a -> Gen b -> Gen (NonEmptyCursor a b) +genNonEmptyCursorBy genA genB = + sized $ \n -> do + part <- arbPartition n + case part of + [] -> singletonNonEmptyCursor <$> resize 0 genA + (s:ss) -> do + i <- choose (0, length ss) + let (as, bs) = splitAt i ss + nonEmptyCursorPrev <- forM as $ \s_ -> resize s_ genB + nonEmptyCursorCurrent <- resize s genA + nonEmptyCursorNext <- forM bs $ \s_ -> resize s_ genB + pure NonEmptyCursor {..} nonEmptyElemOf :: NonEmptyCursor a a -> Gen a nonEmptyElemOf = elements . NE.toList . rebuildNonEmptyCursor id diff --git a/src/Cursor/Map/Gen.hs b/src/Cursor/Map/Gen.hs --- a/src/Cursor/Map/Gen.hs +++ b/src/Cursor/Map/Gen.hs @@ -1,22 +1,28 @@ -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Map.Gen - ( + ( genMapCursorBy ) where import Data.GenValidity import Data.GenValidity.Containers () +import Test.QuickCheck + import Cursor.Map -import Cursor.List.NonEmpty.Gen () -import Cursor.Map.KeyValue.Gen () +import Cursor.List.NonEmpty.Gen +import Cursor.Map.KeyValue.Gen instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) => - GenUnchecked (MapCursor kc vc k v) + GenUnchecked (MapCursor kc vc k v) where + genUnchecked = genMapCursorBy genUnchecked genUnchecked genUnchecked genUnchecked -instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => - GenValid (MapCursor kc vc k v) where - genValid = genValidStructurallyWithoutExtraChecking +instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => GenValid (MapCursor kc vc k v) where + genValid = genMapCursorBy genValid genValid genValid genValid shrinkValid = shrinkValidStructurallyWithoutExtraFiltering + +genMapCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (MapCursor kc vc k v) +genMapCursorBy genKC genVC genK genV = + MapCursor <$> + genNonEmptyCursorBy (genKeyValueCursorBy genKC genVC genK genV) ((,) <$> genK <*> genV) diff --git a/src/Cursor/Map/KeyValue/Gen.hs b/src/Cursor/Map/KeyValue/Gen.hs --- a/src/Cursor/Map/KeyValue/Gen.hs +++ b/src/Cursor/Map/KeyValue/Gen.hs @@ -1,21 +1,28 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Map.KeyValue.Gen - ( + ( genKeyValueCursorBy ) where import Data.GenValidity +import Test.QuickCheck + import Cursor.Map.KeyValue instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) => - GenUnchecked (KeyValueCursor kc vc k v) + GenUnchecked (KeyValueCursor kc vc k v) where + genUnchecked = genKeyValueCursorBy genUnchecked genUnchecked genUnchecked genUnchecked instance (GenValid kc, GenValid vc, GenValid k, GenValid v) => GenValid (KeyValueCursor kc vc k v) where - genValid = genValidStructurallyWithoutExtraChecking + genValid = genKeyValueCursorBy genValid genValid genValid genValid shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked KeyValueToggle instance GenValid KeyValueToggle + +genKeyValueCursorBy :: Gen kc -> Gen vc -> Gen k -> Gen v -> Gen (KeyValueCursor kc vc k v) +genKeyValueCursorBy genKC genVC genK genV = + oneof [KeyValueCursorKey <$> genKC <*> genV, KeyValueCursorValue <$> genK <*> genVC] diff --git a/src/Cursor/Text/Gen.hs b/src/Cursor/Text/Gen.hs --- a/src/Cursor/Text/Gen.hs +++ b/src/Cursor/Text/Gen.hs @@ -1,7 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Text.Gen - ( textCursorWithGen + ( genSafeChar + , genTextCursorChar + , textCursorWithGen , textCursorWithIndex0 ) where @@ -11,14 +13,21 @@ import Data.GenValidity.Text () import Cursor.Text +import Cursor.Types import Cursor.List.Gen instance GenUnchecked TextCursor instance GenValid TextCursor where - genValid = genValidStructurally + genValid = TextCursor <$> listCursorWithGen genTextCursorChar shrinkValid = shrinkValidStructurally + +genSafeChar :: Gen Char +genSafeChar = choose (minBound, maxBound) `suchThat` isSafeChar + +genTextCursorChar :: Gen Char +genTextCursorChar = genSafeChar `suchThat` (/= '\n') textCursorWithGen :: Gen Char -> Gen TextCursor textCursorWithGen gen = TextCursor <$> listCursorWithGen gen diff --git a/src/Cursor/TextField/Gen.hs b/src/Cursor/TextField/Gen.hs --- a/src/Cursor/TextField/Gen.hs +++ b/src/Cursor/TextField/Gen.hs @@ -2,10 +2,8 @@ module Cursor.TextField.Gen where -import qualified Data.Text as T -import qualified Data.Text.Internal as T - import Data.GenValidity +import Data.GenValidity.Text import Test.QuickCheck @@ -16,11 +14,12 @@ import Cursor.Text.Gen instance GenValid TextFieldCursor where - genValid = do - let charGen = genValid `suchThat` (/= '\n') `suchThat` (\c -> T.safe c == c) - prevs <- genListOf $ T.pack <$> genListOf charGen - nexts <- genListOf $ T.pack <$> genListOf charGen - cur <- textCursorWithGen charGen - let nec = NonEmptyCursor prevs cur nexts - pure $ TextFieldCursor nec + genValid = + sized $ \n -> do + (a, b, c) <- genSplit3 n + prevs <- resize a $ genListOf $ genTextBy genTextCursorChar + nexts <- resize b $ genListOf $ genTextBy genTextCursorChar + cur <- resize c $ textCursorWithGen genTextCursorChar + let nec = NonEmptyCursor prevs cur nexts + pure $ TextFieldCursor nec shrinkValid = shrinkValidStructurally diff --git a/src/Cursor/Tree/Gen.hs b/src/Cursor/Tree/Gen.hs --- a/src/Cursor/Tree/Gen.hs +++ b/src/Cursor/Tree/Gen.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -19,49 +19,46 @@ instance GenUnchecked TreeCursorSelection instance GenValid TreeCursorSelection where - genValid = genValidStructurally - shrinkValid = shrinkValidStructurally + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked a => GenUnchecked (SwapResult a) instance GenValid a => GenValid (SwapResult a) where - genValid = genValidStructurally - shrinkValid = shrinkValidStructurally + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked a => GenUnchecked (PromoteElemResult a) instance GenValid a => GenValid (PromoteElemResult a) where - genValid = genValidStructurally - shrinkValid = shrinkValidStructurally + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked a => GenUnchecked (PromoteResult a) instance GenValid a => GenValid (PromoteResult a) where - genValid = genValidStructurally - shrinkValid = shrinkValidStructurally + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked a => GenUnchecked (DemoteResult a) instance GenValid a => GenValid (DemoteResult a) where - genValid = genValidStructurally - shrinkValid = shrinkValidStructurally + genValid = genValidStructurallyWithoutExtraChecking + shrinkValid = shrinkValidStructurallyWithoutExtraFiltering instance GenUnchecked a => GenUnchecked (CTree a) where genUnchecked = sized $ \n -> do - s <- upTo n - (a, b) <- genSplit s + (a, b) <- genSplit n val <- resize a genUnchecked for <- resize b genUnchecked pure $ CNode val for - shrinkUnchecked (CNode a cf) = - [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)] + shrinkUnchecked (CNode a cf) = [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)] instance GenValid a => GenValid (CTree a) where genValid = sized $ \n -> do - s <- upTo n - (a, b) <- genSplit s + (a, b) <- genSplit n val <- resize a genValid for <- resize b genValid pure $ CNode val for @@ -69,37 +66,23 @@ instance GenUnchecked a => GenUnchecked (CForest a) where genUnchecked = - sized $ \n -> - case n of - 0 -> pure EmptyCForest - _ -> - oneof - [ ClosedForest <$> resize n genUnchecked - , OpenForest <$> resize n genUnchecked - ] + sized $ \case + 0 -> pure EmptyCForest + _ -> oneof [ClosedForest <$> genUnchecked, OpenForest <$> genUnchecked] shrinkUnchecked EmptyCForest = [] - shrinkUnchecked (ClosedForest ne) = - EmptyCForest : (ClosedForest <$> shrinkUnchecked ne) + shrinkUnchecked (ClosedForest ne) = EmptyCForest : (ClosedForest <$> shrinkUnchecked ne) shrinkUnchecked (OpenForest ne) = - EmptyCForest : - ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkUnchecked ne) + EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkUnchecked ne) instance GenValid a => GenValid (CForest a) where genValid = - sized $ \n -> - case n of - 0 -> pure EmptyCForest - _ -> - oneof - [ ClosedForest <$> resize n genValid - , OpenForest <$> resize n genValid - ] + sized $ \case + 0 -> pure EmptyCForest + _ -> oneof [ClosedForest <$> genValid, OpenForest <$> genValid] shrinkValid EmptyCForest = [] - shrinkValid (ClosedForest ne) = - EmptyCForest : (ClosedForest <$> shrinkValid ne) + shrinkValid (ClosedForest ne) = EmptyCForest : (ClosedForest <$> shrinkValid ne) shrinkValid (OpenForest ne) = - EmptyCForest : - ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne) + EmptyCForest : ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne) instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (TreeCursor a b) where genUnchecked = diff --git a/test/Cursor/List/NonEmptySpec.hs b/test/Cursor/List/NonEmptySpec.hs --- a/test/Cursor/List/NonEmptySpec.hs +++ b/test/Cursor/List/NonEmptySpec.hs @@ -1,8 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeFamilies #-} module Cursor.List.NonEmptySpec ( spec @@ -20,10 +17,10 @@ describe "nonemptyPrepend" $ it "is equivalent to regular prepend" $ equivalentWhenFirstSucceeds - (\(ls1, ls2) -> (NE.toList . nonemptyPrepend ls1) <$> NE.nonEmpty ls2) - (uncurry (++) :: ([Int], [Int]) -> [Int]) + (\(ls1, ls2) -> NE.toList . nonemptyPrepend ls1 <$> NE.nonEmpty ls2) + (uncurry (++) :: ([Bool], [Bool]) -> [Bool]) describe "nonemptyAppend" $ it "is equivalent to regular append" $ equivalentWhenFirstSucceeds - (\(ls1, ls2) -> (NE.toList . (`nonemptyAppend` ls2)) <$> NE.nonEmpty ls1) - (uncurry (++) :: ([Int], [Int]) -> [Int]) + (\(ls1, ls2) -> NE.toList . (`nonemptyAppend` ls2) <$> NE.nonEmpty ls1) + (uncurry (++) :: ([Bool], [Bool]) -> [Bool]) diff --git a/test/Cursor/ListSpec.hs b/test/Cursor/ListSpec.hs --- a/test/Cursor/ListSpec.hs +++ b/test/Cursor/ListSpec.hs @@ -17,108 +17,85 @@ spec :: Spec spec = do - eqSpec @(ListCursor Int) + eqSpec @(ListCursor Bool) functorSpec @ListCursor - genValidSpec @(ListCursor Rational) - describe "emptyListCursor" $ - it "is valid" $ shouldBeValid (emptyListCursor @Int) + genValidSpec @(ListCursor Bool) + describe "emptyListCursor" $ it "is valid" $ shouldBeValid (emptyListCursor @Bool) describe "makeListCursor" $ - it "produces valid list cursors" $ - producesValidsOnValids (makeListCursor @Rational) + it "produces valid list cursors" $ producesValidsOnValids (makeListCursor @Bool) describe "makeListCursorWithSelection" $ - it "produces valid list cursors" $ - producesValidsOnValids2 (makeListCursorWithSelection @Rational) + it "produces valid list cursors" $ producesValidsOnValids2 (makeListCursorWithSelection @Bool) describe "rebuildListCursor" $ do - it "produces valid lists" $ - producesValidsOnValids (rebuildListCursor @Rational) + it "produces valid lists" $ producesValidsOnValids (rebuildListCursor @Bool) it "is the inverse of makeListCursor" $ - inverseFunctions (makeListCursor @Int) rebuildListCursor + inverseFunctions (makeListCursor @Bool) rebuildListCursor it "is the inverse of makeListCursorWithSelection for any index" $ forAllUnchecked $ \i -> - inverseFunctionsIfFirstSucceeds - (makeListCursorWithSelection @Int i) - rebuildListCursor + inverseFunctionsIfFirstSucceeds (makeListCursorWithSelection @Bool i) rebuildListCursor describe "listCursorNull" $ - it "produces valid bools" $ - producesValidsOnValids (listCursorNull @Rational) + it "produces valid bools" $ producesValidsOnValids (listCursorNull @Bool) describe "listCursorLength" $ - it "produces valid bools" $ - producesValidsOnValids (listCursorLength @Rational) + it "produces valid bools" $ producesValidsOnValids (listCursorLength @Bool) describe "listCursorIndex" $ - it "produces valid indices" $ - producesValidsOnValids (listCursorIndex @Rational) + it "produces valid indices" $ producesValidsOnValids (listCursorIndex @Bool) describe "listCursorSelectPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids (listCursorSelectPrev @Rational) + it "produces valid cursors" $ producesValidsOnValids (listCursorSelectPrev @Bool) it "is a movement" $ isMovementM listCursorSelectPrev it "selects the previous position" pending describe "listCursorSelectNext" $ do - it "produces valid cursors" $ - producesValidsOnValids (listCursorSelectNext @Rational) + it "produces valid cursors" $ producesValidsOnValids (listCursorSelectNext @Bool) it "is a movement" $ isMovementM listCursorSelectNext it "selects the next position" pending describe "listCursorSelectIndex" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (listCursorSelectIndex @Rational) - it "is a movement" $ - forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix) + it "produces valid cursors" $ producesValidsOnValids2 (listCursorSelectIndex @Bool) + it "is a movement" $ forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix) it "selects the position at the given index" pending describe "listCursorPrevItem" $ do - it "produces valid items" $ - producesValidsOnValids (listCursorPrevItem @Rational) + it "produces valid items" $ producesValidsOnValids (listCursorPrevItem @Bool) it "returns the item before the position" pending describe "listCursorNextItem" $ do - it "produces valid items" $ - producesValidsOnValids (listCursorNextItem @Rational) + it "produces valid items" $ producesValidsOnValids (listCursorNextItem @Bool) it "returns the item after the position" pending describe "listCursorSelectStart" $ do - it "produces valid cursors" $ - producesValidsOnValids (listCursorSelectStart @Rational) + it "produces valid cursors" $ producesValidsOnValids (listCursorSelectStart @Bool) it "is a movement" $ isMovement listCursorSelectStart - it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Rational) + it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Bool) it "selects the starting position" pending describe "listCursorSelectEnd" $ do - it "produces valid cursors" $ - producesValidsOnValids (listCursorSelectEnd @Rational) + it "produces valid cursors" $ producesValidsOnValids (listCursorSelectEnd @Bool) it "is a movement" $ isMovement listCursorSelectEnd - it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Rational) + it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Bool) it "selects the end position" pending describe "listCursorInsert" $ do - it "produces valids" $ - forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Rational d) - it "inserts an item before the cursor" $ pending + it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorInsert @Bool d) + it "inserts an item before the cursor" pending describe "listCursorAppend" $ do - it "produces valids" $ - forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Rational d) - it "inserts an item after the cursor" $ pending + it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (listCursorAppend @Bool d) + it "inserts an item after the cursor" pending describe "listCursorRemove" $ do - it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Rational) - it "removes an item before the cursor" $ pending + it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Bool) + it "removes an item before the cursor" pending describe "listCursorDelete" $ do - it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Rational) - it "removes an item before the cursor" $ pending + it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Bool) + it "removes an item before the cursor" pending describe "listCursorSplit" $ do - it "produces valids" $ producesValidsOnValids (listCursorSplit @Rational) - it - "produces two list cursors that rebuild to the rebuilding of the original" $ + it "produces valids" $ producesValidsOnValids (listCursorSplit @Bool) + it "produces two list cursors that rebuild to the rebuilding of the original" $ forAllValid $ \lc -> - let (lc1, lc2) = listCursorSplit (lc :: ListCursor Rational) - in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe` - rebuildListCursor lc + let (lc1, lc2) = listCursorSplit (lc :: ListCursor Bool) + in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe` rebuildListCursor lc describe "listCursorCombine" $ do - it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Rational) - it - "produces a list that rebuilds to the rebuilding of the original two cursors" $ + it "produces valids" $ producesValidsOnValids2 (listCursorCombine @Bool) + it "produces a list that rebuilds to the rebuilding of the original two cursors" $ forAllValid $ \lc1 -> forAllValid $ \lc2 -> - let lc = listCursorCombine lc1 (lc2 :: ListCursor Rational) - in rebuildListCursor lc `shouldBe` - (rebuildListCursor lc1 ++ rebuildListCursor lc2) + let lc = listCursorCombine lc1 (lc2 :: ListCursor Bool) + in rebuildListCursor lc `shouldBe` (rebuildListCursor lc1 ++ rebuildListCursor lc2) isMovementM :: (forall a. ListCursor a -> Maybe (ListCursor a)) -> Property isMovementM func = forAllValid $ \lec -> - case func (lec :: ListCursor Int) of + case func (lec :: ListCursor Bool) of Nothing -> pure () -- Fine Just lec' -> let ne = rebuildListCursor lec @@ -135,5 +112,4 @@ isMovement :: (forall a. ListCursor a -> ListCursor a) -> Property isMovement func = forAllValid $ \lec -> - rebuildListCursor (lec :: ListCursor Int) `shouldBe` - rebuildListCursor (func lec) + rebuildListCursor (lec :: ListCursor Bool) `shouldBe` rebuildListCursor (func lec) diff --git a/test/Cursor/Map/KeyValueSpec.hs b/test/Cursor/Map/KeyValueSpec.hs --- a/test/Cursor/Map/KeyValueSpec.hs +++ b/test/Cursor/Map/KeyValueSpec.hs @@ -13,7 +13,7 @@ spec :: Spec spec = do - eqSpec @(KeyValueCursor Int Int Int Int) - genValidSpec @(KeyValueCursor Double Double Double Double) + eqSpec @(KeyValueCursor Bool Bool Bool Bool) + genValidSpec @(KeyValueCursor Bool Bool Bool Bool) eqSpec @KeyValueToggle genValidSpec @KeyValueToggle diff --git a/test/Cursor/MapSpec.hs b/test/Cursor/MapSpec.hs --- a/test/Cursor/MapSpec.hs +++ b/test/Cursor/MapSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} @@ -14,6 +13,5 @@ spec :: Spec spec = do - eqSpec @(MapCursor Word Int Bool Ordering) - genValidSpec @(MapCursor Double Rational Int Bool) - shrinkValidSpec @(MapCursor Double Rational Int Bool) + eqSpec @(MapCursor Bool Bool Bool Bool) + genValidSpec @(MapCursor Bool Bool Bool Bool) diff --git a/test/Cursor/Simple/ForestSpec.hs b/test/Cursor/Simple/ForestSpec.hs --- a/test/Cursor/Simple/ForestSpec.hs +++ b/test/Cursor/Simple/ForestSpec.hs @@ -29,33 +29,26 @@ spec :: Spec spec = do eqSpec @(SFC.ForestCursor Int) - genValidSpec @(SFC.ForestCursor Rational) + genValidSpec @(SFC.ForestCursor Bool) modifyMaxSize (`quot` 2) $ - modifyMaxSuccess (`quot` 2) $ - shrinkValidSpecWithLimit @(SFC.ForestCursor Rational) 10 + modifyMaxSuccess (`quot` 2) $ shrinkValidSpecWithLimit @(SFC.ForestCursor Bool) 10 describe "makeForestCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (makeForestCursor @Rational) + it "produces valid cursors" $ producesValidsOnValids (makeForestCursor @Bool) describe "rebuildForestCursor" $ do - it "produces valid forests" $ - producesValidsOnValids (rebuildForestCursor @Rational) + it "produces valid forests" $ producesValidsOnValids (rebuildForestCursor @Bool) it "is the inverse of makeForestCursor for integers" $ inverseFunctions (makeForestCursor @Int) rebuildForestCursor - describe "forestCursorLestCursorL" $ - lensSpecOnValid (forestCursorListCursorL @Rational @Rational) - describe "forestCursorSelectedTreeL" $ - lensSpecOnValid (forestCursorSelectedTreeL @Rational @Rational) + describe "forestCursorLestCursorL" $ lensSpecOnValid (forestCursorListCursorL @Bool @Bool) + describe "forestCursorSelectedTreeL" $ lensSpecOnValid (forestCursorSelectedTreeL @Bool @Bool) describe "forestCursorSelection" $ do - it "produces valid ints" $ - producesValidsOnValids (forestCursorSelection @Rational @Rational) + it "produces valid ints" $ producesValidsOnValids (forestCursorSelection @Bool @Bool) it "returns the index of the currently selected element" pending describe "forestCursorSelectIndex" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorSelectIndex @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorSelectIndex @Bool) it "is the identity function when given the current selection" $ forAllValid $ \fc -> forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe` - Just (fc :: SFC.ForestCursor Rational) + Just (fc :: SFC.ForestCursor Bool) it "returns selects the element at the given index" pending movementsSpec collapseSpec @@ -67,28 +60,23 @@ movementsSpec :: Spec movementsSpec = do describe "forestCursorSelectPrevTreeCursor" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Bool it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor it "selects the previous tree cursor" pending describe "forestCursorSelectNextTreeCursor" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectNextTreeCursor @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNextTreeCursor @Bool it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor it "selects the next tree" pending describe "forestCursorSelectFirstTreeCursor" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Bool it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor it "selects the first tree" pending describe "forestCursorSelectLastTreeCursor" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectLastTreeCursor @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectLastTreeCursor @Bool it "is a movement" $ isMovement forestCursorSelectLastTreeCursor it "selects the last tree" pending describe "forestCursorSelectPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectPrev @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrev @Bool it "is a movement" $ isMovementM forestCursorSelectPrev it "selects the previous node" pending -- TODO example with a collapsed tree @@ -101,14 +89,10 @@ ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = - [CNode 1 $ openForest [CNode 2 $ emptyCForest]] + { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 3 :: Int - , treeBelow = emptyCForest - } + {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest} , nonEmptyCursorNext = [] } } @@ -130,16 +114,14 @@ , treeCurrent = 2 , treeBelow = emptyCForest } - , nonEmptyCursorNext = [CNode 3 $ emptyCForest] + , nonEmptyCursorNext = [CNode 3 emptyCForest] } } case forestCursorSelectPrev start of - Nothing -> - expectationFailure "forestCursorSelectPrev should not have failed." + Nothing -> expectationFailure "forestCursorSelectPrev should not have failed." Just actual -> actual `forestShouldBe` expected describe "forestCursorSelectNext" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectNext @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNext @Bool it "is a movement" $ isMovementM forestCursorSelectNext it "selects the next node" pending it "Works for this classic example" $ @@ -165,207 +147,155 @@ , treeCurrent = 2 , treeBelow = emptyCForest } - , nonEmptyCursorNext = [CNode 3 $ emptyCForest] + , nonEmptyCursorNext = [CNode 3 emptyCForest] } } expected = ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = - [CNode 1 $ openForest [CNode 2 $ emptyCForest]] + { nonEmptyCursorPrev = [CNode 1 $ openForest [CNode 2 emptyCForest]] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 3 :: Int - , treeBelow = emptyCForest - } + {treeAbove = Nothing, treeCurrent = 3 :: Int, treeBelow = emptyCForest} , nonEmptyCursorNext = [] } } case forestCursorSelectNext start of - Nothing -> - expectationFailure "forestCursorSelectNext should not have failed." + Nothing -> expectationFailure "forestCursorSelectNext should not have failed." Just actual -> actual `forestShouldBe` expected describe "forestCursorSelectPrevOnSameLevel" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Bool it "is a movement" $ isMovementM forestCursorSelectPrevOnSameLevel it "selects the previous node on the same level as the current node" pending describe "forestCursorSelectNextOnSameLevel" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Bool it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel it "selects the next node on the same level as the current node" pending describe "forestCursorSelectFirst" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectFirst @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectFirst @Bool it "is a movement" $ isMovement forestCursorSelectFirst it "selects the first node in the forest" pending describe "forestCursorSelectLast" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectLast @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectLast @Bool it "is a movement" $ isMovement forestCursorSelectLast it "selects the last node in the forest" pending describe "forestCursorSelectAbove" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectAbove @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectAbove @Bool it "is a movement" $ isMovementM forestCursorSelectAbove it "selects the parent" pending describe "forestCursorSelectBelowAtPos" $ do - it "produces valid cursors" $ - producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Rational + it "produces valid cursors" $ producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Bool it "is a movement for any index" $ forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i it "selects the child of the selected node at the given position" pending describe "forestCursorSelectBelowAtStart" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectBelowAtStart @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectBelowAtStart @Bool it "is a movement" $ isMovementM forestCursorSelectBelowAtStart it "selects the first child of the selected node" pending describe "forestCursorSelectBelowAtEnd" $ do - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorSelectBelowAtEnd @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorSelectBelowAtEnd @Bool it "is a movement" $ isMovementM forestCursorSelectBelowAtEnd it "selects the first child of the selected node" pending collapseSpec :: Spec collapseSpec = do describe "forestCursorOpenCurrentForest" $ - it "produces valid cursors" $ - producesValidsOnValids $ forestCursorOpenCurrentForest @Rational @Rational + it "produces valid cursors" $ producesValidsOnValids $ forestCursorOpenCurrentForest @Bool @Bool describe "forestCursorCloseCurrentForest" $ it "produces valid cursors" $ - producesValidsOnValids $ forestCursorCloseCurrentForest @Rational @Rational + producesValidsOnValids $ forestCursorCloseCurrentForest @Bool @Bool describe "forestCursorToggleCurrentForest" $ it "produces valid cursors" $ - producesValidsOnValids $ forestCursorToggleCurrentForest @Double @Double + producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool describe "forestCursorOpenCurrentForestRecursively" $ it "produces valid cursors" $ - producesValidsOnValids $ forestCursorToggleCurrentForest @Rational @Rational + producesValidsOnValids $ forestCursorToggleCurrentForest @Bool @Bool describe "forestCursorToggleCurrentForestRecursively" $ it "produces valid cursors" $ - producesValidsOnValids $ - forestCursorToggleCurrentForestRecursively @Rational @Rational + producesValidsOnValids $ forestCursorToggleCurrentForestRecursively @Bool @Bool insertSpec :: Spec insertSpec = do describe "forestCursorInsertEntireTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsertEntireTree @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertEntireTree @Bool @Bool) it "inserts a tree cursor before the currently selected tree cursor" pending describe "forestCursorInsertAndSelectTreeCursor" $ do it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Rational) - it - "inserts a tree cursor before the currently selected tree cursor and selects it" - pending + producesValidsOnValids2 (forestCursorInsertAndSelectTreeCursor @Bool) + it "inserts a tree cursor before the currently selected tree cursor and selects it" pending describe "forestCursorAppendEntireTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppendEntireTree @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendEntireTree @Bool @Bool) it "appends a tree after the currently selected tree cursor" pending describe "forestCursorAppendAndSelectTreeCursor" $ do it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Rational) - it - "appends a tree cursor after the currently selected tree cursor and selects it" - pending + producesValidsOnValids2 (forestCursorAppendAndSelectTreeCursor @Bool) + it "appends a tree cursor after the currently selected tree cursor and selects it" pending describe "forestCursorInsertTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsertTree @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertTree @Bool @Bool) it "inserts a tree before the currently selected tree" pending describe "forestCursorInsertAndSelectTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsertAndSelectTree @Rational) - it - "inserts a tree before the currently selected tree and selects it" - pending + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelectTree @Bool) + it "inserts a tree before the currently selected tree and selects it" pending describe "forestCursorAppendTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppendTree @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendTree @Bool @Bool) it "appends a tree after the currently selected tree " pending describe "forestCursorAppendAndSelectTree" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppendAndSelectTree @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelectTree @Bool) it "appends a tree after the currently selected tree and selects it" pending describe "forestCursorInsert" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsert @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsert @Bool @Bool) it "inserts a node before the currently selected node" pending describe "forestCursorInsertAndSelect" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorInsertAndSelect @Rational) - it - "inserts a node before the currently selected node and selects it" - pending + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorInsertAndSelect @Bool) + it "inserts a node before the currently selected node and selects it" pending describe "forestCursorAppend" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppend @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppend @Bool @Bool) it "appends a node after the currently selected node" pending describe "forestCursorAppendAndSelect" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAppendAndSelect @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAppendAndSelect @Bool) it "appends a node after the currently selected node and selects it" pending describe "forestCursorAddChildTreeToNodeAtPos" $ do it "produces valid cursors" $ - producesValidsOnValids3 $ - forestCursorAddChildTreeToNodeAtPos @Rational @Rational - it - "adds a child tree to a node at the given position in the children of that node" - pending + producesValidsOnValids3 $ forestCursorAddChildTreeToNodeAtPos @Bool @Bool + it "adds a child tree to a node at the given position in the children of that node" pending describe "forestCursorAddChildTreeToNodeAtStart" $ do it "produces valid cursors" $ - producesValidsOnValids2 $ - forestCursorAddChildTreeToNodeAtStart @Rational @Rational - it - "adds a child tree to a node at the start the children of that node" - pending + producesValidsOnValids2 $ forestCursorAddChildTreeToNodeAtStart @Bool @Bool + it "adds a child tree to a node at the start the children of that node" pending describe "forestCursorAddChildTreeToNodeAtEnd" $ do it "produces valid cursors" $ - producesValidsOnValids2 $ - forestCursorAddChildTreeToNodeAtEnd @Rational @Rational - it - "adds a child tree to a node at the end the children of that node" - pending + producesValidsOnValids2 $ forestCursorAddChildTreeToNodeAtEnd @Bool @Bool + it "adds a child tree to a node at the end the children of that node" pending describe "forestCursorAddChildToNodeAtPos" $ do it "produces valid cursors" $ - producesValidsOnValids3 $ - forestCursorAddChildToNodeAtPos @Rational @Rational - it - "adds a child to a node at the given position in the children of that node" - pending + producesValidsOnValids3 $ forestCursorAddChildToNodeAtPos @Bool @Bool + it "adds a child to a node at the given position in the children of that node" pending describe "forestCursorAddChildToNodeAtStart" $ do it "produces valid cursors" $ - producesValidsOnValids2 $ - forestCursorAddChildToNodeAtStart @Rational @Rational + producesValidsOnValids2 $ forestCursorAddChildToNodeAtStart @Bool @Bool it "adds a child to a node at the start the children of that node" pending describe "forestCursorAddChildToNodeAtEnd" $ do it "produces valid cursors" $ - producesValidsOnValids2 $ - forestCursorAddChildToNodeAtEnd @Rational @Rational + producesValidsOnValids2 $ forestCursorAddChildToNodeAtEnd @Bool @Bool it "adds a child to a node at the end the children of that node" pending describe "forestCursorAddRoot" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (forestCursorAddRoot @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (forestCursorAddRoot @Bool) it "houses the entire forest under the given node" pending swapSpec :: Spec swapSpec = do describe "forestCursorSwapPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorSwapPrev @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorSwapPrev @Bool @Bool) it "works on the example from the docs" $ let start = ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = [CNode 'a' $ emptyCForest] + { nonEmptyCursorPrev = [CNode 'a' emptyCForest] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'b' - , treeBelow = emptyCForest - } + {treeAbove = Nothing, treeCurrent = 'b', treeBelow = emptyCForest} , nonEmptyCursorNext = [] } } @@ -376,25 +306,20 @@ { nonEmptyCursorPrev = [] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'b' - , treeBelow = emptyCForest - } - , nonEmptyCursorNext = [CNode 'a' $ emptyCForest] + {treeAbove = Nothing, treeCurrent = 'b', treeBelow = emptyCForest} + , nonEmptyCursorNext = [CNode 'a' emptyCForest] } } in case forestCursorSwapPrev start of - Nothing -> - expectationFailure "forestCursorSwapPrev should not have failed." + Nothing -> expectationFailure "forestCursorSwapPrev should not have failed." Just r -> r `forestShouldBe` end it "swaps the current node with the previous node on the same level" pending it "reverts forestCursorSwapNext" $ inverseFunctionsIfSucceedOnValid - (forestCursorSwapNext @Rational @Rational) - (forestCursorSwapPrev @Rational @Rational) + (forestCursorSwapNext @Bool @Bool) + (forestCursorSwapPrev @Bool @Bool) describe "forestCursorSwapNext" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorSwapNext @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorSwapNext @Bool @Bool) it "works on the example from the docs" $ let start = ForestCursor @@ -403,42 +328,34 @@ { nonEmptyCursorPrev = [] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'a' - , treeBelow = emptyCForest - } - , nonEmptyCursorNext = [CNode 'b' $ emptyCForest] + {treeAbove = Nothing, treeCurrent = 'a', treeBelow = emptyCForest} + , nonEmptyCursorNext = [CNode 'b' emptyCForest] } } end = ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = [CNode 'b' $ emptyCForest] + { nonEmptyCursorPrev = [CNode 'b' emptyCForest] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'a' - , treeBelow = emptyCForest - } + {treeAbove = Nothing, treeCurrent = 'a', treeBelow = emptyCForest} , nonEmptyCursorNext = [] } } in case forestCursorSwapNext start of - Nothing -> - expectationFailure "forestCursorSwapNext should not have failed." + Nothing -> expectationFailure "forestCursorSwapNext should not have failed." Just r -> r `forestShouldBe` end it "swaps the current node with the next node on the same level" pending it "reverts forestCursorSwapPrev" $ inverseFunctionsIfSucceedOnValid - (forestCursorSwapPrev @Rational @Rational) - (forestCursorSwapNext @Rational @Rational) + (forestCursorSwapPrev @Bool @Bool) + (forestCursorSwapNext @Bool @Bool) deleteSpec :: Spec deleteSpec = do describe "forestCursorRemoveElemAndSelectPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Bool) it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = @@ -465,8 +382,7 @@ "forestCursorRemoveElemAndSelectPrev should not have updated the forest cursor, but failed instead." it "removes the selected element and selects the previous element" pending describe "forestCursorDeleteElemAndSelectNext" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Bool) it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = @@ -499,16 +415,14 @@ } in case forestCursorDeleteElemAndSelectNext simpleDeleteElemStart of Nothing -> - expectationFailure - "forestCursorDeleteElemAndSelectNext should not have failed." + expectationFailure "forestCursorDeleteElemAndSelectNext should not have failed." Just Deleted -> expectationFailure "forestCursorDeleteElemAndSelectNext should not have deleted the entire example forest." Just (Updated f) -> f `shouldBe` simpleDeleteElemExpected it "deletes the selected element and selects the next element" pending describe "forestCursorRemoveElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorRemoveElem @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveElem @Bool) it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = @@ -546,8 +460,7 @@ Updated f -> f `shouldBe` simpleDeleteElemExpected it "removes the selected element" pending describe "forestCursorDeleteElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorDeleteElem @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteElem @Bool) it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = @@ -586,26 +499,23 @@ it "deletes the selected element" pending describe "forestCursorRemoveSubTreeAndSelectPrev" $ do it "produces valid cursors" $ - producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Rational) + producesValidsOnValids (forestCursorRemoveSubTreeAndSelectPrev @Bool) it "removes the selected subtree and selects the previous tree" pending describe "forestCursorDeleteSubTreeAndSelectNext" $ do it "produces valid cursors" $ - producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Rational) + producesValidsOnValids (forestCursorDeleteSubTreeAndSelectNext @Bool) it "deletes the selected subtree and selects the next tree" pending describe "forestCursorRemoveSubTree" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorRemoveSubTree @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorRemoveSubTree @Bool) it "removes the selected subtree" pending describe "forestCursorDeleteSubTree" $ do - it "produces valid cursors" $ - producesValidsOnValids (forestCursorDeleteSubTree @Rational) + it "produces valid cursors" $ producesValidsOnValids (forestCursorDeleteSubTree @Bool) it "deletes the selected subtree" pending shiftingSpec :: Spec shiftingSpec = do describe "forestCursorPromoteElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ forestCursorPromoteElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ forestCursorPromoteElem @Bool it "works on the example from the documentation" $ let start = ForestCursor @@ -617,17 +527,15 @@ { treeAbove = Just TreeAbove - { treeAboveLefts = - [CNode 'b' $ closedForest [Node 'c' []]] + { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]] , treeAboveAbove = Nothing , treeAboveNode = 'a' - , treeAboveRights = - [CNode 'f' $ closedForest [Node 'g' []]] + , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]] } , treeCurrent = 'd' , treeBelow = closedForest [Node 'e' []] } - , nonEmptyCursorNext = [CNode 'h' $ emptyCForest] + , nonEmptyCursorNext = [CNode 'h' emptyCForest] } } expected = @@ -638,36 +546,28 @@ [ CNode 'a' $ openForest [ CNode 'b' $ - openForest - [CNode 'c' emptyCForest, CNode 'e' emptyCForest] + openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest] , CNode 'f' $ closedForest [Node 'g' []] ] ] , nonEmptyCursorCurrent = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'd' - , treeBelow = emptyCForest - } + {treeAbove = Nothing, treeCurrent = 'd', treeBelow = emptyCForest} , nonEmptyCursorNext = [CNode 'h' emptyCForest] } } in case forestCursorPromoteElem start of - Nothing -> - expectationFailure - "forestCursorPromoteElem should not have failed." + Nothing -> expectationFailure "forestCursorPromoteElem should not have failed." Just f -> f `forestShouldBe` expected it "promotes the current node to the level of its parent" pending describe "forestCursorDemoteElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ forestCursorDemoteElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ forestCursorDemoteElem @Bool it "works on the example from the documentation" $ let start = ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = - [CNode 'a' $ closedForest [Node 'b' []]] + { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]] , nonEmptyCursorCurrent = TreeCursor { treeAbove = Nothing @@ -687,26 +587,23 @@ { treeAbove = Just TreeAbove - { treeAboveLefts = [CNode 'b' $ emptyCForest] + { treeAboveLefts = [CNode 'b' emptyCForest] , treeAboveAbove = Nothing , treeAboveNode = 'a' - , treeAboveRights = [CNode 'd' $ emptyCForest] + , treeAboveRights = [CNode 'd' emptyCForest] } , treeCurrent = 'c' , treeBelow = emptyCForest } - , nonEmptyCursorNext = [CNode 'e' $ emptyCForest] + , nonEmptyCursorNext = [CNode 'e' emptyCForest] } } in case forestCursorDemoteElem start of - Nothing -> - expectationFailure - "forestCursorDemoteElem should not have failed." + Nothing -> expectationFailure "forestCursorDemoteElem should not have failed." Just f -> f `forestShouldBe` expected it "demotes the current node to the level of its children" pending describe "forestCursorPromoteSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ forestCursorPromoteSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ forestCursorPromoteSubTree @Bool it "works on the example from the documentation" $ let start = ForestCursor @@ -718,12 +615,10 @@ { treeAbove = Just TreeAbove - { treeAboveLefts = - [CNode 'b' $ closedForest [Node 'c' []]] + { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]] , treeAboveAbove = Nothing , treeAboveNode = 'a' - , treeAboveRights = - [CNode 'f' $ closedForest [Node 'g' []]] + , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]] } , treeCurrent = 'd' , treeBelow = closedForest [Node 'e' []] @@ -752,21 +647,17 @@ } } in case forestCursorPromoteSubTree start of - Nothing -> - expectationFailure - "forestCursorPromoteSubTree should not have failed." + Nothing -> expectationFailure "forestCursorPromoteSubTree should not have failed." Just f -> f `forestShouldBe` expected it "promotes the current subtree to the level of its parent" pending describe "forestCursorDemoteSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ forestCursorDemoteSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ forestCursorDemoteSubTree @Bool it "works on the example from the documentation" $ let start = ForestCursor { forestCursorListCursor = NonEmptyCursor - { nonEmptyCursorPrev = - [CNode 'a' $ closedForest [Node 'b' []]] + { nonEmptyCursorPrev = [CNode 'a' $ closedForest [Node 'b' []]] , nonEmptyCursorCurrent = TreeCursor { treeAbove = Nothing @@ -798,14 +689,12 @@ } } in case forestCursorDemoteSubTree start of - Nothing -> - expectationFailure - "forestCursorDemoteSubTree should not have failed." + Nothing -> expectationFailure "forestCursorDemoteSubTree should not have failed." Just f -> f `forestShouldBe` expected it "demotes the current subtree to the level of its children" pending describe "forestCursorDemoteElemUnder" $ do it "produces valids on valids" $ - producesValidsOnValids3 $ forestCursorDemoteElemUnder @Rational @Rational + producesValidsOnValids3 $ forestCursorDemoteElemUnder @Bool @Bool it "Works on the example from the docs" $ forAllValid $ \b1 -> forAllValid $ \b2 -> @@ -840,13 +729,11 @@ } , nonEmptyCursorNext = [CNode b2 $ closedForest [Node 'b' []]] } - in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe` - demoteEnd + in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe` demoteEnd it "demotes the current node to the level of its children" pending describe "forestCursorDemoteSubTreeUnder" $ do it "produces valids on valids" $ - producesValidsOnValids2 $ - forestCursorDemoteSubTreeUnder @Rational @Rational + producesValidsOnValids2 $ forestCursorDemoteSubTreeUnder @Bool @Bool it "Works on the example from the docs" $ forAllValid $ \v -> do let demoteStart = @@ -881,12 +768,9 @@ , nonEmptyCursorNext = [] } forestCursorDemoteSubTreeUnder v demoteStart `forestShouldBe` demoteEnd - it - "demotes the current subtree to the level of its children, by adding a root" - pending + it "demotes the current subtree to the level of its children, by adding a root" pending -isMovementM :: - (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property +isMovementM :: (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property isMovementM func = forAllValid @(SFC.ForestCursor Int) $ \lec -> case func lec of @@ -906,11 +790,9 @@ isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property isMovement func = forAllValid $ \lec -> - rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe` - rebuildForestCursor (func lec) + rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe` rebuildForestCursor (func lec) -forestShouldBe :: - (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation +forestShouldBe :: (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation forestShouldBe actual expected = unless (actual == expected) $ expectationFailure $ diff --git a/test/Cursor/Simple/List/NonEmptySpec.hs b/test/Cursor/Simple/List/NonEmptySpec.hs --- a/test/Cursor/Simple/List/NonEmptySpec.hs +++ b/test/Cursor/Simple/List/NonEmptySpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -20,150 +19,118 @@ spec :: Spec spec = do - eqSpec @(NonEmptyCursor Int) - genValidSpec @(NonEmptyCursor Rational) - shrinkValidSpec @(NonEmptyCursor Rational) + eqSpec @(NonEmptyCursor Bool) + genValidSpec @(NonEmptyCursor Bool) describe "makeNonEmptyCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (makeNonEmptyCursor @Rational) + it "produces valid cursors" $ producesValidsOnValids (makeNonEmptyCursor @Bool) describe "makeNonEmptyCursorWithSelection" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Rational) - it - "is the inverse of rebuildNonEmptyCursor when using the current selection" $ + it "produces valid cursors" $ producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Bool) + it "is the inverse of rebuildNonEmptyCursor when using the current selection" $ forAllValid $ \lec -> makeNonEmptyCursorWithSelection - (nonEmptyCursorSelection @Rational lec) + (nonEmptyCursorSelection @Bool lec) (rebuildNonEmptyCursor lec) `shouldBe` Just lec describe "singletonNonEmptyCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (singletonNonEmptyCursor @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (singletonNonEmptyCursor @Bool @Bool) describe "rebuildNonEmptyCursor" $ do - it "produces valid nonempty lists" $ - producesValidsOnValids (rebuildNonEmptyCursor @Rational) + it "produces valid nonempty lists" $ producesValidsOnValids (rebuildNonEmptyCursor @Bool) it "is the inverse of makeNonEmptyCursor for integers" $ inverseFunctions (makeNonEmptyCursor @Int) rebuildNonEmptyCursor - it - "is the inverse of makeNonEmptyCursorWithSelection for integers, for any index" $ + it "is the inverse of makeNonEmptyCursorWithSelection for integers, for any index" $ forAll genUnchecked $ \i -> inverseFunctionsIfFirstSucceedsOnValid (makeNonEmptyCursorWithSelection @Int i) rebuildNonEmptyCursor - describe "nonEmptyCursorElemL" $ - lensSpecOnValid (nonEmptyCursorElemL @Rational @Rational) + describe "nonEmptyCursorElemL" $ lensSpecOnValid (nonEmptyCursorElemL @Bool @Bool) describe "nonEmptyCursorSelectPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorSelectPrev @Rational) + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectPrev @Bool) it "is a movement" $ isMovementM nonEmptyCursorSelectPrev it "selects the previous element" pending describe "nonEmptyCursorSelectNext" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorSelectNext @Rational) + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectNext @Bool) it "is a movement" $ isMovementM nonEmptyCursorSelectNext it "selects the next element" pending describe "nonEmptyCursorSelectFirst" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorSelectFirst @Rational) + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectFirst @Bool) it "is a movement" $ isMovement nonEmptyCursorSelectFirst - it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Rational) + it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectFirst @Bool) it "selects the first element" pending describe "nonEmptyCursorSelectLast" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorSelectLast @Rational) + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorSelectLast @Bool) it "is a movement" $ isMovement nonEmptyCursorSelectLast - it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Rational) + it "is idempotent" $ idempotentOnValid (nonEmptyCursorSelectLast @Bool) it "selects the last element" pending describe "nonEmptyCursorSelection" $ do - it "produces valid ints" $ - producesValidsOnValids (nonEmptyCursorSelection @Rational @Rational) + it "produces valid ints" $ producesValidsOnValids (nonEmptyCursorSelection @Bool @Bool) it "returns the index of the currently selected element" pending describe "nonEmptyCursorSelectIndex" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (nonEmptyCursorSelectIndex @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (nonEmptyCursorSelectIndex @Bool) it "is the identity function when given the current selection" $ forAllValid $ \nec -> nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe` - Just (nec :: NonEmptyCursor Rational) + Just (nec :: NonEmptyCursor Bool) it "returns selects the element at the given index" pending describe "nonEmptyCursorInsert" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorInsert @Rational @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsert @Bool @Bool d) it "inserts a character before the cursor" pending describe "nonEmptyCursorAppend" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorAppend @Rational @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppend @Bool @Bool d) it "inserts a character after the cursor" pending describe "nonEmptyCursorInsertAndSelect" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorInsertAndSelect @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAndSelect @Bool d) it "inserts a character before the cursor and selects it" pending describe "nonEmptyCursorAppendAndSelect" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorAppendAndSelect @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAndSelect @Bool d) it "appends a character before the cursor and selects it" pending describe "nonEmptyCursorInsertAtStart" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids - (nonEmptyCursorInsertAtStart @Rational @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAtStart @Bool @Bool d) it "inserts a character at the start of the list" pending describe "nonEmptyCursorAppendAtEnd" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorAppendAtEnd @Rational @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAtEnd @Bool @Bool d) it "inserts a character at the end of the list" pending describe "nonEmptyCursorInsertAtStartAndSelect" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids - (nonEmptyCursorInsertAtStartAndSelect @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorInsertAtStartAndSelect @Bool d) it "inserts a character at the start of the list and selects it" pending describe "nonEmptyCursorAppendAtEndAndSelect" $ do it "produces valid cursors" $ - forAllValid $ \d -> - producesValidsOnValids (nonEmptyCursorAppendAtEndAndSelect @Rational d) + forAllValid $ \d -> producesValidsOnValids (nonEmptyCursorAppendAtEndAndSelect @Bool d) it "appends a character at the end of the list and selects it" pending describe "nonEmptyCursorRemoveElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorRemoveElem @Rational) + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorRemoveElem @Bool) it "removes an element" pending - describe "nonEmptyCursorDeleteElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (nonEmptyCursorDeleteElem @Rational) + describe "nonEmptyCursorDeleteElem" $ + it "produces valid cursors" $ producesValidsOnValids (nonEmptyCursorDeleteElem @Bool) describe "nonEmptyCursorSearch" $ do it "produces valid cursors when looking for an equal element" $ - forAllValid $ \a -> - producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Rational)) - it - "is indeed the right value when it finds a value and is looking for an equal element" $ + forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Bool)) + it "is indeed the right value when it finds a value and is looking for an equal element" $ forAllValid $ \a -> forAllValid $ \nec -> - case nonEmptyCursorSearch (== (a :: Rational)) nec of + case nonEmptyCursorSearch (== (a :: Bool)) nec of Nothing -> pure () Just e -> nonEmptyCursorCurrent e `shouldBe` a it "finds an element if it is in there" $ forAllValid $ \a -> forAll (nonEmptyWith a genValid) $ \nec -> - case nonEmptyCursorSearch (== (a :: Rational)) nec of - Nothing -> - expectationFailure "Should not have failed to find the element." + case nonEmptyCursorSearch (== (a :: Bool)) nec of + Nothing -> expectationFailure "Should not have failed to find the element." Just e -> nonEmptyCursorCurrent e `shouldBe` a - describe "nonEmptyCursorSelectOrAdd" $ do + describe "nonEmptyCursorSelectOrAdd" $ it "produces valid cursors when looking for an equal element" $ - forAllValid $ \a -> - producesValidsOnValids $ - nonEmptyCursorSelectOrAdd (== a) (a :: Rational) + forAllValid $ \a -> producesValidsOnValids $ nonEmptyCursorSelectOrAdd (== a) (a :: Bool) -isMovementM :: - (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property +isMovementM :: (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property isMovementM func = forAllValid $ \lec -> - case func (lec :: NonEmptyCursor Rational) of + case func (lec :: NonEmptyCursor Bool) of Nothing -> pure () -- Fine Just lec' -> let ne = rebuildNonEmptyCursor lec @@ -180,5 +147,4 @@ isMovement :: (forall a. NonEmptyCursor a -> NonEmptyCursor a) -> Property isMovement func = forAllValid $ \lec -> - rebuildNonEmptyCursor (lec :: NonEmptyCursor Rational) `shouldBe` - rebuildNonEmptyCursor (func lec) + rebuildNonEmptyCursor (lec :: NonEmptyCursor Bool) `shouldBe` rebuildNonEmptyCursor (func lec) diff --git a/test/Cursor/Simple/Map/KeyValueSpec.hs b/test/Cursor/Simple/Map/KeyValueSpec.hs --- a/test/Cursor/Simple/Map/KeyValueSpec.hs +++ b/test/Cursor/Simple/Map/KeyValueSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -19,34 +18,27 @@ spec = do describe "makeKeyValueCursorKey" $ it "produces valid cursors" $ - producesValidsOnValids2 - (makeKeyValueCursorKey @Rational @Rational @Rational @Rational) + producesValidsOnValids2 (makeKeyValueCursorKey @Bool @Bool @Bool @Bool) describe "makeKeyValueCursorValue" $ it "produces valid cursors" $ - producesValidsOnValids2 - (makeKeyValueCursorValue @Rational @Rational @Rational @Rational) + producesValidsOnValids2 (makeKeyValueCursorValue @Bool @Bool @Bool @Bool) describe "rebuildKeyValueCursor" $ - it "produces valid tuples" $ - producesValidsOnValids (rebuildKeyValueCursor @Rational @Rational) + it "produces valid tuples" $ producesValidsOnValids (rebuildKeyValueCursor @Bool @Bool) describe "keyValueCursorSelection" $ it "produces valid selections" $ - producesValidsOnValids - (keyValueCursorSelection @Rational @Rational @Rational @Rational) + producesValidsOnValids (keyValueCursorSelection @Bool @Bool @Bool @Bool) describe "keyValueCursorSelectKey" $ do - it "produces valid cursors" $ - producesValidsOnValids (keyValueCursorSelectKey @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectKey @Bool @Bool) it "is a movement" $ isMovement keyValueCursorSelectKey describe "keyValueCursorSelectValue" $ do - it "produces valid cursors" $ - producesValidsOnValids (keyValueCursorSelectValue @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (keyValueCursorSelectValue @Bool @Bool) it "is a movement" $ isMovement keyValueCursorSelectValue describe "keyValueCursorToggleSelected" $ do - it "produces valid cursors" $ - producesValidsOnValids (keyValueCursorToggleSelected @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (keyValueCursorToggleSelected @Bool @Bool) it "is a movement" $ isMovement keyValueCursorToggleSelected isMovement :: (forall k v. KeyValueCursor k v -> KeyValueCursor k v) -> Property isMovement func = forAllValid $ \lec -> - rebuildKeyValueCursor (lec :: KeyValueCursor Rational Rational) `shouldBe` + rebuildKeyValueCursor (lec :: KeyValueCursor Bool Bool) `shouldBe` rebuildKeyValueCursor (func lec) diff --git a/test/Cursor/Simple/MapSpec.hs b/test/Cursor/Simple/MapSpec.hs --- a/test/Cursor/Simple/MapSpec.hs +++ b/test/Cursor/Simple/MapSpec.hs @@ -21,133 +21,100 @@ spec :: Spec spec = do describe "makeMapCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (makeMapCursor @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (makeMapCursor @Bool @Bool) describe "makeMapCursorWithSelection" $ - it "produces valid cursors" $ - producesValidsOnValids2 (makeMapCursorWithSelection @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (makeMapCursorWithSelection @Bool @Bool) describe "singletonMapCursorKey" $ it "produces valid cursors" $ - producesValidsOnValids2 - (singletonMapCursorKey @Rational @Rational @Rational @Rational) + producesValidsOnValids2 (singletonMapCursorKey @Bool @Bool @Bool @Bool) describe "singletonMapCursorValue" $ it "produces valid cursors" $ - producesValidsOnValids2 - (singletonMapCursorValue @Rational @Rational @Rational @Rational) + producesValidsOnValids2 (singletonMapCursorValue @Bool @Bool @Bool @Bool) describe "rebuildMapCursor" $ do - it "produces valid Nonempty lists" $ - producesValidsOnValids (rebuildMapCursor @Rational @Rational) + it "produces valid Nonempty lists" $ producesValidsOnValids (rebuildMapCursor @Bool @Bool) it "is the inverse of makeMapCursor for integers" $ - inverseFunctions (makeMapCursor @Int @Int) rebuildMapCursor + inverseFunctions (makeMapCursor @Bool @Bool) rebuildMapCursor describe "mapCursorNonEmptyCursorL" $ - lensSpecOnValid - (mapCursorNonEmptyCursorL @Rational @Rational @Rational @Rational) - describe "mapCursorElemL" $ - lensSpecOnValid (mapCursorElemL @Rational @Rational @Rational @Rational) + lensSpecOnValid (mapCursorNonEmptyCursorL @Bool @Bool @Bool @Bool) + describe "mapCursorElemL" $ lensSpecOnValid (mapCursorElemL @Bool @Bool @Bool @Bool) describe "mapCursorSelectKey" $ - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectKey @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectKey @Bool @Bool) describe "mapCursorSelectValue" $ - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectValue @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectValue @Bool @Bool) describe "mapCursorToggleSelected" $ - it "produces valid cursors" $ - producesValidsOnValids (mapCursorToggleSelected @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorToggleSelected @Bool @Bool) describe "mapCursorSelectPrev" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectPrev @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectPrev @Bool @Bool) it "is a movement" $ isMovementM mapCursorSelectPrev it "selects the previous element" pending describe "mapCursorSelectNext" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectNext @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectNext @Bool @Bool) it "is a movement" $ isMovementM mapCursorSelectNext it "selects the next element" pending describe "mapCursorSelectFirst" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectFirst @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectFirst @Bool @Bool) it "is a movement" $ isMovement mapCursorSelectFirst - it "is idempotent" $ - idempotentOnValid (mapCursorSelectFirst @Rational @Rational) + it "is idempotent" $ idempotentOnValid (mapCursorSelectFirst @Bool @Bool) it "selects the first element" pending describe "mapCursorSelectLast" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorSelectLast @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorSelectLast @Bool @Bool) it "is a movement" $ isMovement mapCursorSelectLast - it "is idempotent" $ - idempotentOnValid (mapCursorSelectLast @Rational @Rational) + it "is idempotent" $ idempotentOnValid (mapCursorSelectLast @Bool @Bool) it "selects the last element" pending describe "mapCursorSelection" $ do - it "produces valid ints" $ - producesValidsOnValids - (mapCursorSelection @Rational @Rational @Rational @Rational) + it "produces valid ints" $ producesValidsOnValids (mapCursorSelection @Bool @Bool @Bool @Bool) it "returns the index of the currently selected element" pending describe "mapCursorSelectIndex" $ do - it "produces valid cursors" $ - producesValidsOnValids2 (mapCursorSelectIndex @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (mapCursorSelectIndex @Bool @Bool) it "is the identity function when given the current selection" $ forAllValid $ \nec -> mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe` - Just (nec :: MapCursor Rational Rational) + Just (nec :: MapCursor Bool Bool) it "returns selects the element at the given index" pending describe "mapCursorInsert" $ do - it "produces valid cursors" $ - producesValidsOnValids3 - (mapCursorInsert @Rational @Rational @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsert @Bool @Bool @Bool @Bool) it "inserts a character before the cursor" pending describe "mapCursorAppend" $ do - it "produces valid cursors" $ - producesValidsOnValids3 - (mapCursorAppend @Rational @Rational @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppend @Bool @Bool @Bool @Bool) it "inserts a character after the cursor" pending - describe "mapCursorInsertAndSelectKey" $ do - it "produces valid cursors" $ - producesValidsOnValids3 (mapCursorInsertAndSelectKey @Rational @Rational) - describe "mapCursorAppendAndSelectKey" $ do - it "produces valid cursors" $ - producesValidsOnValids3 (mapCursorAppendAndSelectKey @Rational @Rational) - describe "mapCursorInsertAndSelectValue" $ do + describe "mapCursorInsertAndSelectKey" $ + it "produces valid cursors" $ producesValidsOnValids3 (mapCursorInsertAndSelectKey @Bool @Bool) + describe "mapCursorAppendAndSelectKey" $ + it "produces valid cursors" $ producesValidsOnValids3 (mapCursorAppendAndSelectKey @Bool @Bool) + describe "mapCursorInsertAndSelectValue" $ it "produces valid cursors" $ - producesValidsOnValids3 - (mapCursorInsertAndSelectValue @Rational @Rational) - describe "mapCursorAppendAndSelectValue" $ do + producesValidsOnValids3 (mapCursorInsertAndSelectValue @Bool @Bool) + describe "mapCursorAppendAndSelectValue" $ it "produces valid cursors" $ - producesValidsOnValids3 - (mapCursorAppendAndSelectValue @Rational @Rational) + producesValidsOnValids3 (mapCursorAppendAndSelectValue @Bool @Bool) describe "mapCursorRemoveElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorRemoveElem @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorRemoveElem @Bool @Bool) it "removes an element" pending describe "mapCursorDeleteElem" $ do - it "produces valid cursors" $ - producesValidsOnValids (mapCursorDeleteElem @Rational @Rational) + it "produces valid cursors" $ producesValidsOnValids (mapCursorDeleteElem @Bool @Bool) it "deletes an element" pending describe "mapCursorSearch" $ do it "produces valid cursors when looking for an equal pair" $ forAllValid $ \(k, v) -> - producesValidsOnValids $ - mapCursorSearch @Rational @Rational (\k_ v_ -> k_ == k && v_ == v) - it - "is indeed the right value when it finds a value and is looking for an equal element" $ + producesValidsOnValids $ mapCursorSearch @Bool @Bool (\k_ v_ -> k_ == k && v_ == v) + it "is indeed the right value when it finds a value and is looking for an equal element" $ forAllValid $ \(k, v) -> forAllValid $ \nec -> case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of Nothing -> pure () - Just e -> - rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe` - (k :: Rational, v :: Rational) - describe "mapCursorSelectOrAdd" $ do + Just e -> rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe` (k :: Bool, v :: Bool) + describe "mapCursorSelectOrAdd" $ it "produces valid cursors when looking for an equal element" $ - forAllValid $ \(k, v) -> - producesValidsOnValids $ - mapCursorSelectOrAdd - (\k_ v_ -> k_ == k && v_ == v) - (makeKeyValueCursorKey (k :: Rational) (v :: Rational)) + forAllValid $ \(k, v) -> + producesValidsOnValids $ + mapCursorSelectOrAdd + (\k_ v_ -> k_ == k && v_ == v) + (makeKeyValueCursorKey (k :: Bool) (v :: Bool)) isMovementM :: (forall k v. MapCursor k v -> Maybe (MapCursor k v)) -> Property isMovementM func = forAllValid $ \lec -> - case func (lec :: MapCursor Rational Rational) of + case func (lec :: MapCursor Bool Bool) of Nothing -> pure () -- Fine Just lec' -> let ne = rebuildMapCursor lec @@ -164,5 +131,4 @@ isMovement :: (forall k v. MapCursor k v -> MapCursor k v) -> Property isMovement func = forAllValid $ \lec -> - rebuildMapCursor (lec :: MapCursor Int Int) `shouldBe` - rebuildMapCursor (func lec) + rebuildMapCursor (lec :: MapCursor Bool Bool) `shouldBe` rebuildMapCursor (func lec) diff --git a/test/Cursor/Simple/Tree/BaseSpec.hs b/test/Cursor/Simple/Tree/BaseSpec.hs --- a/test/Cursor/Simple/Tree/BaseSpec.hs +++ b/test/Cursor/Simple/Tree/BaseSpec.hs @@ -21,28 +21,19 @@ spec :: Spec spec = do eqSpec @(STC.TreeCursor Int) - genValidSpec @(STC.TreeCursor Rational) + genValidSpec @(STC.TreeCursor Bool) describe "makeTreeCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (makeTreeCursor @Rational) + it "produces valid cursors" $ producesValidsOnValids (makeTreeCursor @Bool) describe "makeTreeCursorWithSelection" $ - it "produces valid cursors" $ - producesValidsOnValids2 (makeTreeCursorWithSelection @Rational) + it "produces valid cursors" $ producesValidsOnValids2 (makeTreeCursorWithSelection @Bool) describe "singletonTreeCursor" $ - it "produces valid cursors" $ - producesValidsOnValids (singletonTreeCursor @Rational) + it "produces valid cursors" $ producesValidsOnValids (singletonTreeCursor @Bool) describe "rebuildTreeCursor" $ do - it "produces valid trees" $ - producesValidsOnValids (rebuildTreeCursor @Rational) + it "produces valid trees" $ producesValidsOnValids (rebuildTreeCursor @Bool) it "is the inverse of makeTreeCursor for integers" $ inverseFunctions (makeTreeCursor @Int) rebuildTreeCursor it "is the inverse of makeTreeCursorWithSelection for the current selection" $ forAllValid $ \tc -> - case makeTreeCursorWithSelection - @Rational - (treeCursorSelection tc) - (rebuildTreeCursor tc) of - Nothing -> - expectationFailure - "makeTreeCursorWithSelection should not have failed." + case makeTreeCursorWithSelection @Bool (treeCursorSelection tc) (rebuildTreeCursor tc) of + Nothing -> expectationFailure "makeTreeCursorWithSelection should not have failed." Just r -> r `treeShouldBe` tc diff --git a/test/Cursor/Simple/Tree/CollapseSpec.hs b/test/Cursor/Simple/Tree/CollapseSpec.hs --- a/test/Cursor/Simple/Tree/CollapseSpec.hs +++ b/test/Cursor/Simple/Tree/CollapseSpec.hs @@ -17,19 +17,14 @@ spec :: Spec spec = do describe "treeCursorOpenCurrentForest" $ - it "produces valid cursors" $ - producesValidsOnValids $ treeCursorOpenCurrentForest @Rational @Rational + it "produces valid cursors" $ producesValidsOnValids $ treeCursorOpenCurrentForest @Bool @Bool describe "treeCursorCloseCurrentForest" $ - it "produces valid cursors" $ - producesValidsOnValids $ treeCursorCloseCurrentForest @Rational @Rational + it "produces valid cursors" $ producesValidsOnValids $ treeCursorCloseCurrentForest @Bool @Bool describe "treeCursorToggleCurrentForest" $ - it "produces valid cursors" $ - producesValidsOnValids $ treeCursorToggleCurrentForest @Rational @Rational + it "produces valid cursors" $ producesValidsOnValids $ treeCursorToggleCurrentForest @Bool @Bool describe "treeCursorOpenCurrentForestRecursively" $ it "produces valid cursors" $ - producesValidsOnValids $ - treeCursorOpenCurrentForestRecursively @Double @Double + producesValidsOnValids $ treeCursorOpenCurrentForestRecursively @Bool @Bool describe "treeCursorToggleCurrentForestRecursively" $ it "produces valid cursors" $ - producesValidsOnValids $ - treeCursorToggleCurrentForestRecursively @Double @Double + producesValidsOnValids $ treeCursorToggleCurrentForestRecursively @Bool @Bool diff --git a/test/Cursor/Simple/Tree/DeleteSpec.hs b/test/Cursor/Simple/Tree/DeleteSpec.hs --- a/test/Cursor/Simple/Tree/DeleteSpec.hs +++ b/test/Cursor/Simple/Tree/DeleteSpec.hs @@ -24,36 +24,30 @@ spec = do describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do it "produces valids on valids" $ - producesValidsOnValids $ - treeCursorDeleteSubTreeAndSelectPrevious @Rational + producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectPrevious @Bool it "deletes the current subtree selects the previous subtree" pending describe "treeCursorDeleteSubTreeAndSelectNext" $ do it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Rational + producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectNext @Bool it "deletes the current subtree selects the next subtree" pending describe "treeCursorDeleteSubTreeAndSelectAbove" $ do it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Rational + producesValidsOnValids $ treeCursorDeleteSubTreeAndSelectAbove @Bool it "deletes the current subtree selects the above node" pending describe "treeCursorRemoveSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorRemoveSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorRemoveSubTree @Bool it "removes the current subtree" pending describe "treeCursorDeleteSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteSubTree @Bool it "deletes the current subtree" pending describe "treeCursorDeleteElemAndSelectPrevious" $ do it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Rational + producesValidsOnValids $ treeCursorDeleteElemAndSelectPrevious @Bool it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = TreeCursor - { treeAbove = Nothing - , treeCurrent = 1 :: Int - , treeBelow = closedForest [Node 2 fs] - } + {treeAbove = Nothing, treeCurrent = 1 :: Int, treeBelow = closedForest [Node 2 fs]} in case treeCursorDeleteElemAndSelectPrevious simpleDeleteElemStart of Nothing -> pure () Just Deleted -> @@ -65,22 +59,16 @@ it "deletes the current element and selects the previous element" pending describe "treeCursorDeleteElemAndSelectNext" $ do it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Rational + producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Bool it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = - TreeCursor - { treeAbove = Nothing - , treeCurrent = 1 - , treeBelow = openForest [CNode 2 fs] - } + TreeCursor {treeAbove = Nothing, treeCurrent = 1, treeBelow = openForest [CNode 2 fs]} simpleDeleteElemExpected = - TreeCursor - {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs} + TreeCursor {treeAbove = Nothing, treeCurrent = 2 :: Int, treeBelow = fs} in case treeCursorDeleteElemAndSelectNext simpleDeleteElemStart of Nothing -> - expectationFailure - "treeCursorDeleteElemAndSelectNext should not have failed." + expectationFailure "treeCursorDeleteElemAndSelectNext should not have failed." Just Deleted -> expectationFailure "treeCursorDeleteElemAndSelectNext should not have deleted the entire example tree." @@ -88,15 +76,12 @@ it "deletes the current element and selects the next element" pending describe "treeCursorDeleteElemAndSelectAbove" $ do it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Rational + producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Bool it "works for this simple example" $ forAllValid $ \fs -> let simpleDeleteElemStart = TreeCursor - { treeAbove = Nothing - , treeCurrent = 1 :: Int - , treeBelow = closedForest [Node 2 fs] - } + {treeAbove = Nothing, treeCurrent = 1 :: Int, treeBelow = closedForest [Node 2 fs]} in case treeCursorDeleteElemAndSelectAbove simpleDeleteElemStart of Nothing -> pure () Just Deleted -> @@ -107,10 +92,8 @@ "treeCursorDeleteElemAndSelectAbove should not have updated the example tree, but failed instead." it "deletes the current element and selects the above element" pending describe "treeCursorRemoveElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorRemoveElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorRemoveElem @Bool it "removes the current element" pending describe "treeCursorDeleteElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDeleteElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorDeleteElem @Bool it "deletes the current element" pending diff --git a/test/Cursor/Simple/Tree/DemoteSpec.hs b/test/Cursor/Simple/Tree/DemoteSpec.hs --- a/test/Cursor/Simple/Tree/DemoteSpec.hs +++ b/test/Cursor/Simple/Tree/DemoteSpec.hs @@ -23,8 +23,7 @@ spec = do functorSpec @DemoteResult describe "treeCursorDemoteElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDemoteElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorDemoteElem @Bool it "Works on the example from the docs" $ let promoteStart = TreeCursor @@ -61,12 +60,10 @@ } in case treeCursorDemoteElem promoteStart of Demoted tc' -> tc' `treeShouldBe` promoteEnd - _ -> - expectationFailure "treeCursorDemoteElem should not have failed" + _ -> expectationFailure "treeCursorDemoteElem should not have failed" it "demotes the current node to the level of its children" pending describe "treeCursorDemoteSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorDemoteSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorDemoteSubTree @Bool it "Works on the example from the docs" $ let promoteStart = TreeCursor @@ -103,13 +100,10 @@ } in case treeCursorDemoteSubTree promoteStart of Demoted tc' -> tc' `treeShouldBe` promoteEnd - _ -> - expectationFailure - "treeCursorDemoteSubTree should not have failed" + _ -> expectationFailure "treeCursorDemoteSubTree should not have failed" it "demotes the current subtree to the level of its children" pending describe "treeCursorDemoteElemUnder" $ do - it "produces valids on valids" $ - producesValidsOnValids3 $ treeCursorDemoteElemUnder @Rational @Rational + it "produces valids on valids" $ producesValidsOnValids3 $ treeCursorDemoteElemUnder @Bool @Bool it "Works on the example from the docs" $ forAllValid $ \b1 -> forAllValid $ \b2 -> @@ -148,21 +142,16 @@ } in case treeCursorDemoteElemUnder b1 b2 demoteStart of Just tc' -> tc' `treeShouldBe` demoteEnd - _ -> - expectationFailure - "treeCursorDemoteElemUnder should not have failed" + _ -> expectationFailure "treeCursorDemoteElemUnder should not have failed" it "demotes the current node to the level of its children" pending describe "treeCursorDemoteSubTreeUnder" $ do it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorDemoteSubTreeUnder @Rational @Rational + producesValidsOnValids2 $ treeCursorDemoteSubTreeUnder @Bool @Bool it "Works on the example from the docs" $ forAllValid $ \v -> do let demoteStart = TreeCursor - { treeAbove = Nothing - , treeCurrent = 'a' - , treeBelow = closedForest [Node 'b' []] - } + {treeAbove = Nothing, treeCurrent = 'a', treeBelow = closedForest [Node 'b' []]} demoteEnd = TreeCursor { treeAbove = @@ -177,6 +166,4 @@ , treeBelow = closedForest [Node 'b' []] } treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe` demoteEnd - it - "demotes the current subtree to the level of its children, by adding a root" - pending + it "demotes the current subtree to the level of its children, by adding a root" pending diff --git a/test/Cursor/Simple/Tree/InsertSpec.hs b/test/Cursor/Simple/Tree/InsertSpec.hs --- a/test/Cursor/Simple/Tree/InsertSpec.hs +++ b/test/Cursor/Simple/Tree/InsertSpec.hs @@ -17,32 +17,23 @@ spec :: Spec spec = do describe "treeCursorInsert" $ do - it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorInsert @Rational @Rational + it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsert @Bool @Bool it "inserts the element" pending describe "treeCursorInsertAndSelect" $ do - it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorInsertAndSelect @Rational + it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorInsertAndSelect @Bool it "inserts and select the element" pending describe "treeCursorAppend" $ do - it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorAppend @Rational @Rational + it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppend @Bool @Bool it "appends the element" pending describe "treeCursorAppendAndSelect" $ do - it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorAppendAndSelect @Rational + it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorAppendAndSelect @Bool it "appends and select the element" pending describe "treeCursorAddChildAtPos" $ do - it "produces valid cursors " $ - producesValidsOnValids3 $ treeCursorAddChildAtPos @Rational @Rational - it - "adds a tree at the given index in the children of the current node" - pending + it "produces valid cursors " $ producesValidsOnValids3 $ treeCursorAddChildAtPos @Bool @Bool + it "adds a tree at the given index in the children of the current node" pending describe "treeCursorAddChildAtStart" $ do - it "produces valid cursors " $ - producesValidsOnValids2 $ treeCursorAddChildAtStart @Rational @Rational + it "produces valid cursors " $ producesValidsOnValids2 $ treeCursorAddChildAtStart @Bool @Bool it "adds a tree at the start of the children of the current node" pending describe "treeCursorAddChildAtEnd" $ do - it "produces valid cursors " $ - producesValidsOnValids2 $ treeCursorAddChildAtEnd @Rational @Rational + it "produces valid cursors " $ producesValidsOnValids2 $ treeCursorAddChildAtEnd @Bool @Bool it "adds a tree at the end of the children of the current node" pending diff --git a/test/Cursor/Simple/Tree/MovementSpec.hs b/test/Cursor/Simple/Tree/MovementSpec.hs --- a/test/Cursor/Simple/Tree/MovementSpec.hs +++ b/test/Cursor/Simple/Tree/MovementSpec.hs @@ -17,30 +17,21 @@ import Cursor.Simple.Tree hiding (TreeCursor) import Cursor.Simple.Tree.Gen () -import Cursor.Tree - ( CTree(..) - , TreeAbove(..) - , TreeCursor(..) - , emptyCForest - , openForest - ) +import Cursor.Tree (CTree(..), TreeAbove(..), TreeCursor(..), emptyCForest, openForest) import Cursor.Simple.Tree.TestUtils spec :: Spec spec = do describe "treeCursorSelection" $ - it "produces valids on valids" $ - producesValidsOnValids (treeCursorSelection @Rational @Rational) + it "produces valids on valids" $ producesValidsOnValids (treeCursorSelection @Bool @Bool) describe "treeCursorSelect" $ do - it "produces valids on valids" $ - producesValidsOnValids2 (treeCursorSelect @Rational) + it "produces valids on valids" $ producesValidsOnValids2 (treeCursorSelect @Bool) it "is identity with the current selection" $ forAllValid $ \tc -> let sel = treeCursorSelection tc - in case treeCursorSelect @Rational sel tc of - Nothing -> - expectationFailure "treeCursorSelect should not have failed." + in case treeCursorSelect @Bool sel tc of + Nothing -> expectationFailure "treeCursorSelect should not have failed." Just r -> unless (r == tc) $ expectationFailure $ @@ -55,17 +46,17 @@ describe "treeCursorSelectPrevOnSameLevel" $ do testMovementM treeCursorSelectPrevOnSameLevel it "selects the previous element" pending - it "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $ do + it "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $ inverseFunctionsIfSucceedOnValid - (treeCursorSelectNextOnSameLevel @Rational) - (treeCursorSelectPrevOnSameLevel @Rational) + (treeCursorSelectNextOnSameLevel @Bool) + (treeCursorSelectPrevOnSameLevel @Bool) describe "treeCursorSelectNextOnSameLevel" $ do testMovementM treeCursorSelectNextOnSameLevel it "selects the next element" pending - it "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ do + it "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ inverseFunctionsIfSucceedOnValid - (treeCursorSelectPrevOnSameLevel @Rational) - (treeCursorSelectNextOnSameLevel @Rational) + (treeCursorSelectPrevOnSameLevel @Bool) + (treeCursorSelectNextOnSameLevel @Bool) describe "treeCursorSelectAbovePrev" $ do testMovementM treeCursorSelectAbovePrev it "Works for this classic example" $ @@ -81,10 +72,7 @@ Just (TreeAbove { treeAboveLefts = - [ CNode 1 $ - openForest - [CNode 2 $ openForest [CNode 3 emptyCForest]] - ] + [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]] , treeAboveAbove = Nothing , treeAboveNode = 0 , treeAboveRights = [] @@ -108,8 +96,7 @@ { treeAboveLefts = [] , treeAboveAbove = Nothing , treeAboveNode = 0 - , treeAboveRights = - [CNode 4 emptyCForest] + , treeAboveRights = [CNode 4 emptyCForest] }) , treeAboveNode = 1 , treeAboveRights = [] @@ -121,19 +108,16 @@ , treeBelow = emptyCForest } case treeCursorSelectAbovePrev start of - Nothing -> - expectationFailure "treeCursorSelectAbovePrev should not have failed" + Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed" Just r -> r `treeShouldBe` expected it "selects the previous element" pending - it "after treeCursorSelectAboveNext is identity if they don't fail" $ do + it "after treeCursorSelectAboveNext is identity if they don't fail" $ forAllValid $ \tc -> - case treeCursorSelectAboveNext @Rational tc of + case treeCursorSelectAboveNext @Bool tc of Nothing -> pure () Just tc' -> case treeCursorSelectAbovePrev tc' of - Nothing -> - expectationFailure - "treeCursorSelectAbovePrev should not have failed." + Nothing -> expectationFailure "treeCursorSelectAbovePrev should not have failed." Just tc'' -> unless (tc == tc'') $ expectationFailure $ @@ -190,10 +174,7 @@ Just (TreeAbove { treeAboveLefts = - [ CNode 1 $ - openForest - [CNode 2 $ openForest [CNode 3 emptyCForest]] - ] + [CNode 1 $ openForest [CNode 2 $ openForest [CNode 3 emptyCForest]]] , treeAboveAbove = Nothing , treeAboveNode = 0 , treeAboveRights = [] @@ -202,13 +183,12 @@ , treeBelow = emptyCForest } case treeCursorSelectAboveNext start of - Nothing -> - expectationFailure "treeCursorSelectAboveNext should not have failed." + Nothing -> expectationFailure "treeCursorSelectAboveNext should not have failed." Just r -> r `treeShouldBe` expected it "selects the next element" pending - it "after treeCursorSelectAbovePrev is identity if they don't fail" $ do + it "after treeCursorSelectAbovePrev is identity if they don't fail" $ forAllValid $ \tc -> - case treeCursorSelectAbovePrev @Rational tc of + case treeCursorSelectAbovePrev @Bool tc of Nothing -> pure () Just tc' -> case treeCursorSelectAboveNext tc' of @@ -230,36 +210,30 @@ describe "treeCursorSelectPrev" $ do testMovementM treeCursorSelectPrev it "selects the previous element" pending - it "after treeCursorSelectNext is identity if they don't fail" $ do - inverseFunctionsIfSucceedOnValid - (treeCursorSelectNext @Rational) - (treeCursorSelectPrev @Rational) + it "after treeCursorSelectNext is identity if they don't fail" $ + inverseFunctionsIfSucceedOnValid (treeCursorSelectNext @Bool) (treeCursorSelectPrev @Bool) describe "treeCursorSelectNext" $ do testMovementM treeCursorSelectNext it "selects the next element" pending - it "after treeCursorSelectPrev is identity if they don't fail" $ do - inverseFunctionsIfSucceedOnValid - (treeCursorSelectPrev @Rational) - (treeCursorSelectNext @Rational) + it "after treeCursorSelectPrev is identity if they don't fail" $ + inverseFunctionsIfSucceedOnValid (treeCursorSelectPrev @Bool) (treeCursorSelectNext @Bool) describe "treeCursorSelectFirst" $ do testMovement treeCursorSelectFirst it "selects the first element" pending - it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Rational + it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Bool describe "treeCursorSelectLast" $ do testMovement treeCursorSelectLast it "selects the last element" pending - it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Rational + it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Bool describe "treeCursorSelectAbove" $ do testMovementM treeCursorSelectAbove it "selects the element above" pending - it "after treeCursorSelectBelow is identity if they don't fail" $ do - inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Rational) $ - treeCursorSelectAbove @Rational + it "after treeCursorSelectBelow is identity if they don't fail" $ + inverseFunctionsIfSucceedOnValid (treeCursorSelectBelowAtStart @Bool) $ + treeCursorSelectAbove @Bool describe "treeCursorSelectBelowAtPos" $ do - it "produces valids on valids" $ - producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Rational - it "is a movement" $ - forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n + it "produces valids on valids" $ producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Bool + it "is a movement" $ forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n it "selects the element n-th below" pending describe "treeCursorSelectBelowAtStart" $ do testMovementM treeCursorSelectBelowAtStart diff --git a/test/Cursor/Simple/Tree/PromoteSpec.hs b/test/Cursor/Simple/Tree/PromoteSpec.hs --- a/test/Cursor/Simple/Tree/PromoteSpec.hs +++ b/test/Cursor/Simple/Tree/PromoteSpec.hs @@ -32,8 +32,7 @@ applicativeSpec @PromoteElemResult monadSpec @PromoteElemResult describe "treeCursorPromoteElem" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorPromoteElem @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteElem @Bool it "Works on the example from the docs" $ let promoteStart = TreeCursor @@ -64,10 +63,7 @@ [ CNode 'a' $ openForest [ CNode 'b' $ - openForest - [ CNode 'c' emptyCForest - , CNode 'e' emptyCForest - ] + openForest [CNode 'c' emptyCForest, CNode 'e' emptyCForest] , CNode 'f' $ closedForest [Node 'g' []] ] ] @@ -80,23 +76,20 @@ } in case treeCursorPromoteElem promoteStart of PromotedElem tc' -> tc' `treeShouldBe` promoteEnd - _ -> - expectationFailure "treeCursorPromoteElem should not have failed" + _ -> expectationFailure "treeCursorPromoteElem should not have failed" it "promotes the current node to the level of its parent" pending functorSpec @PromoteResult applicativeSpec @PromoteResult monadSpec @PromoteResult describe "treeCursorPromoteSubTree" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorPromoteSubTree @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorPromoteSubTree @Bool it "Works on the example from the docs" $ let promoteStart = TreeCursor { treeAbove = Just TreeAbove - { treeAboveLefts = - [CNode 'b' $ closedForest [Node 'c' []]] + { treeAboveLefts = [CNode 'b' $ closedForest [Node 'c' []]] , treeAboveAbove = Just TreeAbove @@ -106,8 +99,7 @@ , treeAboveRights = [node 'h' []] } , treeAboveNode = 'a' - , treeAboveRights = - [CNode 'f' $ closedForest [Node 'g' []]] + , treeAboveRights = [CNode 'f' $ closedForest [Node 'g' []]] } , treeCurrent = 'd' , treeBelow = closedForest [Node 'e' []] @@ -133,7 +125,5 @@ } in case treeCursorPromoteSubTree promoteStart of Promoted tc' -> tc' `treeShouldBe` promoteEnd - _ -> - expectationFailure - "treeCursorPromoteSubTree should not have failed" + _ -> expectationFailure "treeCursorPromoteSubTree should not have failed" it "promotes the current subtree to the level of its parent" pending diff --git a/test/Cursor/Simple/Tree/SwapSpec.hs b/test/Cursor/Simple/Tree/SwapSpec.hs --- a/test/Cursor/Simple/Tree/SwapSpec.hs +++ b/test/Cursor/Simple/Tree/SwapSpec.hs @@ -21,8 +21,7 @@ spec = do functorSpec @SwapResult describe "treeCursorSwapPrev" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorSwapPrev @Rational @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorSwapPrev @Bool @Bool it "works on the example from the docs" $ let start = TreeCursor @@ -55,12 +54,11 @@ _ -> expectationFailure "treeCursorSwapPrev should not have failed." it "reverts treeCursorSwapNext" $ inverseFunctionsIfSucceedOnValid - (treeCursorSwapNext @Rational @Rational) - (treeCursorSwapPrev @Rational @Rational) + (treeCursorSwapNext @Bool @Bool) + (treeCursorSwapPrev @Bool @Bool) it "swaps the current node with the previous node" pending describe "treeCursorSwapNext" $ do - it "produces valids on valids" $ - producesValidsOnValids $ treeCursorSwapNext @Rational @Rational + it "produces valids on valids" $ producesValidsOnValids $ treeCursorSwapNext @Bool @Bool it "works on the example from the docs" $ let start = TreeCursor @@ -93,6 +91,6 @@ _ -> expectationFailure "treeCursorSwapNext should not have failed." it "reverts treeCursorSwapNext" $ inverseFunctionsIfSucceedOnValid - (treeCursorSwapPrev @Rational @Rational) - (treeCursorSwapNext @Rational @Rational) + (treeCursorSwapPrev @Bool @Bool) + (treeCursorSwapNext @Bool @Bool) it "swaps the current node with the next node" pending diff --git a/test/Cursor/Simple/Tree/TestUtils.hs b/test/Cursor/Simple/Tree/TestUtils.hs --- a/test/Cursor/Simple/Tree/TestUtils.hs +++ b/test/Cursor/Simple/Tree/TestUtils.hs @@ -22,17 +22,15 @@ testMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Spec testMovement func = do - it "produces valids on valids" $ producesValidsOnValids $ func @Rational + it "produces valids on valids" $ producesValidsOnValids $ func @Bool it "is a movement" $ isMovement func -testMovementM :: - (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec +testMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec testMovementM func = do - it "produces valids on valids" $ producesValidsOnValids $ func @Rational + it "produces valids on valids" $ producesValidsOnValids $ func @Bool it "is a movement" $ isMovementM func -isMovementM :: - (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property +isMovementM :: (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property isMovementM func = forAllValid @(STC.TreeCursor Int) $ \lec -> case func lec of @@ -52,11 +50,9 @@ isMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Property isMovement func = forAllValid $ \lec -> - rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe` - rebuildTreeCursor (func lec) + rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe` rebuildTreeCursor (func lec) -treeShouldBe :: - (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation +treeShouldBe :: (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation treeShouldBe actual expected = unless (actual == expected) $ expectationFailure $ diff --git a/test/Cursor/TextFieldSpec.hs b/test/Cursor/TextFieldSpec.hs --- a/test/Cursor/TextFieldSpec.hs +++ b/test/Cursor/TextFieldSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} @@ -143,7 +142,7 @@ describe "textFieldCursorInsertNewline" $ do it "produces valid cursors" $ producesValidsOnValids textFieldCursorInsertNewline it "inserts a new line" pending - describe "textFieldCursorAppendNewline" $ do + describe "textFieldCursorAppendNewline" $ it "produces valid cursors" $ producesValidsOnValids textFieldCursorAppendNewline describe "textFieldCursorRemove" $ do it "produces valid cursors" $ producesValidsOnValids textFieldCursorRemove diff --git a/test/Cursor/TextSpec.hs b/test/Cursor/TextSpec.hs --- a/test/Cursor/TextSpec.hs +++ b/test/Cursor/TextSpec.hs @@ -82,16 +82,16 @@ it "returns the item after the position" pending describe "textCursorInsert" $ do it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorInsert d) - it "inserts an item before the cursor" $ pending + it "inserts an item before the cursor" pending describe "textCursorAppend" $ do it "produces valids" $ forAllValid $ \d -> producesValidsOnValids (textCursorAppend d) - it "inserts an item after the cursor" $ pending + it "inserts an item after the cursor" pending describe "textCursorRemove" $ do it "produces valids" $ validIfSucceedsOnValid textCursorRemove - it "removes an item before the cursor" $ pending + it "removes an item before the cursor" pending describe "textCursorDelete" $ do it "produces valids" $ validIfSucceedsOnValid textCursorDelete - it "removes an item before the cursor" $ pending + it "removes an item before the cursor" pending describe "textCursorSplit" $ do it "produces valids" $ producesValidsOnValids textCursorSplit it "produces two list cursors that rebuild to the rebuilding of the original" $ diff --git a/test/Cursor/Tree/TypesSpec.hs b/test/Cursor/Tree/TypesSpec.hs --- a/test/Cursor/Tree/TypesSpec.hs +++ b/test/Cursor/Tree/TypesSpec.hs @@ -21,39 +21,35 @@ eqSpec @TreeCursorSelection genValidSpec @TreeCursorSelection shrinkValidSpecWithLimit @TreeCursorSelection 10 - eqSpec @(SwapResult Int) - genValidSpec @(SwapResult Rational) - shrinkValidSpecWithLimit @(SwapResult Int) 10 - eqSpec @(PromoteElemResult Int) - genValidSpec @(PromoteElemResult Rational) - shrinkValidSpecWithLimit @(PromoteElemResult Int) 10 - eqSpec @(PromoteResult Int) - genValidSpec @(PromoteResult Rational) - shrinkValidSpecWithLimit @(PromoteResult Int) 10 - eqSpec @(DemoteResult Int) - genValidSpec @(DemoteResult Rational) - shrinkValidSpecWithLimit @(DemoteResult Int) 10 - eqSpec @(CTree Int) - genValidSpec @(CTree Rational) - shrinkValidSpecWithLimit @(CTree Int) 10 - eqSpec @(CForest Int) - genValidSpec @(CForest Rational) - shrinkValidSpecWithLimit @(CForest Int) 10 - eqSpec @(TreeAbove Int) - genValidSpec @(TreeAbove Rational) - shrinkValidSpecWithLimit @(TreeAbove Int) 10 - describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Rational - describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Rational - describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Rational - describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Rational - eqSpec @(TreeCursor Int Word) - genValidSpec @(TreeCursor Rational Rational) - shrinkValidSpecWithLimit @(TreeCursor Word Int) 10 - describe "treeCursorAboveL" $ - lensSpecOnValid $ treeCursorAboveL @Rational @Rational - describe "treeCursorCurrentL" $ - lensSpecOnValid $ treeCursorCurrentL @Rational @Rational - describe "treeCursorBelowL" $ - lensSpecOnValid $ treeCursorBelowL @Rational @Rational - describe "treeCursorCurrentSubTreeL" $ - lensSpecOnValid $ treeCursorCurrentSubTreeL @Rational @Rational + eqSpec @(SwapResult Bool) + genValidSpec @(SwapResult Bool) + shrinkValidSpecWithLimit @(SwapResult Bool) 10 + eqSpec @(PromoteElemResult Bool) + genValidSpec @(PromoteElemResult Bool) + shrinkValidSpecWithLimit @(PromoteElemResult Bool) 10 + eqSpec @(PromoteResult Bool) + genValidSpec @(PromoteResult Bool) + shrinkValidSpecWithLimit @(PromoteResult Bool) 10 + eqSpec @(DemoteResult Bool) + genValidSpec @(DemoteResult Bool) + shrinkValidSpecWithLimit @(DemoteResult Bool) 10 + eqSpec @(CTree Bool) + genValidSpec @(CTree Bool) + shrinkValidSpecWithLimit @(CTree Bool) 10 + eqSpec @(CForest Bool) + genValidSpec @(CForest Bool) + shrinkValidSpecWithLimit @(CForest Bool) 10 + eqSpec @(TreeAbove Bool) + genValidSpec @(TreeAbove Bool) + shrinkValidSpecWithLimit @(TreeAbove Bool) 10 + describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Bool + describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Bool + describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Bool + describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Bool + eqSpec @(TreeCursor Bool Word) + genValidSpec @(TreeCursor Bool Bool) + shrinkValidSpecWithLimit @(TreeCursor Word Bool) 10 + describe "treeCursorAboveL" $ lensSpecOnValid $ treeCursorAboveL @Bool @Bool + describe "treeCursorCurrentL" $ lensSpecOnValid $ treeCursorCurrentL @Bool @Bool + describe "treeCursorBelowL" $ lensSpecOnValid $ treeCursorBelowL @Bool @Bool + describe "treeCursorCurrentSubTreeL" $ lensSpecOnValid $ treeCursorCurrentSubTreeL @Bool @Bool