packages feed

cursor-gen (empty) → 0.0.0.0

raw patch · 37 files changed

+3594/−0 lines, 37 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, cursor, cursor-gen, genvalidity, genvalidity-containers, genvalidity-hspec, genvalidity-hspec-optics, genvalidity-text, hspec, microlens, pretty-show, text

Files

+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ cursor-gen.cabal view
@@ -0,0 +1,92 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 58018e9f00ff2eb5016098f09115ecf1aad35674f8b0a9ca7a893c923064ab31++name:           cursor-gen+version:        0.0.0.0+synopsis:       Generators for Purely Functional Cursors+description:    Generators for Purely Functional Cursors for common data structures+category:       Cursor+homepage:       https://github.com/NorfairKing/cursor+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright: (c) 2018 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++library+  exposed-modules:+      Cursor.Forest.Gen+      Cursor.List.Gen+      Cursor.List.NonEmpty.Gen+      Cursor.Map.Gen+      Cursor.Map.KeyValue.Gen+      Cursor.Simple.Forest.Gen+      Cursor.Simple.List.NonEmpty.Gen+      Cursor.Simple.Map.Gen+      Cursor.Simple.Map.KeyValue.Gen+      Cursor.Simple.Tree.Gen+      Cursor.Text.Gen+      Cursor.TextField.Gen+      Cursor.Tree.Gen+  other-modules:+      Paths_cursor_gen+  hs-source-dirs:+      src/+  ghc-options: -Wall+  build-depends:+      QuickCheck+    , base <5+    , containers+    , cursor+    , genvalidity+    , genvalidity-containers+    , genvalidity-text+    , text+  default-language: Haskell2010++test-suite cursor-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Cursor.List.NonEmptySpec+      Cursor.ListSpec+      Cursor.Map.KeyValueSpec+      Cursor.MapSpec+      Cursor.Simple.ForestSpec+      Cursor.Simple.List.NonEmptySpec+      Cursor.Simple.Map.KeyValueSpec+      Cursor.Simple.MapSpec+      Cursor.Simple.Tree.BaseSpec+      Cursor.Simple.Tree.CollapseSpec+      Cursor.Simple.Tree.DeleteSpec+      Cursor.Simple.Tree.DemoteSpec+      Cursor.Simple.Tree.InsertSpec+      Cursor.Simple.Tree.MovementSpec+      Cursor.Simple.Tree.PromoteSpec+      Cursor.Simple.Tree.SwapSpec+      Cursor.Simple.Tree.TestUtils+      Cursor.TextFieldSpec+      Cursor.TextSpec+      Cursor.Tree.TypesSpec+      Paths_cursor_gen+  hs-source-dirs:+      test/+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+  build-depends:+      QuickCheck+    , base+    , containers+    , cursor+    , cursor-gen+    , genvalidity-hspec+    , genvalidity-hspec-optics+    , hspec+    , microlens+    , pretty-show+    , text+  default-language: Haskell2010
+ src/Cursor/Forest/Gen.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Forest.Gen+    (+    ) where++import Data.GenValidity+import Data.GenValidity.Containers ()++import Cursor.Forest++import Cursor.List.NonEmpty.Gen ()+import Cursor.Tree.Gen ()++instance (GenUnchecked a, GenUnchecked b) =>+         GenUnchecked (ForestCursor a b) where+    genUnchecked = ForestCursor <$> genUnchecked+    shrinkUnchecked (ForestCursor ne) = ForestCursor <$> shrinkUnchecked ne++instance (GenValid a, GenValid b) => GenValid (ForestCursor a b) where+    genValid = ForestCursor <$> genValid+    shrinkValid (ForestCursor ne) = ForestCursor <$> shrinkValid ne
+ src/Cursor/List/Gen.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.List.Gen+    ( listCursorWithGen+    , listCursorWithIndex0+    ) where++import Test.QuickCheck++import Cursor.List++import Data.GenValidity++instance GenUnchecked a => GenUnchecked (ListCursor a) where+    genUnchecked =+        sized $ \n -> do+            (a, b) <- genSplit n+            listCursorPrev <- resize a genUnchecked+            listCursorNext <- resize b genUnchecked+            pure ListCursor {..}++instance GenValid a => GenValid (ListCursor a) where+    genValid =+        sized $ \n -> do+            (a, b) <- genSplit n+            listCursorPrev <- resize a genValid+            listCursorNext <- resize b genValid+            pure ListCursor {..}++listCursorWithGen :: Gen a -> Gen (ListCursor a)+listCursorWithGen gen = ListCursor <$> genListOf gen <*> genListOf gen++listCursorWithIndex0 :: Gen a -> Gen (ListCursor a)+listCursorWithIndex0 gen = ListCursor [] <$> genListOf gen
+ src/Cursor/List/NonEmpty/Gen.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.List.NonEmpty.Gen+    ( nonEmptyElemOf+    , nonEmptyWithIndex0+    , nonEmptyWith+    ) where++import Control.Monad++import Data.GenValidity++import Test.QuickCheck++import qualified Data.List.NonEmpty as NE++import Cursor.List.NonEmpty++instance (GenUnchecked a, GenUnchecked b) =>+         GenUnchecked (NonEmptyCursor a b) where+    genUnchecked =+        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 (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 {..}++nonEmptyElemOf :: NonEmptyCursor a a -> Gen a+nonEmptyElemOf = elements . NE.toList . rebuildNonEmptyCursor id++nonEmptyWithIndex0 :: Gen a -> Gen (NonEmptyCursor a a)+nonEmptyWithIndex0 g = NonEmptyCursor [] <$> g <*> genListOf g++nonEmptyWith :: a -> Gen a -> Gen (NonEmptyCursor a a)+nonEmptyWith a g =+    oneof+        [ NonEmptyCursor <$> listWithA <*> g <*> genListOf g+        , NonEmptyCursor <$> genListOf g <*> pure a <*> genListOf g+        , NonEmptyCursor <$> genListOf g <*> g <*> listWithA+        ]+  where+    listWithA = do+        l1 <- genListOf g+        l2 <- genListOf g+        pure $ l1 ++ [a] ++ l2
+ src/Cursor/Map/Gen.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Map.Gen+    (+    ) where++import Data.GenValidity+import Data.GenValidity.Containers ()++import Cursor.Map++import Cursor.List.NonEmpty.Gen ()+import Cursor.Map.KeyValue.Gen ()++instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) =>+         GenUnchecked (MapCursor kc vc k v)++instance (GenValid kc, GenValid vc, GenValid k, GenValid v) =>+         GenValid (MapCursor kc vc k v) where+    genValid = genValidStructurallyWithoutExtraChecking+    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+ src/Cursor/Map/KeyValue/Gen.hs view
@@ -0,0 +1,21 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Map.KeyValue.Gen+    (+    ) where++import Data.GenValidity++import Cursor.Map.KeyValue++instance (GenUnchecked kc, GenUnchecked vc, GenUnchecked k, GenUnchecked v) =>+         GenUnchecked (KeyValueCursor kc vc k v)++instance (GenValid kc, GenValid vc, GenValid k, GenValid v) =>+         GenValid (KeyValueCursor kc vc k v) where+    genValid = genValidStructurallyWithoutExtraChecking+    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked KeyValueToggle++instance GenValid KeyValueToggle
+ src/Cursor/Simple/Forest/Gen.hs view
@@ -0,0 +1,5 @@+module Cursor.Simple.Forest.Gen+    (+    ) where++import Cursor.Forest.Gen ()
+ src/Cursor/Simple/List/NonEmpty/Gen.hs view
@@ -0,0 +1,19 @@+module Cursor.Simple.List.NonEmpty.Gen+    ( nonEmptyElemOf+    , nonEmptyWithIndex0+    , nonEmptyWith+    ) where++import Test.QuickCheck++import qualified Cursor.List.NonEmpty.Gen as NEC+import Cursor.Simple.List.NonEmpty++nonEmptyElemOf :: NonEmptyCursor a -> Gen a+nonEmptyElemOf = NEC.nonEmptyElemOf++nonEmptyWithIndex0 :: Gen a -> Gen (NonEmptyCursor a)+nonEmptyWithIndex0 = NEC.nonEmptyWithIndex0++nonEmptyWith :: a -> Gen a -> Gen (NonEmptyCursor a)+nonEmptyWith = NEC.nonEmptyWith
+ src/Cursor/Simple/Map/Gen.hs view
@@ -0,0 +1,5 @@+module Cursor.Simple.Map.Gen+    (+    ) where++import Cursor.Map.Gen ()
+ src/Cursor/Simple/Map/KeyValue/Gen.hs view
@@ -0,0 +1,5 @@+module Cursor.Simple.Map.KeyValue.Gen+    (+    ) where++import Cursor.Map.KeyValue.Gen ()
+ src/Cursor/Simple/Tree/Gen.hs view
@@ -0,0 +1,5 @@+module Cursor.Simple.Tree.Gen+    (+    ) where++import Cursor.Tree.Gen ()
+ src/Cursor/Text/Gen.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Text.Gen+    ( textCursorWithGen+    , textCursorWithIndex0+    ) where++import Test.QuickCheck++import Data.GenValidity+import Data.GenValidity.Text ()++import Cursor.Text++import Cursor.List.Gen++instance GenUnchecked TextCursor++instance GenValid TextCursor where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++textCursorWithGen :: Gen Char -> Gen TextCursor+textCursorWithGen gen = TextCursor <$> listCursorWithGen gen++textCursorWithIndex0 :: Gen Char -> Gen TextCursor+textCursorWithIndex0 gen = TextCursor <$> listCursorWithIndex0 gen
+ src/Cursor/TextField/Gen.hs view
@@ -0,0 +1,27 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.TextField.Gen where++import qualified Data.Text as T++import Data.GenValidity++import Test.QuickCheck++import Cursor.List.NonEmpty+import Cursor.TextField++import Cursor.List.NonEmpty.Gen ()+import Cursor.Text.Gen++instance GenUnchecked TextFieldCursor++instance GenValid TextFieldCursor where+    genValid = do+        let charGen = genValid `suchThat` (/= '\n')+        prevs <- genListOf $ T.pack <$> genListOf charGen+        nexts <- genListOf $ T.pack <$> genListOf charGen+        cur <- textCursorWithGen charGen+        let nec = NonEmptyCursor prevs cur nexts+        pure $ TextFieldCursor nec+    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+ src/Cursor/Tree/Gen.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Tree.Gen+    (+    ) where++import qualified Data.List.NonEmpty as NE+import Data.Maybe++import Data.GenValidity+import Data.GenValidity.Containers ()++import Test.QuickCheck++import Cursor.Tree++instance GenUnchecked TreeCursorSelection++instance GenValid TreeCursorSelection where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++instance GenUnchecked a => GenUnchecked (SwapResult a)++instance GenValid a => GenValid (SwapResult a) where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++instance GenUnchecked a => GenUnchecked (PromoteElemResult a)++instance GenValid a => GenValid (PromoteElemResult a) where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++instance GenUnchecked a => GenUnchecked (PromoteResult a)++instance GenValid a => GenValid (PromoteResult a) where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++instance GenUnchecked a => GenUnchecked (DemoteResult a)++instance GenValid a => GenValid (DemoteResult a) where+    genValid = genValidStructurally+    shrinkValid = shrinkValidStructurally++instance GenUnchecked a => GenUnchecked (CTree a) where+    genUnchecked =+        sized $ \n -> do+            s <- upTo n+            (a, b) <- genSplit s+            val <- resize a genUnchecked+            for <- resize b genUnchecked+            pure $ CNode val for+    shrinkUnchecked (CNode a cf) =+        [CNode a' cf' | (a', cf') <- shrinkUnchecked (a, cf)]++instance GenValid a => GenValid (CTree a) where+    genValid =+        sized $ \n -> do+            s <- upTo n+            (a, b) <- genSplit s+            val <- resize a genValid+            for <- resize b genValid+            pure $ CNode val for+    shrinkValid (CNode a cf) = [CNode a' cf' | (a', cf') <- shrinkValid (a, cf)]++instance GenUnchecked a => GenUnchecked (CForest a) where+    genUnchecked =+        sized $ \n ->+            case n of+                0 -> pure EmptyCForest+                _ ->+                    oneof+                        [ ClosedForest <$> resize n genUnchecked+                        , OpenForest <$> resize n genUnchecked+                        ]+    shrinkUnchecked EmptyCForest = []+    shrinkUnchecked (ClosedForest ne) =+        EmptyCForest : (ClosedForest <$> shrinkUnchecked ne)+    shrinkUnchecked (OpenForest ne) =+        EmptyCForest :+        ClosedForest (NE.map rebuildCTree ne) :+        (OpenForest <$> shrinkUnchecked ne)++instance GenValid a => GenValid (CForest a) where+    genValid =+        sized $ \n ->+            case n of+                0 -> pure EmptyCForest+                _ ->+                    oneof+                        [ ClosedForest <$> resize n genValid+                        , OpenForest <$> resize n genValid+                        ]+    shrinkValid EmptyCForest = []+    shrinkValid (ClosedForest ne) =+        EmptyCForest : (ClosedForest <$> shrinkValid ne)+    shrinkValid (OpenForest ne) =+        EmptyCForest :+        ClosedForest (NE.map rebuildCTree ne) : (OpenForest <$> shrinkValid ne)++instance (GenUnchecked a, GenUnchecked b) => GenUnchecked (TreeCursor a b) where+    genUnchecked =+        sized $ \n -> do+            s <- upTo n+            (a, b, c, d) <- genSplit4 s+            treeAbove <- resize (a + b) genUnchecked+            treeCurrent <- resize c genUnchecked+            treeBelow <- resize d genUnchecked+            pure TreeCursor {..}+    shrinkUnchecked tc =+        let opts =+                catMaybes+                    [ do ta <- treeAbove tc+                         pure $ tc {treeAbove = treeAboveAbove ta}+                    ]+         in opts ++ genericShrinkUnchecked tc++instance (GenValid a, GenValid b) => GenValid (TreeCursor a b) where+    genValid =+        sized $ \n -> do+            s <- upTo n+            (a, b, c, d) <- genSplit4 s+            treeAbove <- resize (a + b) genValid+            treeCurrent <- resize c genValid+            treeBelow <- resize d genValid+            pure TreeCursor {..}+    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering++instance GenUnchecked b => GenUnchecked (TreeAbove b) where+    genUnchecked =+        sized $ \n -> do+            s <- upTo n+            (a, b, c, d) <- genSplit4 s+            treeAboveLefts <- resize a genUnchecked+            treeAboveAbove <- resize b genUnchecked+            treeAboveNode <- resize c genUnchecked+            treeAboveRights <- resize d genUnchecked+            pure TreeAbove {..}++instance GenValid b => GenValid (TreeAbove b) where+    genValid =+        sized $ \n -> do+            s <- upTo n+            (a, b, c, d) <- genSplit4 s+            treeAboveLefts <- resize a genValid+            treeAboveAbove <- resize b genValid+            treeAboveNode <- resize c genValid+            treeAboveRights <- resize d genValid+            pure TreeAbove {..}+    shrinkValid = shrinkValidStructurallyWithoutExtraFiltering
+ test/Cursor/List/NonEmptySpec.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.List.NonEmptySpec+    ( spec+    ) where++import Test.Hspec+import Test.Validity++import qualified Data.List.NonEmpty as NE++import Cursor.List.NonEmpty++spec :: Spec+spec = do+    describe "nonemptyPrepend" $+        it "is equivalent to regular prepend" $+        equivalentWhenFirstSucceeds+            (\(ls1, ls2) ->+                 (NE.toList . nonemptyPrepend ls1) <$> NE.nonEmpty ls2)+            (uncurry (++) :: ([Int], [Int]) -> [Int])+    describe "nonemptyAppend" $+        it "is equivalent to regular append" $+        equivalentWhenFirstSucceeds+            (\(ls1, ls2) ->+                 (NE.toList . (`nonemptyAppend` ls2)) <$> NE.nonEmpty ls1)+            (uncurry (++) :: ([Int], [Int]) -> [Int])
+ test/Cursor/ListSpec.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}++module Cursor.ListSpec+    ( spec+    ) where++import Test.Hspec+import Test.QuickCheck+import Test.Validity++import Control.Monad++import Cursor.List+import Cursor.List.Gen ()++spec :: Spec+spec = do+    eqSpec @(ListCursor Int)+    functorSpec @ListCursor+    genValidSpec @(ListCursor Double)+    describe "emptyListCursor" $+        it "is valid" $ shouldBeValid (emptyListCursor @Int)+    describe "makeListCursor" $+        it "produces valid list cursors" $+        producesValidsOnValids (makeListCursor @Double)+    describe "makeListCursorWithSelection" $+        it "produces valid list cursors" $+        producesValidsOnValids2 (makeListCursorWithSelection @Double)+    describe "rebuildListCursor" $ do+        it "produces valid lists" $+            producesValidsOnValids (rebuildListCursor @Double)+        it "is the inverse of makeListCursor" $+            inverseFunctions (makeListCursor @Int) rebuildListCursor+        it "is the inverse of makeListCursorWithSelection for any index" $+            forAllUnchecked $ \i ->+                inverseFunctionsIfFirstSucceeds+                    (makeListCursorWithSelection @Int i)+                    rebuildListCursor+    describe "listCursorNull" $+        it "produces valid bools" $+        producesValidsOnValids (listCursorNull @Double)+    describe "listCursorLength" $+        it "produces valid bools" $+        producesValidsOnValids (listCursorLength @Double)+    describe "listCursorIndex" $+        it "produces valid indices" $+        producesValidsOnValids (listCursorIndex @Double)+    describe "listCursorSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids (listCursorSelectPrev @Double)+        it "is a movement" $ isMovementM listCursorSelectPrev+        it "selects the previous position" pending+    describe "listCursorSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids (listCursorSelectNext @Double)+        it "is a movement" $ isMovementM listCursorSelectNext+        it "selects the next position" pending+    describe "listCursorSelectIndex" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (listCursorSelectIndex @Double)+        it "is a movement" $+            forAllUnchecked $ \ix -> isMovement (listCursorSelectIndex ix)+        it "selects the position at the given index" pending+    describe "listCursorPrevItem" $ do+        it "produces valid items" $+            producesValidsOnValids (listCursorPrevItem @Double)+        it "returns the item before the position" pending+    describe "listCursorNextItem" $ do+        it "produces valid items" $+            producesValidsOnValids (listCursorNextItem @Double)+        it "returns the item after the position" pending+    describe "listCursorSelectStart" $ do+        it "produces valid cursors" $+            producesValidsOnValids (listCursorSelectStart @Double)+        it "is a movement" $ isMovement listCursorSelectStart+        it "is idempotent" $ idempotentOnValid (listCursorSelectStart @Double)+        it "selects the starting position" pending+    describe "listCursorSelectEnd" $ do+        it "produces valid cursors" $+            producesValidsOnValids (listCursorSelectEnd @Double)+        it "is a movement" $ isMovement listCursorSelectEnd+        it "is idempotent" $ idempotentOnValid (listCursorSelectEnd @Double)+        it "selects the end position" pending+    describe "listCursorInsert" $ do+        it "produces valids" $+            forAllValid $ \d ->+                producesValidsOnValids (listCursorInsert @Double d)+        it "inserts an item before the cursor" $ pending+    describe "listCursorAppend" $ do+        it "produces valids" $+            forAllValid $ \d ->+                producesValidsOnValids (listCursorAppend @Double d)+        it "inserts an item after the cursor" $ pending+    describe "listCursorRemove" $ do+        it "produces valids" $ validIfSucceedsOnValid (listCursorRemove @Double)+        it "removes an item before the cursor" $ pending+    describe "listCursorDelete" $ do+        it "produces valids" $ validIfSucceedsOnValid (listCursorDelete @Double)+        it "removes an item before the cursor" $ pending+    describe "listCursorSplit" $ do+        it "produces valids" $ producesValidsOnValids (listCursorSplit @Double)+        it+            "produces two list cursors that rebuild to the rebuilding of the original" $+            forAllValid $ \lc ->+                let (lc1, lc2) = listCursorSplit (lc :: ListCursor Double)+                 in (rebuildListCursor lc1 ++ rebuildListCursor lc2) `shouldBe`+                    rebuildListCursor lc+    describe "listCursorCombine" $ do+        it "produces valids" $+            producesValidsOnValids2 (listCursorCombine @Double)+        it+            "produces a list that rebuilds to the rebuilding of the original two cursors" $+            forAllValid $ \lc1 ->+                forAllValid $ \lc2 ->+                    let lc = listCursorCombine lc1 (lc2 :: ListCursor Double)+                     in rebuildListCursor lc `shouldBe`+                        (rebuildListCursor lc1 ++ rebuildListCursor lc2)++isMovementM :: (forall a. ListCursor a -> Maybe (ListCursor a)) -> Property+isMovementM func =+    forAllValid $ \lec ->+        case func (lec :: ListCursor Int) of+            Nothing -> pure () -- Fine+            Just lec' ->+                let ne = rebuildListCursor lec+                    ne' = rebuildListCursor lec'+                 in unless (ne == ne') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show lec+                        , "List before:  \n" ++ show ne+                        , "Cursor after: \n" ++ show lec'+                        , "List after:   \n" ++ show ne'+                        ]++isMovement :: (forall a. ListCursor a -> ListCursor a) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildListCursor (lec :: ListCursor Int) `shouldBe`+        rebuildListCursor (func lec)
+ test/Cursor/Map/KeyValueSpec.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TypeApplications #-}++module Cursor.Map.KeyValueSpec+    ( spec+    ) where++import Test.Hspec++import Test.Validity++import Cursor.Map.KeyValue+import Cursor.Map.KeyValue.Gen ()++spec :: Spec+spec = do+    eqSpec @(KeyValueCursor Int Int Int Int)+    genValidSpec @(KeyValueCursor Double Double Double Double)+    eqSpec @KeyValueToggle+    genValidSpec @KeyValueToggle
+ test/Cursor/MapSpec.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}++module Cursor.MapSpec+    ( spec+    ) where++import Test.Hspec+import Test.Validity++import Cursor.Map+import Cursor.Map.Gen ()++spec :: Spec+spec = do+    eqSpec @(MapCursor Word Int Bool Ordering)+    genValidSpec @(MapCursor Double Rational Int Bool)+    shrinkValidSpec @(MapCursor Double Rational Int Bool)
+ test/Cursor/Simple/ForestSpec.hs view
@@ -0,0 +1,1014 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.ForestSpec+    ( spec+    ) where++import Data.Tree++import Control.Monad (unless)++import Test.Hspec++import Test.QuickCheck+import Test.Validity+import Test.Validity.Optics++import Cursor.Forest (ForestCursor(..))+import Cursor.List.NonEmpty+import Cursor.Simple.Forest hiding (ForestCursor)+import qualified Cursor.Simple.Forest as SFC (ForestCursor)+import Cursor.Tree+import Cursor.Types++import Cursor.Simple.Forest.Gen ()++spec :: Spec+spec = do+    eqSpec @(SFC.ForestCursor Int)+    genValidSpec @(SFC.ForestCursor Double)+    shrinkValidSpecWithLimit @(SFC.ForestCursor Double) 100+    describe "makeForestCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (makeForestCursor @Double)+    describe "rebuildForestCursor" $ do+        it "produces valid forests" $+            producesValidsOnValids (rebuildForestCursor @Double)+        it "is the inverse of makeForestCursor for integers" $+            inverseFunctions (makeForestCursor @Int) rebuildForestCursor+    describe "forestCursorLestCursorL" $+        lensSpecOnValid (forestCursorListCursorL @Double @Double)+    describe "forestCursorSelectedTreeL" $+        lensSpecOnValid (forestCursorSelectedTreeL @Double @Double)+    describe "forestCursorSelection" $ do+        it "produces valid ints" $+            producesValidsOnValids (forestCursorSelection @Double @Double)+        it "returns the index of the currently selected element" pending+    describe "forestCursorSelectIndex" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorSelectIndex @Double)+        it "is the identity function when given the current selection" $+            forAllValid $ \fc ->+                forestCursorSelectIndex (forestCursorSelection fc) fc `shouldBe`+                Just (fc :: SFC.ForestCursor Double)+        it "returns selects the element at the given index" pending+    movementsSpec+    collapseSpec+    insertSpec+    swapSpec+    deleteSpec+    shiftingSpec++movementsSpec :: Spec+movementsSpec = do+    describe "forestCursorSelectPrevTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectPrevTreeCursor @Double+        it "is a movement" $ isMovementM forestCursorSelectPrevTreeCursor+        it "selects the previous tree cursor" pending+    describe "forestCursorSelectNextTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectNextTreeCursor @Double+        it "is a movement" $ isMovementM forestCursorSelectNextTreeCursor+        it "selects the next tree" pending+    describe "forestCursorSelectFirstTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectFirstTreeCursor @Double+        it "is a movement" $ isMovement forestCursorSelectFirstTreeCursor+        it "selects the first tree" pending+    describe "forestCursorSelectLastTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectLastTreeCursor @Double+        it "is a movement" $ isMovement forestCursorSelectLastTreeCursor+        it "selects the last tree" pending+    describe "forestCursorSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectPrev @Double+        it "is a movement" $ isMovementM forestCursorSelectPrev+        it "selects the previous node" pending+        -- TODO example with a collapsed tree+        it "Works for this classic example without any collapsing" $+            --   > 1+            --     > 2 <- expected end cursor+            --   > 3 <- start cursor+         do+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [ CNode 1 $+                                          openForest [CNode 2 $ emptyCForest]+                                        ]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 3 :: Int+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveAbove =+                                                                Nothing+                                                          , treeAboveLefts = []+                                                          , treeAboveNode = 1+                                                          , treeAboveRights = []+                                                          }+                                            , treeCurrent = 2+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 3 $ emptyCForest]+                                  }+                        }+            case forestCursorSelectPrev start of+                Nothing ->+                    expectationFailure+                        "forestCursorSelectPrev should not have failed."+                Just actual -> actual `forestShouldBe` expected+    describe "forestCursorSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectNext @Double+        it "is a movement" $ isMovementM forestCursorSelectNext+        it "selects the next node" pending+        it "Works for this classic example" $+            --   > 1+            --     > 2 <- start cursor+            --   > 3 <- expected end cursor+         do+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveAbove =+                                                                Nothing+                                                          , treeAboveLefts = []+                                                          , treeAboveNode = 1+                                                          , treeAboveRights = []+                                                          }+                                            , treeCurrent = 2+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 3 $ emptyCForest]+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [ CNode 1 $+                                          openForest [CNode 2 $ emptyCForest]+                                        ]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 3 :: Int+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+            case forestCursorSelectNext start of+                Nothing ->+                    expectationFailure+                        "forestCursorSelectNext should not have failed."+                Just actual -> actual `forestShouldBe` expected+    describe "forestCursorSelectPrevOnSameLevel" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectPrevOnSameLevel @Double+        it "is a movement" $ isMovementM forestCursorSelectPrevOnSameLevel+        it+            "selects the previous node on the same level as the current node"+            pending+    describe "forestCursorSelectNextOnSameLevel" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectNextOnSameLevel @Double+        it "is a movement" $ isMovementM forestCursorSelectNextOnSameLevel+        it "selects the next node on the same level as the current node" pending+    describe "forestCursorSelectFirst" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectFirst @Double+        it "is a movement" $ isMovement forestCursorSelectFirst+        it "selects the first node in the forest" pending+    describe "forestCursorSelectLast" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectLast @Double+        it "is a movement" $ isMovement forestCursorSelectLast+        it "selects the last node in the forest" pending+    describe "forestCursorSelectBelowAtPos" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 $ forestCursorSelectBelowAtPos @Double+        it "is a movement for any index" $+            forAllValid $ \i -> isMovementM $ forestCursorSelectBelowAtPos i+        it+            "selects the child of the selected node at the given position"+            pending+    describe "forestCursorSelectBelowAtStart" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectBelowAtStart @Double+        it "is a movement" $ isMovementM forestCursorSelectBelowAtStart+        it "selects the first child of the selected node" pending+    describe "forestCursorSelectBelowAtEnd" $ do+        it "produces valid cursors" $+            producesValidsOnValids $ forestCursorSelectBelowAtEnd @Double+        it "is a movement" $ isMovementM forestCursorSelectBelowAtEnd+        it "selects the first child of the selected node" pending++collapseSpec :: Spec+collapseSpec = do+    describe "forestCursorOpenCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ forestCursorOpenCurrentForest @Double @Double+    describe "forestCursorCloseCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ forestCursorCloseCurrentForest @Double @Double+    describe "forestCursorToggleCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ forestCursorToggleCurrentForest @Double @Double++insertSpec :: Spec+insertSpec = do+    describe "forestCursorInsertEntireTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2+                (forestCursorInsertEntireTree @Double @Double)+        it+            "inserts a tree cursor before the currently selected tree cursor"+            pending+    describe "forestCursorInsertAndSelectTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids2+                (forestCursorInsertAndSelectTreeCursor @Double)+        it+            "inserts a tree cursor before the currently selected tree cursor and selects it"+            pending+    describe "forestCursorAppendEntireTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2+                (forestCursorAppendEntireTree @Double @Double)+        it "appends a tree after the currently selected tree cursor" pending+    describe "forestCursorAppendAndSelectTreeCursor" $ do+        it "produces valid cursors" $+            producesValidsOnValids2+                (forestCursorAppendAndSelectTreeCursor @Double)+        it+            "appends a tree cursor after the currently selected tree cursor and selects it"+            pending+    describe "forestCursorInsertTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorInsertTree @Double @Double)+        it "inserts a tree before the currently selected tree" pending+    describe "forestCursorInsertAndSelectTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorInsertAndSelectTree @Double)+        it+            "inserts a tree before the currently selected tree and selects it"+            pending+    describe "forestCursorAppendTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorAppendTree @Double @Double)+        it "appends a tree after the currently selected tree " pending+    describe "forestCursorAppendAndSelectTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorAppendAndSelectTree @Double)+        it+            "appends a tree after the currently selected tree and selects it"+            pending+    describe "forestCursorInsert" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorInsert @Double @Double)+        it "inserts a node before the currently selected node" pending+    describe "forestCursorInsertAndSelect" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorInsertAndSelect @Double)+        it+            "inserts a node before the currently selected node and selects it"+            pending+    describe "forestCursorAppend" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorAppend @Double @Double)+        it "appends a node after the currently selected node" pending+    describe "forestCursorAppendAndSelect" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorAppendAndSelect @Double)+        it+            "appends a node after the currently selected node and selects it"+            pending+    describe "forestCursorAddChildTreeToNodeAtPos" $ do+        it "produces valid cursors" $+            producesValidsOnValids3 $+            forestCursorAddChildTreeToNodeAtPos @Double @Double+        it+            "adds a child tree to a node at the given position in the children of that node"+            pending+    describe "forestCursorAddChildTreeToNodeAtStart" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 $+            forestCursorAddChildTreeToNodeAtStart @Double @Double+        it+            "adds a child tree to a node at the start the children of that node"+            pending+    describe "forestCursorAddChildTreeToNodeAtEnd" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 $+            forestCursorAddChildTreeToNodeAtEnd @Double @Double+        it+            "adds a child tree to a node at the end the children of that node"+            pending+    describe "forestCursorAddChildToNodeAtPos" $ do+        it "produces valid cursors" $+            producesValidsOnValids3 $+            forestCursorAddChildToNodeAtPos @Double @Double+        it+            "adds a child to a node at the given position in the children of that node"+            pending+    describe "forestCursorAddChildToNodeAtStart" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 $+            forestCursorAddChildToNodeAtStart @Double @Double+        it+            "adds a child to a node at the start the children of that node"+            pending+    describe "forestCursorAddChildToNodeAtEnd" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 $+            forestCursorAddChildToNodeAtEnd @Double @Double+        it "adds a child to a node at the end the children of that node" pending+    describe "forestCursorAddRoot" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (forestCursorAddRoot @Double)+        it "houses the entire forest under the given node" pending++swapSpec :: Spec+swapSpec = do+    describe "forestCursorSwapPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorSwapPrev @Double @Double)+        it "works on the example from the docs" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [CNode 'a' $ emptyCForest]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'b'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+                end =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'b'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'a' $ emptyCForest]+                                  }+                        }+             in case forestCursorSwapPrev start of+                    Nothing ->+                        expectationFailure+                            "forestCursorSwapPrev should not have failed."+                    Just r -> r `forestShouldBe` end+        it+            "swaps the current node with the previous node on the same level"+            pending+        it "reverts forestCursorSwapNext" $+            inverseFunctionsIfSucceedOnValid+                (forestCursorSwapNext @Double @Double)+                (forestCursorSwapPrev @Double @Double)+    describe "forestCursorSwapNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorSwapNext @Double @Double)+        it "works on the example from the docs" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'a'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'b' $ emptyCForest]+                                  }+                        }+                end =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [CNode 'b' $ emptyCForest]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'a'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+             in case forestCursorSwapNext start of+                    Nothing ->+                        expectationFailure+                            "forestCursorSwapNext should not have failed."+                    Just r -> r `forestShouldBe` end+        it "swaps the current node with the next node on the same level" pending+        it "reverts forestCursorSwapPrev" $+            inverseFunctionsIfSucceedOnValid+                (forestCursorSwapPrev @Double @Double)+                (forestCursorSwapNext @Double @Double)++deleteSpec :: Spec+deleteSpec = do+    describe "forestCursorRemoveElemAndSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorRemoveElemAndSelectPrev @Double)+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 1 :: Int+                                                , treeBelow =+                                                      closedForest [Node 2 fs]+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                 in case forestCursorRemoveElemAndSelectPrev+                             simpleDeleteElemStart of+                        Nothing -> pure ()+                        Just Deleted ->+                            expectationFailure+                                "forestCursorRemoveElemAndSelectPrev should not have deleted the entire example forest."+                        Just (Updated _) ->+                            expectationFailure+                                "forestCursorRemoveElemAndSelectPrev should not have updated the forest cursor, but failed instead."+        it+            "removes the selected element and selects the previous element"+            pending+    describe "forestCursorDeleteElemAndSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorDeleteElemAndSelectNext @Double)+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 1+                                                , treeBelow =+                                                      closedForest [Node 2 fs]+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                    simpleDeleteElemExpected =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 2 :: Int+                                                , treeBelow = closedForest fs+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                 in case forestCursorDeleteElemAndSelectNext+                             simpleDeleteElemStart of+                        Nothing ->+                            expectationFailure+                                "forestCursorDeleteElemAndSelectNext should not have failed."+                        Just Deleted ->+                            expectationFailure+                                "forestCursorDeleteElemAndSelectNext should not have deleted the entire example forest."+                        Just (Updated f) ->+                            f `shouldBe` simpleDeleteElemExpected+        it "deletes the selected element and selects the next element" pending+    describe "forestCursorRemoveElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorRemoveElem @Double)+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 1+                                                , treeBelow =+                                                      closedForest [Node 2 fs]+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                    simpleDeleteElemExpected =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 2 :: Int+                                                , treeBelow = closedForest fs+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                 in case forestCursorRemoveElem simpleDeleteElemStart of+                        Deleted ->+                            expectationFailure+                                "forestCursorRemoveElem should not have deleted the entire example forest."+                        Updated f -> f `shouldBe` simpleDeleteElemExpected+        it "removes the selected element" pending+    describe "forestCursorDeleteElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorDeleteElem @Double)+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 1+                                                , treeBelow =+                                                      closedForest [Node 2 fs]+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                    simpleDeleteElemExpected =+                        ForestCursor+                            { forestCursorListCursor =+                                  NonEmptyCursor+                                      { nonEmptyCursorPrev = []+                                      , nonEmptyCursorCurrent =+                                            TreeCursor+                                                { treeAbove = Nothing+                                                , treeCurrent = 2 :: Int+                                                , treeBelow = closedForest fs+                                                }+                                      , nonEmptyCursorNext = []+                                      }+                            }+                 in case forestCursorDeleteElem simpleDeleteElemStart of+                        Deleted ->+                            expectationFailure+                                "forestCursorDeleteElem should not have deleted the entire example forest."+                        Updated f -> f `shouldBe` simpleDeleteElemExpected+        it "deletes the selected element" pending+    describe "forestCursorRemoveSubTreeAndSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids+                (forestCursorRemoveSubTreeAndSelectPrev @Double)+        it "removes the selected subtree and selects the previous tree" pending+    describe "forestCursorDeleteSubTreeAndSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids+                (forestCursorDeleteSubTreeAndSelectNext @Double)+        it "deletes the selected subtree and selects the next tree" pending+    describe "forestCursorRemoveSubTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorRemoveSubTree @Double)+        it "removes the selected subtree" pending+    describe "forestCursorDeleteSubTree" $ do+        it "produces valid cursors" $+            producesValidsOnValids (forestCursorDeleteSubTree @Double)+        it "deletes the selected subtree" pending++shiftingSpec :: Spec+shiftingSpec = do+    describe "forestCursorPromoteElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ forestCursorPromoteElem @Double+        it "works on the example from the documentation" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveLefts =+                                                                [ CNode 'b' $+                                                                  closedForest+                                                                      [ Node+                                                                            'c'+                                                                            []+                                                                      ]+                                                                ]+                                                          , treeAboveAbove =+                                                                Nothing+                                                          , treeAboveNode = 'a'+                                                          , treeAboveRights =+                                                                [ CNode 'f' $+                                                                  closedForest+                                                                      [ Node+                                                                            'g'+                                                                            []+                                                                      ]+                                                                ]+                                                          }+                                            , treeCurrent = 'd'+                                            , treeBelow =+                                                  closedForest [Node 'e' []]+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'h' $ emptyCForest]+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [ CNode 'a' $+                                          openForest+                                              [ CNode 'b' $+                                                openForest+                                                    [ CNode 'c' emptyCForest+                                                    , CNode 'e' emptyCForest+                                                    ]+                                              , CNode 'f' $+                                                closedForest [Node 'g' []]+                                              ]+                                        ]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'd'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'h' emptyCForest]+                                  }+                        }+             in case forestCursorPromoteElem start of+                    Nothing ->+                        expectationFailure+                            "forestCursorPromoteElem should not have failed."+                    Just f -> f `forestShouldBe` expected+        it "promotes the current node to the level of its parent" pending+    describe "forestCursorDemoteElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ forestCursorDemoteElem @Double+        it "works on the example from the documentation" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [CNode 'a' $ closedForest [Node 'b' []]]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'c'+                                            , treeBelow =+                                                  closedForest [Node 'd' []]+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'e' emptyCForest]+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveLefts =+                                                                [ CNode 'b' $+                                                                  emptyCForest+                                                                ]+                                                          , treeAboveAbove =+                                                                Nothing+                                                          , treeAboveNode = 'a'+                                                          , treeAboveRights =+                                                                [ CNode 'd' $+                                                                  emptyCForest+                                                                ]+                                                          }+                                            , treeCurrent = 'c'+                                            , treeBelow = emptyCForest+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'e' $ emptyCForest]+                                  }+                        }+             in case forestCursorDemoteElem start of+                    Nothing ->+                        expectationFailure+                            "forestCursorDemoteElem should not have failed."+                    Just f -> f `forestShouldBe` expected+        it "demotes the current node to the level of its children" pending+    describe "forestCursorPromoteSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ forestCursorPromoteSubTree @Double+        it "works on the example from the documentation" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveLefts =+                                                                [ CNode 'b' $+                                                                  closedForest+                                                                      [ Node+                                                                            'c'+                                                                            []+                                                                      ]+                                                                ]+                                                          , treeAboveAbove =+                                                                Nothing+                                                          , treeAboveNode = 'a'+                                                          , treeAboveRights =+                                                                [ CNode 'f' $+                                                                  closedForest+                                                                      [ Node+                                                                            'g'+                                                                            []+                                                                      ]+                                                                ]+                                                          }+                                            , treeCurrent = 'd'+                                            , treeBelow =+                                                  closedForest [Node 'e' []]+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'h' emptyCForest]+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [ CNode 'a' $+                                          openForest+                                              [ CNode 'b' $+                                                closedForest [Node 'c' []]+                                              , CNode 'f' $+                                                closedForest [Node 'g' []]+                                              ]+                                        ]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'd'+                                            , treeBelow =+                                                  closedForest [Node 'e' []]+                                            }+                                  , nonEmptyCursorNext =+                                        [CNode 'h' emptyCForest]+                                  }+                        }+             in case forestCursorPromoteSubTree start of+                    Nothing ->+                        expectationFailure+                            "forestCursorPromoteSubTree should not have failed."+                    Just f -> f `forestShouldBe` expected+        it "promotes the current subtree to the level of its parent" pending+    describe "forestCursorDemoteSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ forestCursorDemoteSubTree @Double+        it "works on the example from the documentation" $+            let start =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev =+                                        [CNode 'a' $ closedForest [Node 'b' []]]+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove = Nothing+                                            , treeCurrent = 'c'+                                            , treeBelow =+                                                  closedForest [Node 'd' []]+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+                expected =+                    ForestCursor+                        { forestCursorListCursor =+                              NonEmptyCursor+                                  { nonEmptyCursorPrev = []+                                  , nonEmptyCursorCurrent =+                                        TreeCursor+                                            { treeAbove =+                                                  Just+                                                      TreeAbove+                                                          { treeAboveLefts =+                                                                [ CNode+                                                                      'b'+                                                                      emptyCForest+                                                                ]+                                                          , treeAboveAbove =+                                                                Nothing+                                                          , treeAboveNode = 'a'+                                                          , treeAboveRights = []+                                                          }+                                            , treeCurrent = 'c'+                                            , treeBelow =+                                                  closedForest [Node 'd' []]+                                            }+                                  , nonEmptyCursorNext = []+                                  }+                        }+             in case forestCursorDemoteSubTree start of+                    Nothing ->+                        expectationFailure+                            "forestCursorDemoteSubTree should not have failed."+                    Just f -> f `forestShouldBe` expected+        it "demotes the current subtree to the level of its children" pending+    describe "forestCursorDemoteElemUnder" $ do+        it "produces valids on valids" $+            producesValidsOnValids3 $+            forestCursorDemoteElemUnder @Double @Double+        it "Works on the example from the docs" $+            forAllValid $ \b1 ->+                forAllValid $ \b2 ->+                    let demoteStart =+                            ForestCursor $+                            NonEmptyCursor+                                { nonEmptyCursorPrev = []+                                , nonEmptyCursorCurrent =+                                      TreeCursor+                                          { treeAbove = Nothing+                                          , treeCurrent = 'a'+                                          , treeBelow =+                                                closedForest [Node 'b' []]+                                          }+                                , nonEmptyCursorNext = []+                                }+                        demoteEnd =+                            ForestCursor $+                            NonEmptyCursor+                                { nonEmptyCursorPrev = []+                                , nonEmptyCursorCurrent =+                                      TreeCursor+                                          { treeAbove =+                                                Just+                                                    TreeAbove+                                                        { treeAboveLefts = []+                                                        , treeAboveAbove =+                                                              Nothing+                                                        , treeAboveNode = b1+                                                        , treeAboveRights = []+                                                        }+                                          , treeCurrent = 'a'+                                          , treeBelow = emptyCForest+                                          }+                                , nonEmptyCursorNext =+                                      [CNode b2 $ closedForest [Node 'b' []]]+                                }+                     in forestCursorDemoteElemUnder b1 b2 demoteStart `forestShouldBe`+                        demoteEnd+        it "demotes the current node to the level of its children" pending+    describe "forestCursorDemoteSubTreeUnder" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $+            forestCursorDemoteSubTreeUnder @Double @Double+        it "Works on the example from the docs" $+            forAllValid $ \v -> do+                let demoteStart =+                        ForestCursor $+                        NonEmptyCursor+                            { nonEmptyCursorPrev = []+                            , nonEmptyCursorCurrent =+                                  TreeCursor+                                      { treeAbove = Nothing+                                      , treeCurrent = 'a'+                                      , treeBelow = closedForest [Node 'b' []]+                                      }+                            , nonEmptyCursorNext = []+                            }+                    demoteEnd =+                        ForestCursor $+                        NonEmptyCursor+                            { nonEmptyCursorPrev = []+                            , nonEmptyCursorCurrent =+                                  TreeCursor+                                      { treeAbove =+                                            Just+                                                TreeAbove+                                                    { treeAboveLefts = []+                                                    , treeAboveAbove = Nothing+                                                    , treeAboveNode = v+                                                    , treeAboveRights = []+                                                    }+                                      , treeCurrent = 'a'+                                      , treeBelow = closedForest [Node 'b' []]+                                      }+                            , nonEmptyCursorNext = []+                            }+                forestCursorDemoteSubTreeUnder v demoteStart `forestShouldBe`+                    demoteEnd+        it+            "demotes the current subtree to the level of its children, by adding a root"+            pending++isMovementM ::+       (forall a. SFC.ForestCursor a -> Maybe (SFC.ForestCursor a)) -> Property+isMovementM func =+    forAllValid @(SFC.ForestCursor Int) $ \lec ->+        case func lec of+            Nothing -> pure () -- Fine+            Just lec' ->+                let ne = rebuildForestCursor lec+                    ne' = rebuildForestCursor lec'+                 in unless (ne == ne') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show lec+                        , "Forest before:  \n" ++ show ne+                        , "Cursor after: \n" ++ show lec'+                        , "Forest after:   \n" ++ show ne'+                        ]++isMovement :: (forall a. SFC.ForestCursor a -> SFC.ForestCursor a) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildForestCursor (lec :: SFC.ForestCursor Int) `shouldBe`+        rebuildForestCursor (func lec)++forestShouldBe ::+       (Show a, Eq a) => SFC.ForestCursor a -> SFC.ForestCursor a -> Expectation+forestShouldBe actual expected =+    unless (actual == expected) $+    expectationFailure $+    unlines+        [ "The following should have been equal."+        , "actual:"+        , drawForestCursor actual+        , "expected:"+        , drawForestCursor expected+        ]
+ test/Cursor/Simple/List/NonEmptySpec.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Simple.List.NonEmptySpec+    ( spec+    ) where++import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Test.Validity.Optics++import Control.Monad++import Cursor.Simple.List.NonEmpty+import Cursor.Simple.List.NonEmpty.Gen++spec :: Spec+spec = do+    eqSpec @(NonEmptyCursor Int)+    genValidSpec @(NonEmptyCursor Double)+    shrinkValidSpec @(NonEmptyCursor Double)+    describe "makeNonEmptyCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (makeNonEmptyCursor @Double)+    describe "makeNonEmptyCursorWithSelection" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (makeNonEmptyCursorWithSelection @Double)+        it+            "is the inverse of rebuildNonEmptyCursor when using the current selection" $+            forAllValid $ \lec ->+                makeNonEmptyCursorWithSelection+                    (nonEmptyCursorSelection @Double lec)+                    (rebuildNonEmptyCursor lec) `shouldBe`+                Just lec+    describe "singletonNonEmptyCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (singletonNonEmptyCursor @Double @Double)+    describe "rebuildNonEmptyCursor" $ do+        it "produces valid nonempty lists" $+            producesValidsOnValids (rebuildNonEmptyCursor @Double)+        it "is the inverse of makeNonEmptyCursor for integers" $+            inverseFunctions (makeNonEmptyCursor @Int) rebuildNonEmptyCursor+        it+            "is the inverse of makeNonEmptyCursorWithSelection for integers, for any index" $+            forAll genUnchecked $ \i ->+                inverseFunctionsIfFirstSucceedsOnValid+                    (makeNonEmptyCursorWithSelection @Int i)+                    rebuildNonEmptyCursor+    describe "nonEmptyCursorElemL" $+        lensSpecOnValid (nonEmptyCursorElemL @Double @Double)+    describe "nonEmptyCursorSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorSelectPrev @Double)+        it "is a movement" $ isMovementM nonEmptyCursorSelectPrev+        it "selects the previous element" pending+    describe "nonEmptyCursorSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorSelectNext @Double)+        it "is a movement" $ isMovementM nonEmptyCursorSelectNext+        it "selects the next element" pending+    describe "nonEmptyCursorSelectFirst" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorSelectFirst @Double)+        it "is a movement" $ isMovement nonEmptyCursorSelectFirst+        it "is idempotent" $+            idempotentOnValid (nonEmptyCursorSelectFirst @Double)+        it "selects the first element" pending+    describe "nonEmptyCursorSelectLast" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorSelectLast @Double)+        it "is a movement" $ isMovement nonEmptyCursorSelectLast+        it "is idempotent" $+            idempotentOnValid (nonEmptyCursorSelectLast @Double)+        it "selects the last element" pending+    describe "nonEmptyCursorSelection" $ do+        it "produces valid ints" $+            producesValidsOnValids (nonEmptyCursorSelection @Double @Double)+        it "returns the index of the currently selected element" pending+    describe "nonEmptyCursorSelectIndex" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (nonEmptyCursorSelectIndex @Double)+        it "is the identity function when given the current selection" $+            forAllValid $ \nec ->+                nonEmptyCursorSelectIndex (nonEmptyCursorSelection nec) nec `shouldBe`+                Just (nec :: NonEmptyCursor Double)+        it "returns selects the element at the given index" pending+    describe "nonEmptyCursorInsert" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (nonEmptyCursorInsert @Double @Double d)+        it "inserts a character before the cursor" pending+    describe "nonEmptyCursorAppend" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (nonEmptyCursorAppend @Double @Double d)+        it "inserts a character after the cursor" pending+    describe "nonEmptyCursorInsertAndSelect" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (nonEmptyCursorInsertAndSelect @Double d)+        it "inserts a character before the cursor and selects it" pending+    describe "nonEmptyCursorAppendAndSelect" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (nonEmptyCursorAppendAndSelect @Double d)+        it "appends a character before the cursor and selects it" pending+    describe "nonEmptyCursorInsertAtStart" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids+                    (nonEmptyCursorInsertAtStart @Double @Double d)+        it "inserts a character at the start of the list" pending+    describe "nonEmptyCursorAppendAtEnd" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids+                    (nonEmptyCursorAppendAtEnd @Double @Double d)+        it "inserts a character at the end of the list" pending+    describe "nonEmptyCursorInsertAtStartAndSelect" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids+                    (nonEmptyCursorInsertAtStartAndSelect @Double d)+        it "inserts a character at the start of the list and selects it" pending+    describe "nonEmptyCursorAppendAtEndAndSelect" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids+                    (nonEmptyCursorAppendAtEndAndSelect @Double d)+        it "appends a character at the end of the list and selects it" pending+    describe "nonEmptyCursorRemoveElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorRemoveElem @Double)+        it "removes an element" pending+    describe "nonEmptyCursorDeleteElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (nonEmptyCursorDeleteElem @Double)+    describe "nonEmptyCursorSearch" $ do+        it "produces valid cursors when looking for an equal element" $+            forAllValid $ \a ->+                producesValidsOnValids $ nonEmptyCursorSearch (== (a :: Double))+        it+            "is indeed the right value when it finds a value and is looking for an equal element" $+            forAllValid $ \a ->+                forAllValid $ \nec ->+                    case nonEmptyCursorSearch (== (a :: Double)) nec of+                        Nothing -> pure ()+                        Just e -> nonEmptyCursorCurrent e `shouldBe` a+        it "finds an element if it is in there" $+            forAllValid $ \a ->+                forAll (nonEmptyWith a genValid) $ \nec ->+                    case nonEmptyCursorSearch (== (a :: Double)) nec of+                        Nothing ->+                            expectationFailure+                                "Should not have failed to find the element."+                        Just e -> nonEmptyCursorCurrent e `shouldBe` a+    describe "nonEmptyCursorSelectOrAdd" $ do+        it "produces valid cursors when looking for an equal element" $+            forAllValid $ \a ->+                producesValidsOnValids $+                nonEmptyCursorSelectOrAdd (== a) (a :: Double)++isMovementM ::+       (forall a. NonEmptyCursor a -> Maybe (NonEmptyCursor a)) -> Property+isMovementM func =+    forAllValid $ \lec ->+        case func (lec :: NonEmptyCursor Double) of+            Nothing -> pure () -- Fine+            Just lec' ->+                let ne = rebuildNonEmptyCursor lec+                    ne' = rebuildNonEmptyCursor lec'+                 in unless (ne == ne') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show lec+                        , "List before:  \n" ++ show ne+                        , "Cursor after: \n" ++ show lec'+                        , "List after:   \n" ++ show ne'+                        ]++isMovement :: (forall a. NonEmptyCursor a -> NonEmptyCursor a) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildNonEmptyCursor (lec :: NonEmptyCursor Double) `shouldBe`+        rebuildNonEmptyCursor (func lec)
+ test/Cursor/Simple/Map/KeyValueSpec.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Simple.Map.KeyValueSpec+    ( spec+    ) where++import Test.Hspec+import Test.QuickCheck+import Test.Validity++import Cursor.Simple.Map.KeyValue+import Cursor.Simple.Map.KeyValue.Gen ()++spec :: Spec+spec = do+    describe "makeKeyValueCursorKey" $+        it "produces valid cursors" $+        producesValidsOnValids2+            (makeKeyValueCursorKey @Double @Rational @Double @Rational)+    describe "makeKeyValueCursorValue" $+        it "produces valid cursors" $+        producesValidsOnValids2+            (makeKeyValueCursorValue @Double @Rational @Double @Rational)+    describe "rebuildKeyValueCursor" $+        it "produces valid tuples" $+        producesValidsOnValids (rebuildKeyValueCursor @Double @Rational)+    describe "keyValueCursorSelection" $+        it "produces valid selections" $+        producesValidsOnValids+            (keyValueCursorSelection @Double @Rational @Double @Rational)+    describe "keyValueCursorSelectKey" $ do+        it "produces valid cursors" $+            producesValidsOnValids (keyValueCursorSelectKey @Double @Rational)+        it "is a movement" $ isMovement keyValueCursorSelectKey+    describe "keyValueCursorSelectValue" $ do+        it "produces valid cursors" $+            producesValidsOnValids (keyValueCursorSelectValue @Double @Rational)+        it "is a movement" $ isMovement keyValueCursorSelectValue+    describe "keyValueCursorToggleSelected" $ do+        it "produces valid cursors" $+            producesValidsOnValids+                (keyValueCursorToggleSelected @Double @Rational)+        it "is a movement" $ isMovement keyValueCursorToggleSelected++isMovement :: (forall k v. KeyValueCursor k v -> KeyValueCursor k v) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildKeyValueCursor (lec :: KeyValueCursor Double Rational) `shouldBe`+        rebuildKeyValueCursor (func lec)
+ test/Cursor/Simple/MapSpec.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}++module Cursor.Simple.MapSpec+    ( spec+    ) where++import Test.Hspec+import Test.QuickCheck+import Test.Validity+import Test.Validity.Optics++import Lens.Micro++import Control.Monad++import Cursor.Simple.Map+import Cursor.Simple.Map.Gen ()++spec :: Spec+spec = do+    describe "makeMapCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (makeMapCursor @Double @Rational)+    describe "makeMapCursorWithSelection" $+        it "produces valid cursors" $+        producesValidsOnValids2 (makeMapCursorWithSelection @Double @Rational)+    describe "singletonMapCursorKey" $+        it "produces valid cursors" $+        producesValidsOnValids2+            (singletonMapCursorKey @Double @Rational @Double @Rational)+    describe "singletonMapCursorValue" $+        it "produces valid cursors" $+        producesValidsOnValids2+            (singletonMapCursorValue @Double @Rational @Double @Rational)+    describe "rebuildMapCursor" $ do+        it "produces valid Nonempty lists" $+            producesValidsOnValids (rebuildMapCursor @Double @Rational)+        it "is the inverse of makeMapCursor for integers" $+            inverseFunctions (makeMapCursor @Int @Int) rebuildMapCursor+    describe "mapCursorNonEmptyCursorL" $+        lensSpecOnValid+            (mapCursorNonEmptyCursorL @Double @Rational @Double @Rational)+    describe "mapCursorElemL" $+        lensSpecOnValid (mapCursorElemL @Double @Rational @Double @Rational)+    describe "mapCursorSelectKey" $+        it "produces valid cursors" $+        producesValidsOnValids (mapCursorSelectKey @Double @Rational)+    describe "mapCursorSelectValue" $+        it "produces valid cursors" $+        producesValidsOnValids (mapCursorSelectValue @Double @Rational)+    describe "mapCursorToggleSelected" $+        it "produces valid cursors" $+        producesValidsOnValids (mapCursorToggleSelected @Double @Rational)+    describe "mapCursorSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorSelectPrev @Double @Rational)+        it "is a movement" $ isMovementM mapCursorSelectPrev+        it "selects the previous element" pending+    describe "mapCursorSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorSelectNext @Double @Rational)+        it "is a movement" $ isMovementM mapCursorSelectNext+        it "selects the next element" pending+    describe "mapCursorSelectFirst" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorSelectFirst @Double @Rational)+        it "is a movement" $ isMovement mapCursorSelectFirst+        it "is idempotent" $+            idempotentOnValid (mapCursorSelectFirst @Double @Rational)+        it "selects the first element" pending+    describe "mapCursorSelectLast" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorSelectLast @Double @Rational)+        it "is a movement" $ isMovement mapCursorSelectLast+        it "is idempotent" $+            idempotentOnValid (mapCursorSelectLast @Double @Rational)+        it "selects the last element" pending+    describe "mapCursorSelection" $ do+        it "produces valid ints" $+            producesValidsOnValids+                (mapCursorSelection @Double @Rational @Double @Rational)+        it "returns the index of the currently selected element" pending+    describe "mapCursorSelectIndex" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 (mapCursorSelectIndex @Double @Rational)+        it "is the identity function when given the current selection" $+            forAllValid $ \nec ->+                mapCursorSelectIndex (mapCursorSelection nec) nec `shouldBe`+                Just (nec :: MapCursor Double Rational)+        it "returns selects the element at the given index" pending+    describe "mapCursorInsert" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorInsert @Double @Rational @Double @Rational)+        it "inserts a character before the cursor" pending+    describe "mapCursorAppend" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorAppend @Double @Rational @Double @Rational)+        it "inserts a character after the cursor" pending+    describe "mapCursorInsertAndSelectKey" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorInsertAndSelectKey @Double @Rational)+    describe "mapCursorAppendAndSelectKey" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorAppendAndSelectKey @Double @Rational)+    describe "mapCursorInsertAndSelectValue" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorInsertAndSelectValue @Double @Rational)+    describe "mapCursorAppendAndSelectValue" $ do+        it "produces valid cursors" $+            producesValidsOnValids3+                (mapCursorAppendAndSelectValue @Double @Rational)+    describe "mapCursorRemoveElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorRemoveElem @Double @Rational)+        it "removes an element" pending+    describe "mapCursorDeleteElem" $ do+        it "produces valid cursors" $+            producesValidsOnValids (mapCursorDeleteElem @Double @Rational)+        it "deletes an element" pending+    describe "mapCursorSearch" $ do+        it "produces valid cursors when looking for an equal pair" $+            forAllValid $ \(k, v) ->+                producesValidsOnValids $+                mapCursorSearch @Double @Rational (\k_ v_ -> k_ == k && v_ == v)+        it+            "is indeed the right value when it finds a value and is looking for an equal element" $+            forAllValid $ \(k, v) ->+                forAllValid $ \nec ->+                    case mapCursorSearch (\k_ v_ -> k_ == k && v_ == v) nec of+                        Nothing -> pure ()+                        Just e ->+                            rebuildKeyValueCursor (e ^. mapCursorElemL) `shouldBe`+                            (k :: Double, v :: Rational)+    describe "mapCursorSelectOrAdd" $ do+        it "produces valid cursors when looking for an equal element" $+            forAllValid $ \(k, v) ->+                producesValidsOnValids $+                mapCursorSelectOrAdd+                    (\k_ v_ -> k_ == k && v_ == v)+                    (makeKeyValueCursorKey (k :: Double) (v :: Rational))++isMovementM :: (forall k v. MapCursor k v -> Maybe (MapCursor k v)) -> Property+isMovementM func =+    forAllValid $ \lec ->+        case func (lec :: MapCursor Double Double) of+            Nothing -> pure () -- Fine+            Just lec' ->+                let ne = rebuildMapCursor lec+                    ne' = rebuildMapCursor lec'+                 in unless (ne == ne') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show lec+                        , "Map before:  \n" ++ show ne+                        , "Cursor after: \n" ++ show lec'+                        , "Map after:   \n" ++ show ne'+                        ]++isMovement :: (forall k v. MapCursor k v -> MapCursor k v) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildMapCursor (lec :: MapCursor Int Int) `shouldBe`+        rebuildMapCursor (func lec)
+ test/Cursor/Simple/Tree/BaseSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Simple.Tree.BaseSpec+    ( spec+    ) where+++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import qualified Cursor.Simple.Tree as STC (TreeCursor)+import Cursor.Simple.Tree.Gen ()++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    eqSpec @(STC.TreeCursor Int)+    genValidSpec @(STC.TreeCursor Double)+    describe "makeTreeCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (makeTreeCursor @Double)+    describe "makeTreeCursorWithSelection" $+        it "produces valid cursors" $+        producesValidsOnValids2 (makeTreeCursorWithSelection @Double)+    describe "singletonTreeCursor" $+        it "produces valid cursors" $+        producesValidsOnValids (singletonTreeCursor @Double)+    describe "rebuildTreeCursor" $ do+        it "produces valid trees" $+            producesValidsOnValids (rebuildTreeCursor @Double)+        it "is the inverse of makeTreeCursor for integers" $+            inverseFunctions (makeTreeCursor @Int) rebuildTreeCursor+        it+            "is the inverse of makeTreeCursorWithSelection for the current selection" $+            forAllValid $ \tc ->+                case makeTreeCursorWithSelection+                         @Double+                         (treeCursorSelection tc)+                         (rebuildTreeCursor tc) of+                    Nothing ->+                        expectationFailure+                            "makeTreeCursorWithSelection should not have failed."+                    Just r -> r `treeShouldBe` tc
+ test/Cursor/Simple/Tree/CollapseSpec.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.CollapseSpec+    ( spec+    ) where++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()++spec :: Spec+spec = do+    describe "treeCursorOpenCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ treeCursorOpenCurrentForest @Double @Double+    describe "treeCursorCloseCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ treeCursorCloseCurrentForest @Double @Double+    describe "treeCursorToggleCurrentForest" $+        it "produces valid cursors" $+        producesValidsOnValids $ treeCursorToggleCurrentForest @Double @Double
+ test/Cursor/Simple/Tree/DeleteSpec.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.DeleteSpec+    ( spec+    ) where++import Data.Tree++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree+       (CTree(..), TreeCursor(..), closedForest, openForest)+import Cursor.Types++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    describe "treeCursorDeleteSubTreeAndSelectPrevious" $ do+        it "produces valids on valids" $+            producesValidsOnValids $+            treeCursorDeleteSubTreeAndSelectPrevious @Double+        it "deletes the current subtree selects the previous subtree" pending+    describe "treeCursorDeleteSubTreeAndSelectNext" $ do+        it "produces valids on valids" $+            producesValidsOnValids $+            treeCursorDeleteSubTreeAndSelectNext @Double+        it "deletes the current subtree selects the next subtree" pending+    describe "treeCursorDeleteSubTreeAndSelectAbove" $ do+        it "produces valids on valids" $+            producesValidsOnValids $+            treeCursorDeleteSubTreeAndSelectAbove @Double+        it "deletes the current subtree selects the above node" pending+    describe "treeCursorRemoveSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorRemoveSubTree @Double+        it "removes the current subtree" pending+    describe "treeCursorDeleteSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDeleteSubTree @Double+        it "deletes the current subtree" pending+    describe "treeCursorDeleteElemAndSelectPrevious" $ do+        it "produces valids on valids" $+            producesValidsOnValids $+            treeCursorDeleteElemAndSelectPrevious @Double+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        TreeCursor+                        { treeAbove = Nothing+                        , treeCurrent = 1 :: Int+                        , treeBelow = closedForest [Node 2 fs]+                        }+                in case treeCursorDeleteElemAndSelectPrevious+                            simpleDeleteElemStart of+                       Nothing -> pure ()+                       Just Deleted ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectPrevious should not have deleted the entire example tree."+                       Just (Updated _) ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectPrevious should not have updated the example tree, but failed instead."+        it+            "deletes the current element and selects the previous element"+            pending+    describe "treeCursorDeleteElemAndSelectNext" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDeleteElemAndSelectNext @Double+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        TreeCursor+                        { treeAbove = Nothing+                        , treeCurrent = 1+                        , treeBelow = openForest [CNode 2 fs]+                        }+                    simpleDeleteElemExpected =+                        TreeCursor+                        { treeAbove = Nothing+                        , treeCurrent = 2 :: Int+                        , treeBelow = fs+                        }+                in case treeCursorDeleteElemAndSelectNext simpleDeleteElemStart of+                       Nothing ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectNext should not have failed."+                       Just Deleted ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectNext should not have deleted the entire example tree."+                       Just (Updated f) ->+                           f `treeShouldBe` simpleDeleteElemExpected+        it "deletes the current element and selects the next element" pending+    describe "treeCursorDeleteElemAndSelectAbove" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDeleteElemAndSelectAbove @Double+        it "works for this simple example" $+            forAllValid $ \fs ->+                let simpleDeleteElemStart =+                        TreeCursor+                        { treeAbove = Nothing+                        , treeCurrent = 1 :: Int+                        , treeBelow = closedForest [Node 2 fs]+                        }+                in case treeCursorDeleteElemAndSelectAbove simpleDeleteElemStart of+                       Nothing -> pure ()+                       Just Deleted ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectAbove should not have deleted the entire example tree."+                       Just (Updated _) ->+                           expectationFailure+                               "treeCursorDeleteElemAndSelectAbove should not have updated the example tree, but failed instead."+        it "deletes the current element and selects the above element" pending+    describe "treeCursorRemoveElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorRemoveElem @Double+        it "removes the current element" pending+    describe "treeCursorDeleteElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDeleteElem @Double+        it "deletes the current element" pending
+ test/Cursor/Simple/Tree/DemoteSpec.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.DemoteSpec+    ( spec+    ) where++import Data.Tree++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree+       (TreeAbove(..), TreeCursor(..), closedForest, emptyCForest)++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    functorSpec @DemoteResult+    describe "treeCursorDemoteElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDemoteElem @Double+        it "Works on the example from the docs" $+            let promoteStart =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'a' [node 'b' []]]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [node 'e' []]+                              }+                    , treeCurrent = 'c'+                    , treeBelow = closedForest [Node 'd' []]+                    }+                promoteEnd =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'b' []]+                              , treeAboveAbove =+                                    Just+                                        TreeAbove+                                        { treeAboveLefts = []+                                        , treeAboveAbove = Nothing+                                        , treeAboveNode = 'p'+                                        , treeAboveRights = [node 'e' []]+                                        }+                              , treeAboveNode = 'a'+                              , treeAboveRights = [node 'd' []]+                              }+                    , treeCurrent = 'c'+                    , treeBelow = emptyCForest+                    }+            in case treeCursorDemoteElem promoteStart of+                   Demoted tc' -> tc' `treeShouldBe` promoteEnd+                   _ ->+                       expectationFailure+                           "treeCursorDemoteElem should not have failed"+        it "demotes the current node to the level of its children" pending+    describe "treeCursorDemoteSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorDemoteSubTree @Double+        it "Works on the example from the docs" $+            let promoteStart =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'a' [node 'b' []]]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [node 'e' []]+                              }+                    , treeCurrent = 'c'+                    , treeBelow = closedForest [Node 'd' []]+                    }+                promoteEnd =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'b' []]+                              , treeAboveAbove =+                                    Just+                                        TreeAbove+                                        { treeAboveLefts = []+                                        , treeAboveAbove = Nothing+                                        , treeAboveNode = 'p'+                                        , treeAboveRights = [node 'e' []]+                                        }+                              , treeAboveNode = 'a'+                              , treeAboveRights = []+                              }+                    , treeCurrent = 'c'+                    , treeBelow = closedForest [Node 'd' []]+                    }+            in case treeCursorDemoteSubTree promoteStart of+                   Demoted tc' -> tc' `treeShouldBe` promoteEnd+                   _ ->+                       expectationFailure+                           "treeCursorDemoteSubTree should not have failed"+        it "demotes the current subtree to the level of its children" pending+    describe "treeCursorDemoteElemUnder" $ do+        it "produces valids on valids" $+            producesValidsOnValids3 $ treeCursorDemoteElemUnder @Double @Double+        it "Works on the example from the docs" $+            forAllValid $ \b1 ->+                forAllValid $ \b2 ->+                    let demoteStart =+                            TreeCursor+                            { treeAbove =+                                  Just+                                      TreeAbove+                                      { treeAboveLefts = []+                                      , treeAboveAbove = Nothing+                                      , treeAboveNode = 'p'+                                      , treeAboveRights = []+                                      }+                            , treeCurrent = 'a'+                            , treeBelow = closedForest [Node 'b' []]+                            }+                        demoteEnd =+                            TreeCursor+                            { treeAbove =+                                  Just+                                      TreeAbove+                                      { treeAboveLefts = []+                                      , treeAboveAbove =+                                            Just+                                                TreeAbove+                                                { treeAboveLefts = []+                                                , treeAboveAbove = Nothing+                                                , treeAboveNode = 'p'+                                                , treeAboveRights =+                                                      [node b2 [node 'b' []]]+                                                }+                                      , treeAboveNode = b1+                                      , treeAboveRights = []+                                      }+                            , treeCurrent = 'a'+                            , treeBelow = emptyCForest+                            }+                    in case treeCursorDemoteElemUnder b1 b2 demoteStart of+                           Just tc' -> tc' `treeShouldBe` demoteEnd+                           _ ->+                               expectationFailure+                                   "treeCursorDemoteElemUnder should not have failed"+        it "demotes the current node to the level of its children" pending+    describe "treeCursorDemoteSubTreeUnder" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $+            treeCursorDemoteSubTreeUnder @Double @Double+        it "Works on the example from the docs" $+            forAllValid $ \v -> do+                let demoteStart =+                        TreeCursor+                        { treeAbove = Nothing+                        , treeCurrent = 'a'+                        , treeBelow = closedForest [Node 'b' []]+                        }+                    demoteEnd =+                        TreeCursor+                        { treeAbove =+                              Just+                                  TreeAbove+                                  { treeAboveLefts = []+                                  , treeAboveAbove = Nothing+                                  , treeAboveNode = v+                                  , treeAboveRights = []+                                  }+                        , treeCurrent = 'a'+                        , treeBelow = closedForest [Node 'b' []]+                        }+                treeCursorDemoteSubTreeUnder v demoteStart `treeShouldBe`+                    demoteEnd+        it+            "demotes the current subtree to the level of its children, by adding a root"+            pending
+ test/Cursor/Simple/Tree/InsertSpec.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.InsertSpec+    ( spec+    ) where++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()++spec :: Spec+spec = do+    describe "treeCursorInsert" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $ treeCursorInsert @Double @Double+        it "inserts the element" pending+    describe "treeCursorInsertAndSelect" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $ treeCursorInsertAndSelect @Double+        it "inserts and select the element" pending+    describe "treeCursorAppend" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $ treeCursorAppend @Double @Double+        it "appends the element" pending+    describe "treeCursorAppendAndSelect" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $ treeCursorAppendAndSelect @Double+        it "appends and select the element" pending+    describe "treeCursorAddChildAtPos" $ do+        it "produces valid cursors " $+            producesValidsOnValids3 $ treeCursorAddChildAtPos @Double @Double+        it+            "adds a tree at the given index in the children of the current node"+            pending+    describe "treeCursorAddChildAtStart" $ do+        it "produces valid cursors " $+            producesValidsOnValids2 $ treeCursorAddChildAtStart @Double @Double+        it+            "adds a tree at the start of the children of the current node"+            pending+    describe "treeCursorAddChildAtEnd" $ do+        it "produces valid cursors " $+            producesValidsOnValids2 $ treeCursorAddChildAtEnd @Double @Double+        it "adds a tree at the end of the children of the current node" pending
+ test/Cursor/Simple/Tree/MovementSpec.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.MovementSpec+    ( spec+    ) where++import Control.Monad (unless)++import Text.Show.Pretty++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree+       (CTree(..), TreeAbove(..), TreeCursor(..), emptyCForest,+        openForest)++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    describe "treeCursorSelection" $+        it "produces valids on valids" $+        producesValidsOnValids (treeCursorSelection @Double @Double)+    describe "treeCursorSelect" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 (treeCursorSelect @Double)+        it "is identity with the current selection" $+            forAllValid $ \tc ->+                let sel = treeCursorSelection tc+                in case treeCursorSelect @Double sel tc of+                       Nothing ->+                           expectationFailure+                               "treeCursorSelect should not have failed."+                       Just r ->+                           unless (r == tc) $+                           expectationFailure $+                           unlines+                               [ "selection:"+                               , ppShow sel+                               , "expected:"+                               , drawTreeCursor tc+                               , "actual:"+                               , drawTreeCursor r+                               ]+    describe "treeCursorSelectPrevOnSameLevel" $ do+        testMovementM treeCursorSelectPrevOnSameLevel+        it "selects the previous element" pending+        it+            "after treeCursorSelectNextOnSameLevel is identity if they don't fail" $ do+            inverseFunctionsIfSucceedOnValid+                (treeCursorSelectNextOnSameLevel @Double)+                (treeCursorSelectPrevOnSameLevel @Double)+    describe "treeCursorSelectNextOnSameLevel" $ do+        testMovementM treeCursorSelectNextOnSameLevel+        it "selects the next element" pending+        it+            "after treeCursorSelectPrevOnSameLevel is identity if they don't fail" $ do+            inverseFunctionsIfSucceedOnValid+                (treeCursorSelectPrevOnSameLevel @Double)+                (treeCursorSelectNextOnSameLevel @Double)+    describe "treeCursorSelectAbovePrev" $ do+        testMovementM treeCursorSelectAbovePrev+        it "Works for this classic example" $+            -- > 0+            --   > 1+            --     > 2+            --       > 3 <- expected end cursor+            --   > 4 <- start cursor+         do+            let start =+                    TreeCursor+                    { treeAbove =+                          Just+                              (TreeAbove+                               { treeAboveLefts =+                                     [ CNode 1 $+                                       openForest+                                           [ CNode 2 $+                                             openForest [CNode 3 emptyCForest]+                                           ]+                                     ]+                               , treeAboveAbove = Nothing+                               , treeAboveNode = 0+                               , treeAboveRights = []+                               })+                    , treeCurrent = 4 :: Int+                    , treeBelow = emptyCForest+                    }+                expected =+                    TreeCursor+                    { treeAbove =+                          Just+                              (TreeAbove+                               { treeAboveLefts = []+                               , treeAboveAbove =+                                     Just+                                         (TreeAbove+                                          { treeAboveLefts = []+                                          , treeAboveAbove =+                                                Just+                                                    (TreeAbove+                                                     { treeAboveLefts = []+                                                     , treeAboveAbove = Nothing+                                                     , treeAboveNode = 0+                                                     , treeAboveRights =+                                                           [ CNode+                                                                 4+                                                                 emptyCForest+                                                           ]+                                                     })+                                          , treeAboveNode = 1+                                          , treeAboveRights = []+                                          })+                               , treeAboveNode = 2+                               , treeAboveRights = []+                               })+                    , treeCurrent = 3+                    , treeBelow = emptyCForest+                    }+            case treeCursorSelectAbovePrev start of+                Nothing ->+                    expectationFailure+                        "treeCursorSelectAbovePrev should not have failed"+                Just r -> r `treeShouldBe` expected+        it "selects the previous element" pending+        it "after treeCursorSelectAboveNext is identity if they don't fail" $ do+            forAllValid $ \tc ->+                case treeCursorSelectAboveNext @Double tc of+                    Nothing -> pure ()+                    Just tc' ->+                        case treeCursorSelectAbovePrev tc' of+                            Nothing ->+                                expectationFailure+                                    "treeCursorSelectAbovePrev should not have failed."+                            Just tc'' ->+                                unless (tc == tc'') $+                                expectationFailure $+                                unlines+                                    [ "treeCursorSelectAboveNext and treeCursorSelectAbovePrev should have round-tripped."+                                    , "Started with:"+                                    , drawTreeCursor tc+                                    , "after treeCursorSelectAboveNext"+                                    , drawTreeCursor tc'+                                    , "after treeCursorSelectAbovePrev"+                                    , drawTreeCursor tc''+                                    , "instead of"+                                    , drawTreeCursor tc+                                    ]+    describe "treeCursorSelectAboveNext" $ do+        testMovementM treeCursorSelectAboveNext+        it "Works for this classic example" $+            -- > 0+            --   > 1+            --     > 2+            --       > 3 <- start cursor+            --   > 4 <- expected end cursor+         do+            let start =+                    TreeCursor+                    { treeAbove =+                          Just+                              (TreeAbove+                               { treeAboveLefts = []+                               , treeAboveAbove =+                                     Just+                                         (TreeAbove+                                          { treeAboveLefts = []+                                          , treeAboveAbove =+                                                Just+                                                    (TreeAbove+                                                     { treeAboveLefts = []+                                                     , treeAboveAbove = Nothing+                                                     , treeAboveNode = 0+                                                     , treeAboveRights =+                                                           [node 4 []]+                                                     })+                                          , treeAboveNode = 1+                                          , treeAboveRights = []+                                          })+                               , treeAboveNode = 2+                               , treeAboveRights = []+                               })+                    , treeCurrent = 3+                    , treeBelow = emptyCForest+                    }+                expected =+                    TreeCursor+                    { treeAbove =+                          Just+                              (TreeAbove+                               { treeAboveLefts =+                                     [ CNode 1 $+                                       openForest+                                           [ CNode 2 $+                                             openForest [CNode 3 emptyCForest]+                                           ]+                                     ]+                               , treeAboveAbove = Nothing+                               , treeAboveNode = 0+                               , treeAboveRights = []+                               })+                    , treeCurrent = 4 :: Int+                    , treeBelow = emptyCForest+                    }+            case treeCursorSelectAboveNext start of+                Nothing ->+                    expectationFailure+                        "treeCursorSelectAboveNext should not have failed."+                Just r -> r `treeShouldBe` expected+        it "selects the next element" pending+        it "after treeCursorSelectAbovePrev is identity if they don't fail" $ do+            forAllValid $ \tc ->+                case treeCursorSelectAbovePrev @Double tc of+                    Nothing -> pure ()+                    Just tc' ->+                        case treeCursorSelectAboveNext tc' of+                            Nothing -> pure ()+                            Just tc'' ->+                                unless (tc == tc'') $+                                expectationFailure $+                                unlines+                                    [ "treeCursorSelectAbovePrev and treeCursorSelectAboveNext should have round-tripped."+                                    , "Started with:"+                                    , drawTreeCursor tc+                                    , "after treeCursorSelectAbovePrev"+                                    , drawTreeCursor tc'+                                    , "after treeCursorSelectAboveNext"+                                    , drawTreeCursor tc''+                                    , "instead of"+                                    , drawTreeCursor tc+                                    ]+    describe "treeCursorSelectPrev" $ do+        testMovementM treeCursorSelectPrev+        it "selects the previous element" pending+        it "after treeCursorSelectNext is identity if they don't fail" $ do+            inverseFunctionsIfSucceedOnValid+                (treeCursorSelectNext @Double)+                (treeCursorSelectPrev @Double)+    describe "treeCursorSelectNext" $ do+        testMovementM treeCursorSelectNext+        it "selects the next element" pending+        it "after treeCursorSelectPrev is identity if they don't fail" $ do+            inverseFunctionsIfSucceedOnValid+                (treeCursorSelectPrev @Double)+                (treeCursorSelectNext @Double)+    describe "treeCursorSelectFirst" $ do+        testMovement treeCursorSelectFirst+        it "selects the first element" pending+        it "is idempotent" $ idempotentOnValid $ treeCursorSelectFirst @Double+    describe "treeCursorSelectLast" $ do+        testMovement treeCursorSelectLast+        it "selects the last element" pending+        it "is idempotent" $ idempotentOnValid $ treeCursorSelectLast @Double+    describe "treeCursorSelectAbove" $ do+        testMovementM treeCursorSelectAbove+        it "selects the element above" pending+        it "after treeCursorSelectBelow is identity if they don't fail" $ do+            inverseFunctionsIfSucceedOnValid+                (treeCursorSelectBelowAtStart @Double) $+                treeCursorSelectAbove @Double+    describe "treeCursorSelectBelowAtPos" $ do+        it "produces valids on valids" $+            producesValidsOnValids2 $ treeCursorSelectBelowAtPos @Double+        it "is a movement" $+            forAllValid $ \n -> isMovementM $ treeCursorSelectBelowAtPos n+        it "selects the element n-th below" pending+    describe "treeCursorSelectBelowAtStart" $ do+        testMovementM treeCursorSelectBelowAtStart+        it "selects the first child below" pending+    describe "treeCursorSelectBelowAtEnd" $ do+        testMovementM treeCursorSelectBelowAtEnd+        it "selects the last child below" pending+    describe "treeCursorSelectBelowAtStartRecursively" $ do+        testMovementM treeCursorSelectBelowAtStartRecursively+        it "selects the first child below, recursively" pending+    describe "treeCursorSelectBelowAtEndRecursively" $ do+        testMovementM treeCursorSelectBelowAtEndRecursively+        it "selects the last child below, recursively" pending
+ test/Cursor/Simple/Tree/PromoteSpec.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.PromoteSpec+    ( spec+    ) where++import Data.Tree++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree+       ( CTree(..), TreeAbove(..), TreeCursor(..),+        closedForest, emptyCForest, openForest)++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    functorSpec @PromoteElemResult+    applicativeSpec @PromoteElemResult+    monadSpec @PromoteElemResult+    describe "treeCursorPromoteElem" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorPromoteElem @Double+        it "Works on the example from the docs" $+            let promoteStart =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'b' [node 'c' []]]+                              , treeAboveAbove =+                                    Just+                                        TreeAbove+                                        { treeAboveLefts = []+                                        , treeAboveAbove = Nothing+                                        , treeAboveNode = 'p'+                                        , treeAboveRights = [node 'h' []]+                                        }+                              , treeAboveNode = 'a'+                              , treeAboveRights = [node 'f' [node 'g' []]]+                              }+                    , treeCurrent = 'd'+                    , treeBelow = closedForest [Node 'e' []]+                    }+                promoteEnd =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts =+                                    [ CNode 'a' $+                                      openForest+                                          [ CNode 'b' $+                                            openForest+                                                [ CNode 'c' emptyCForest+                                                , CNode 'e' emptyCForest+                                                ]+                                          , CNode 'f' $+                                            closedForest [Node 'g' []]+                                          ]+                                    ]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [CNode 'h' emptyCForest]+                              }+                    , treeCurrent = 'd'+                    , treeBelow = emptyCForest+                    }+            in case treeCursorPromoteElem promoteStart of+                   PromotedElem tc' -> tc' `treeShouldBe` promoteEnd+                   _ ->+                       expectationFailure+                           "treeCursorPromoteElem should not have failed"+        it "promotes the current node to the level of its parent" pending+    functorSpec @PromoteResult+    applicativeSpec @PromoteResult+    monadSpec @PromoteResult+    describe "treeCursorPromoteSubTree" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorPromoteSubTree @Double+        it "Works on the example from the docs" $+            let promoteStart =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts =+                                    [CNode 'b' $ closedForest [Node 'c' []]]+                              , treeAboveAbove =+                                    Just+                                        TreeAbove+                                        { treeAboveLefts = []+                                        , treeAboveAbove = Nothing+                                        , treeAboveNode = 'p'+                                        , treeAboveRights = [node 'h' []]+                                        }+                              , treeAboveNode = 'a'+                              , treeAboveRights =+                                    [CNode 'f' $ closedForest [Node 'g' []]]+                              }+                    , treeCurrent = 'd'+                    , treeBelow = closedForest [Node 'e' []]+                    }+                promoteEnd =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts =+                                    [ CNode 'a' $+                                      openForest+                                          [ CNode 'b' $+                                            closedForest [Node 'c' []]+                                          , CNode 'f' $+                                            closedForest [Node 'g' []]+                                          ]+                                    ]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [CNode 'h' $ closedForest []]+                              }+                    , treeCurrent = 'd'+                    , treeBelow = closedForest [Node 'e' []]+                    }+            in case treeCursorPromoteSubTree promoteStart of+                   Promoted tc' -> tc' `treeShouldBe` promoteEnd+                   _ ->+                       expectationFailure+                           "treeCursorPromoteSubTree should not have failed"+        it "promotes the current subtree to the level of its parent" pending
+ test/Cursor/Simple/Tree/SwapSpec.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Cursor.Simple.Tree.SwapSpec+    ( spec+    ) where++import Test.Hspec++import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree (TreeAbove(..), TreeCursor(..), emptyCForest)++import Cursor.Simple.Tree.TestUtils++spec :: Spec+spec = do+    functorSpec @SwapResult+    describe "treeCursorSwapPrev" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorSwapPrev @Double @Double+        it "works on the example from the docs" $+            let start =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'a' []]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = []+                              }+                    , treeCurrent = 'b'+                    , treeBelow = emptyCForest+                    }+                end =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = []+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [node 'a' []]+                              }+                    , treeCurrent = 'b'+                    , treeBelow = emptyCForest+                    }+            in case treeCursorSwapPrev start of+                   Swapped r -> r `treeShouldBe` end+                   _ ->+                       expectationFailure+                           "treeCursorSwapPrev should not have failed."+        it "reverts treeCursorSwapNext" $+            inverseFunctionsIfSucceedOnValid+                (treeCursorSwapNext @Double @Double)+                (treeCursorSwapPrev @Double @Double)+        it "swaps the current node with the previous node" pending+    describe "treeCursorSwapNext" $ do+        it "produces valids on valids" $+            producesValidsOnValids $ treeCursorSwapNext @Double @Double+        it "works on the example from the docs" $+            let start =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = []+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = [node 'b' []]+                              }+                    , treeCurrent = 'a'+                    , treeBelow = emptyCForest+                    }+                end =+                    TreeCursor+                    { treeAbove =+                          Just+                              TreeAbove+                              { treeAboveLefts = [node 'b' []]+                              , treeAboveAbove = Nothing+                              , treeAboveNode = 'p'+                              , treeAboveRights = []+                              }+                    , treeCurrent = 'a'+                    , treeBelow = emptyCForest+                    }+            in case treeCursorSwapNext start of+                   Swapped r -> r `treeShouldBe` end+                   _ ->+                       expectationFailure+                           "treeCursorSwapNext should not have failed."+        it "reverts treeCursorSwapNext" $+            inverseFunctionsIfSucceedOnValid+                (treeCursorSwapPrev @Double @Double)+                (treeCursorSwapNext @Double @Double)+        it "swaps the current node with the next node" pending
+ test/Cursor/Simple/Tree/TestUtils.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Simple.Tree.TestUtils where++import Data.Tree++import Control.Monad (unless)++import Test.Hspec++import Test.QuickCheck+import Test.Validity++import Cursor.Simple.Tree hiding (TreeCursor)+import qualified Cursor.Simple.Tree as STC (TreeCursor)+import Cursor.Simple.Tree.Gen ()+import Cursor.Tree (CTree(..), closedForest)++testMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Spec+testMovement func = do+    it "produces valids on valids" $ producesValidsOnValids $ func @Double+    it "is a movement" $ isMovement func++testMovementM ::+       (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Spec+testMovementM func = do+    it "produces valids on valids" $ producesValidsOnValids $ func @Double+    it "is a movement" $ isMovementM func++isMovementM ::+       (forall a. STC.TreeCursor a -> Maybe (STC.TreeCursor a)) -> Property+isMovementM func =+    forAllValid @(STC.TreeCursor Int) $ \lec ->+        case func lec of+            Nothing -> pure () -- Fine+            Just lec' ->+                let ne = rebuildCTree $ rebuildTreeCursor lec+                    ne' = rebuildCTree $ rebuildTreeCursor lec'+                in unless (ne == ne') $+                   expectationFailure $+                   unlines+                       [ "Cursor before:\n" ++ drawTreeCursor lec+                       , "Tree before:  \n" ++ drawTree (fmap show ne)+                       , "Cursor after: \n" ++ drawTreeCursor lec'+                       , "Tree after:   \n" ++ drawTree (fmap show ne')+                       ]++isMovement :: (forall a. STC.TreeCursor a -> STC.TreeCursor a) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildTreeCursor (lec :: STC.TreeCursor Int) `shouldBe`+        rebuildTreeCursor (func lec)++treeShouldBe ::+       (Show a, Eq a) => STC.TreeCursor a -> STC.TreeCursor a -> Expectation+treeShouldBe actual expected =+    unless (actual == expected) $+    expectationFailure $+    unlines+        [ "The following should have been equal."+        , "actual:"+        , drawTreeCursor actual+        , "expected:"+        , drawTreeCursor expected+        ]++instance CanFail SwapResult where+    hasFailed (Swapped _) = False+    hasFailed _ = True+    resultIfSucceeded (Swapped a) = Just a+    resultIfSucceeded _ = Nothing++node :: a -> [CTree a] -> CTree a+node a ts = CNode a $ closedForest $ map rebuildCTree ts
+ test/Cursor/TextFieldSpec.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.TextFieldSpec+    ( spec+    ) where++import Test.Hspec++import Test.QuickCheck+import Test.Validity++-- import Test.Validity.Optics+import Text.Show.Pretty (ppShow)++import qualified Data.Text as T++import qualified Data.List.NonEmpty as NE++import Control.Monad++import Cursor.TextField+import Cursor.TextField.Gen ()+import Cursor.Types++spec :: Spec+spec = do+    eqSpec @TextFieldCursor+    genValidSpec @TextFieldCursor+    describe "makeTextFieldCursor" $+        it "produces valid cursors" $ producesValidsOnValids makeTextFieldCursor+    describe "makeTextFieldCursorWithSelection" $ do+        it "produces valid cursors" $+            producesValidsOnValids3 makeTextFieldCursorWithSelection+        it+            "is the inverse of rebuildTextFieldCursor when using the current selection" $+            forAllValid $ \tfc -> do+                let (x, y) = textFieldCursorSelection tfc+                    t = rebuildTextFieldCursor tfc+                case makeTextFieldCursorWithSelection x y t of+                    Nothing ->+                        expectationFailure+                            "makeTextFieldCursorWithSelection should not have failed."+                    Just tfc' ->+                        unless (tfc' == tfc) $+                        expectationFailure $+                        unlines+                            [ "expected"+                            , ppShow tfc+                            , "actual"+                            , ppShow tfc'+                            , "The selection of the original (expected) cursor was:"+                            , show (x, y)+                            , "The rebuild text was:"+                            , show t+                            ]+    describe "rebuildTextFieldCursorLines" $ do+        it "produces valid lists" $+            producesValidsOnValids rebuildTextFieldCursorLines+        it "produces texts without newlines" $+            forAllValid $ \tfc -> do+                let ls = NE.toList $ rebuildTextFieldCursorLines tfc+                unless (all (T.all (/= '\n')) ls) $+                    expectationFailure $+                    unlines $+                    "Some of the following lines contain a newline:" :+                    map show ls+    describe "rebuildTextFieldCursor" $ do+        it "produces valid texts" $+            producesValidsOnValids rebuildTextFieldCursor+        it "is the inverse of makeTextFieldCursor for integers" $+            inverseFunctionsOnValid makeTextFieldCursor rebuildTextFieldCursor+        it+            "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $+            forAllValid $ \x ->+                forAllValid $ \y ->+                    inverseFunctionsIfFirstSucceedsOnValid+                        (makeTextFieldCursorWithSelection x y)+                        rebuildTextFieldCursor+    describe "textFieldCursorSelection" $+        it "produces valid tuples" $+        producesValidsOnValids textFieldCursorSelection+    describe "emptyTextFieldCursor" $+        it "is valid" $ shouldBeValid emptyTextFieldCursor+    describe "nullTextFieldCursor" $+        it "produces valid" $ producesValidsOnValids nullTextFieldCursor+    describe "textFieldCursorSelectPrevLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectPrevLine+        it "is a movement" $ isMovementM textFieldCursorSelectPrevLine+        it "selects the previous line" pending+    describe "textFieldCursorSelectNextLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectNextLine+        it "is a movement" $ isMovementM textFieldCursorSelectNextLine+        it "selects the next line" pending+    describe "textFieldCursorSelectFirstLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectFirstLine+        it "is a movement" $ isMovement textFieldCursorSelectFirstLine+        it "is idempotent" $ idempotentOnValid textFieldCursorSelectFirstLine+        it "selects the first line" pending+    describe "textFieldCursorSelectLastLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectLastLine+        it "is a movement" $ isMovement textFieldCursorSelectLastLine+        it "is idempotent" $ idempotentOnValid textFieldCursorSelectLastLine+        it "selects the last line" pending+    describe "textFieldCursorSelectPrevChar" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectPrevChar+        it "selects the previous character on the current line" pending+    describe "textFieldCursorSelectNextChar" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectNextChar+        it "selects the previous character on the current line" pending+    describe "textFieldCursorIndexOnLine" $ do+        it "produces valid indices" $+            producesValidsOnValids textFieldCursorIndexOnLine+        it "returns the index on the current line" pending+    describe "textFieldCursorSelectIndexOnLine" $ do+        it "produces valid cursors for any index" $+            producesValidsOnValids2 textFieldCursorSelectIndexOnLine+        it "selects the given index on the current line" pending+    describe "textFieldCursorInsertChar" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (textFieldCursorInsertChar d)+        it "inserts a character before the cursor on the current line" pending+    describe "textFieldCursorAppendChar" $ do+        it "produces valid cursors" $+            forAllValid $ \d ->+                producesValidsOnValids (textFieldCursorAppendChar d)+        it "inserts a character after the cursor on the currrent line" pending+    describe "textFieldCursorInsertNewline" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorInsertNewline+        it "inserts a new line" pending+    describe "textFieldCursorAppendNewline" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorAppendNewline+    describe "textFieldCursorRemove" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorRemove+        it "removes empty text field cursor" $+            textFieldCursorRemove emptyTextFieldCursor `shouldBe` Just Deleted+        it "removes a character or a line" pending+    describe "textFieldCursorDelete" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorDelete+        it "removes empty text field cursor" $+            textFieldCursorDelete emptyTextFieldCursor `shouldBe` Just Deleted+        it "deletes a character or a line" pending+    describe "textFieldCursorSelectStartOfLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectStartOfLine+        it "selects the start of the current line" pending+    describe "textFieldCursorSelectEndOfLine" $ do+        it "produces valid cursors" $+            producesValidsOnValids textFieldCursorSelectEndOfLine+        it "selects the end of the current line" pending++isMovementM :: (TextFieldCursor -> Maybe TextFieldCursor) -> Property+isMovementM func =+    forAllValid $ \tfc ->+        case func tfc of+            Nothing -> pure () -- Fine+            Just tfc' ->+                let tf = rebuildTextFieldCursor tfc+                    tf' = rebuildTextFieldCursor tfc'+                 in unless (tf == tf') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show tfc+                        , "TextField before:  \n" ++ show tf+                        , "Cursor after: \n" ++ show tfc'+                        , "TextField after:   \n" ++ show tf'+                        ]++isMovement :: (TextFieldCursor -> TextFieldCursor) -> Property+isMovement func =+    forAllValid $ \tfc ->+        rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)
+ test/Cursor/TextSpec.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}++module Cursor.TextSpec+    ( spec+    ) where++import Test.Hspec+import Test.QuickCheck+import Test.Validity++import Control.Monad++import Cursor.Text+import Cursor.Text.Gen ()++spec :: Spec+spec = do+    eqSpec @TextCursor+    genValidSpec @TextCursor+    describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor+    describe "makeTextCursor" $+        it "produces valid list cursors" $ producesValidsOnValids makeTextCursor+    describe "makeTextCursorWithSelection" $+        it "produces valid list cursors" $+        producesValidsOnValids2 makeTextCursorWithSelection+    describe "rebuildTextCursor" $ do+        it "produces valid lists" $ producesValidsOnValids rebuildTextCursor+        it "is the inverse of makeTextCursor" $+            inverseFunctionsIfFirstSucceedsOnValid+                makeTextCursor+                rebuildTextCursor+        it "is the inverse of makeTextCursorWithSelection for any index" $+            forAllUnchecked $ \i ->+                inverseFunctionsIfFirstSucceedsOnValid+                    (makeTextCursorWithSelection i)+                    rebuildTextCursor+    describe "textCursorNull" $+        it "produces valid bools" $ producesValidsOnValids textCursorNull+    describe "textCursorLength" $+        it "produces valid ints" $ producesValidsOnValids textCursorLength+    describe "textCursorIndex" $+        it "produces valid indices" $ producesValidsOnValids textCursorIndex+    describe "textCursorSelectPrev" $ do+        it "produces valid cursors" $+            producesValidsOnValids textCursorSelectPrev+        it "is a movement" $ isMovementM textCursorSelectPrev+        it "selects the previous position" pending+    describe "textCursorSelectNext" $ do+        it "produces valid cursors" $+            producesValidsOnValids textCursorSelectNext+        it "is a movement" $ isMovementM textCursorSelectNext+        it "selects the next position" pending+    describe "textCursorSelectIndex" $ do+        it "produces valid cursors" $+            producesValidsOnValids2 textCursorSelectIndex+        it "is a movement" $+            forAllUnchecked $ \ix -> isMovement (textCursorSelectIndex ix)+        it "selects the position at the given index" pending+        it+            "produces a cursor that has the given selection for valid selections in the cursor" $+            forAllValid $ \tc ->+                forAll (choose (0, textCursorLength tc)) $ \i ->+                    textCursorIndex (textCursorSelectIndex i tc) `shouldBe` i+    describe "textCursorSelectStart" $ do+        it "produces valid cursors" $+            producesValidsOnValids textCursorSelectStart+        it "is a movement" $ isMovement textCursorSelectStart+        it "is idempotent" $ idempotent textCursorSelectStart+        it "selects the starting position" pending+    describe "textCursorSelectEnd" $ do+        it "produces valid cursors" $ producesValidsOnValids textCursorSelectEnd+        it "is a movement" $ isMovement textCursorSelectEnd+        it "is idempotent" $ idempotent textCursorSelectEnd+        it "selects the end position" pending+    describe "textCursorPrevChar" $ do+        it "produces valid items" $ producesValidsOnValids textCursorPrevChar+        it "returns the item before the position" pending+    describe "textCursorNextChar" $ do+        it "produces valid items" $ producesValidsOnValids textCursorNextChar+        it "returns the item after the position" pending+    describe "textCursorInsert" $ do+        it "produces valids" $+            forAllValid $ \d -> producesValidsOnValids (textCursorInsert d)+        it "inserts an item before the cursor" $ pending+    describe "textCursorAppend" $ do+        it "produces valids" $+            forAllValid $ \d -> producesValidsOnValids (textCursorAppend d)+        it "inserts an item after the cursor" $ pending+    describe "textCursorRemove" $ do+        it "produces valids" $ validIfSucceedsOnValid textCursorRemove+        it "removes an item before the cursor" $ pending+    describe "textCursorDelete" $ do+        it "produces valids" $ validIfSucceedsOnValid textCursorDelete+        it "removes an item before the cursor" $ pending+    describe "textCursorSplit" $ do+        it "produces valids" $ producesValidsOnValids textCursorSplit+        it+            "produces two list cursors that rebuild to the rebuilding of the original" $+            forAllValid $ \lc ->+                let (lc1, lc2) = textCursorSplit lc+                 in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe`+                    rebuildTextCursor lc+    describe "textCursorCombine" $ do+        it "produces valids" $ producesValidsOnValids2 textCursorCombine+        it+            "produces a list that rebuilds to the rebuilding of the original two cursors" $+            forAllValid $ \lc1 ->+                forAllValid $ \lc2 ->+                    let lc = textCursorCombine lc1 lc2+                     in rebuildTextCursor lc `shouldBe`+                        (rebuildTextCursor lc1 <> rebuildTextCursor lc2)++isMovementM :: (TextCursor -> Maybe TextCursor) -> Property+isMovementM func =+    forAllValid $ \tc ->+        case func tc of+            Nothing -> pure () -- Fine+            Just tc' ->+                let t = rebuildTextCursor tc+                    t' = rebuildTextCursor tc'+                 in unless (t == t') $+                    expectationFailure $+                    unlines+                        [ "Cursor before:\n" ++ show tc+                        , "Text before:  \n" ++ show t+                        , "Cursor after: \n" ++ show tc'+                        , "Text after:   \n" ++ show t'+                        ]++isMovement :: (TextCursor -> TextCursor) -> Property+isMovement func =+    forAllValid $ \lec ->+        rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)
+ test/Cursor/Tree/TypesSpec.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Cursor.Tree.TypesSpec+    ( spec+    ) where++import Test.Hspec++import Test.Validity+import Test.Validity.Optics++import Cursor.Tree+import Cursor.Tree.Gen ()++spec :: Spec+spec = do+    eqSpec @TreeCursorSelection+    genValidSpec @TreeCursorSelection+    shrinkValidSpecWithLimit @TreeCursorSelection 100+    eqSpec @(SwapResult Int)+    genValidSpec @(SwapResult Double)+    shrinkValidSpecWithLimit @(SwapResult Int) 100+    eqSpec @(PromoteElemResult Int)+    genValidSpec @(PromoteElemResult Double)+    shrinkValidSpecWithLimit @(PromoteElemResult Int) 100+    eqSpec @(PromoteResult Int)+    genValidSpec @(PromoteResult Double)+    shrinkValidSpecWithLimit @(PromoteResult Int) 100+    eqSpec @(DemoteResult Int)+    genValidSpec @(DemoteResult Double)+    shrinkValidSpecWithLimit @(DemoteResult Int) 100+    eqSpec @(CTree Int)+    genValidSpec @(CTree Double)+    shrinkValidSpecWithLimit @(CTree Int) 100+    eqSpec @(CForest Int)+    genValidSpec @(CForest Double)+    shrinkValidSpecWithLimit @(CForest Int) 100+    eqSpec @(TreeAbove Int)+    genValidSpec @(TreeAbove Double)+    shrinkValidSpecWithLimit @(TreeAbove Int) 100+    describe "treeAboveLeftsL" $ lensSpecOnValid $ treeAboveLeftsL @Double+    describe "treeAboveAboveL" $ lensSpecOnValid $ treeAboveAboveL @Double+    describe "treeAboveNodeL" $ lensSpecOnValid $ treeAboveNodeL @Double+    describe "treeAboveRightsL" $ lensSpecOnValid $ treeAboveRightsL @Double+    eqSpec @(TreeCursor Int Word)+    genValidSpec @(TreeCursor Float Double)+    shrinkValidSpecWithLimit @(TreeCursor Word Int) 100+    describe "treeCursorAboveL" $+        lensSpecOnValid $ treeCursorAboveL @Float @Double+    describe "treeCursorCurrentL" $+        lensSpecOnValid $ treeCursorCurrentL @Float @Double+    describe "treeCursorBelowL" $+        lensSpecOnValid $ treeCursorBelowL @Float @Double+    describe "treeCursorCurrentSubTreeL" $+        lensSpecOnValid $ treeCursorCurrentSubTreeL @Float @Double
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}