{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Cursor.Tree.Gen ( ) where import Cursor.Tree import Data.GenValidity import Data.GenValidity.Containers () import qualified Data.List.NonEmpty as NE import Test.QuickCheck instance GenValid TreeCursorSelection where genValid :: Gen TreeCursorSelection genValid = Gen TreeCursorSelection forall a. (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking shrinkValid :: TreeCursorSelection -> [TreeCursorSelection] shrinkValid = TreeCursorSelection -> [TreeCursorSelection] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid a => GenValid (SwapResult a) where genValid :: Gen (SwapResult a) genValid = Gen (SwapResult a) forall a. (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking shrinkValid :: SwapResult a -> [SwapResult a] shrinkValid = SwapResult a -> [SwapResult a] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid a => GenValid (PromoteElemResult a) where genValid :: Gen (PromoteElemResult a) genValid = Gen (PromoteElemResult a) forall a. (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking shrinkValid :: PromoteElemResult a -> [PromoteElemResult a] shrinkValid = PromoteElemResult a -> [PromoteElemResult a] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid a => GenValid (PromoteResult a) where genValid :: Gen (PromoteResult a) genValid = Gen (PromoteResult a) forall a. (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking shrinkValid :: PromoteResult a -> [PromoteResult a] shrinkValid = PromoteResult a -> [PromoteResult a] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid a => GenValid (DemoteResult a) where genValid :: Gen (DemoteResult a) genValid = Gen (DemoteResult a) forall a. (Generic a, GGenValid (Rep a)) => Gen a genValidStructurallyWithoutExtraChecking shrinkValid :: DemoteResult a -> [DemoteResult a] shrinkValid = DemoteResult a -> [DemoteResult a] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid a => GenValid (CTree a) where genValid :: Gen (CTree a) genValid = (Int -> Gen (CTree a)) -> Gen (CTree a) forall a. (Int -> Gen a) -> Gen a sized ((Int -> Gen (CTree a)) -> Gen (CTree a)) -> (Int -> Gen (CTree a)) -> Gen (CTree a) forall a b. (a -> b) -> a -> b $ \Int n -> do (Int a, Int b) <- Int -> Gen (Int, Int) genSplit Int n a val <- Int -> Gen a -> Gen a forall a. Int -> Gen a -> Gen a resize Int a Gen a forall a. GenValid a => Gen a genValid CForest a for <- Int -> Gen (CForest a) -> Gen (CForest a) forall a. Int -> Gen a -> Gen a resize Int b Gen (CForest a) forall a. GenValid a => Gen a genValid CTree a -> Gen (CTree a) forall (f :: * -> *) a. Applicative f => a -> f a pure (CTree a -> Gen (CTree a)) -> CTree a -> Gen (CTree a) forall a b. (a -> b) -> a -> b $ a -> CForest a -> CTree a forall a. a -> CForest a -> CTree a CNode a val CForest a for shrinkValid :: CTree a -> [CTree a] shrinkValid (CNode a a CForest a cf) = [a -> CForest a -> CTree a forall a. a -> CForest a -> CTree a CNode a a' CForest a cf' | (a a', CForest a cf') <- (a, CForest a) -> [(a, CForest a)] forall a. GenValid a => a -> [a] shrinkValid (a a, CForest a cf)] instance GenValid a => GenValid (CForest a) where genValid :: Gen (CForest a) genValid = (Int -> Gen (CForest a)) -> Gen (CForest a) forall a. (Int -> Gen a) -> Gen a sized ((Int -> Gen (CForest a)) -> Gen (CForest a)) -> (Int -> Gen (CForest a)) -> Gen (CForest a) forall a b. (a -> b) -> a -> b $ \case Int 0 -> CForest a -> Gen (CForest a) forall (f :: * -> *) a. Applicative f => a -> f a pure CForest a forall a. CForest a EmptyCForest Int _ -> [Gen (CForest a)] -> Gen (CForest a) forall a. [Gen a] -> Gen a oneof [NonEmpty (Tree a) -> CForest a forall a. NonEmpty (Tree a) -> CForest a ClosedForest (NonEmpty (Tree a) -> CForest a) -> Gen (NonEmpty (Tree a)) -> Gen (CForest a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen (NonEmpty (Tree a)) forall a. GenValid a => Gen a genValid, NonEmpty (CTree a) -> CForest a forall a. NonEmpty (CTree a) -> CForest a OpenForest (NonEmpty (CTree a) -> CForest a) -> Gen (NonEmpty (CTree a)) -> Gen (CForest a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Gen (NonEmpty (CTree a)) forall a. GenValid a => Gen a genValid] shrinkValid :: CForest a -> [CForest a] shrinkValid CForest a EmptyCForest = [] shrinkValid (ClosedForest NonEmpty (Tree a) ne) = CForest a forall a. CForest a EmptyCForest CForest a -> [CForest a] -> [CForest a] forall a. a -> [a] -> [a] : (NonEmpty (Tree a) -> CForest a forall a. NonEmpty (Tree a) -> CForest a ClosedForest (NonEmpty (Tree a) -> CForest a) -> [NonEmpty (Tree a)] -> [CForest a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty (Tree a) -> [NonEmpty (Tree a)] forall a. GenValid a => a -> [a] shrinkValid NonEmpty (Tree a) ne) shrinkValid (OpenForest NonEmpty (CTree a) ne) = CForest a forall a. CForest a EmptyCForest CForest a -> [CForest a] -> [CForest a] forall a. a -> [a] -> [a] : NonEmpty (Tree a) -> CForest a forall a. NonEmpty (Tree a) -> CForest a ClosedForest ((CTree a -> Tree a) -> NonEmpty (CTree a) -> NonEmpty (Tree a) forall a b. (a -> b) -> NonEmpty a -> NonEmpty b NE.map CTree a -> Tree a forall a. CTree a -> Tree a rebuildCTree NonEmpty (CTree a) ne) CForest a -> [CForest a] -> [CForest a] forall a. a -> [a] -> [a] : (NonEmpty (CTree a) -> CForest a forall a. NonEmpty (CTree a) -> CForest a OpenForest (NonEmpty (CTree a) -> CForest a) -> [NonEmpty (CTree a)] -> [CForest a] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> NonEmpty (CTree a) -> [NonEmpty (CTree a)] forall a. GenValid a => a -> [a] shrinkValid NonEmpty (CTree a) ne) instance (GenValid a, GenValid b) => GenValid (TreeCursor a b) where genValid :: Gen (TreeCursor a b) genValid = (Int -> Gen (TreeCursor a b)) -> Gen (TreeCursor a b) forall a. (Int -> Gen a) -> Gen a sized ((Int -> Gen (TreeCursor a b)) -> Gen (TreeCursor a b)) -> (Int -> Gen (TreeCursor a b)) -> Gen (TreeCursor a b) forall a b. (a -> b) -> a -> b $ \Int n -> do Int s <- Int -> Gen Int upTo Int n (Int a, Int b, Int c, Int d) <- Int -> Gen (Int, Int, Int, Int) genSplit4 Int s Maybe (TreeAbove b) treeAbove <- Int -> Gen (Maybe (TreeAbove b)) -> Gen (Maybe (TreeAbove b)) forall a. Int -> Gen a -> Gen a resize (Int a Int -> Int -> Int forall a. Num a => a -> a -> a + Int b) Gen (Maybe (TreeAbove b)) forall a. GenValid a => Gen a genValid a treeCurrent <- Int -> Gen a -> Gen a forall a. Int -> Gen a -> Gen a resize Int c Gen a forall a. GenValid a => Gen a genValid CForest b treeBelow <- Int -> Gen (CForest b) -> Gen (CForest b) forall a. Int -> Gen a -> Gen a resize Int d Gen (CForest b) forall a. GenValid a => Gen a genValid TreeCursor a b -> Gen (TreeCursor a b) forall (f :: * -> *) a. Applicative f => a -> f a pure TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b TreeCursor {a Maybe (TreeAbove b) CForest b treeAbove :: Maybe (TreeAbove b) treeCurrent :: a treeBelow :: CForest b treeBelow :: CForest b treeCurrent :: a treeAbove :: Maybe (TreeAbove b) ..} shrinkValid :: TreeCursor a b -> [TreeCursor a b] shrinkValid = TreeCursor a b -> [TreeCursor a b] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering instance GenValid b => GenValid (TreeAbove b) where genValid :: Gen (TreeAbove b) genValid = (Int -> Gen (TreeAbove b)) -> Gen (TreeAbove b) forall a. (Int -> Gen a) -> Gen a sized ((Int -> Gen (TreeAbove b)) -> Gen (TreeAbove b)) -> (Int -> Gen (TreeAbove b)) -> Gen (TreeAbove b) forall a b. (a -> b) -> a -> b $ \Int n -> do Int s <- Int -> Gen Int upTo Int n (Int a, Int b, Int c, Int d) <- Int -> Gen (Int, Int, Int, Int) genSplit4 Int s [CTree b] treeAboveLefts <- Int -> Gen [CTree b] -> Gen [CTree b] forall a. Int -> Gen a -> Gen a resize Int a Gen [CTree b] forall a. GenValid a => Gen a genValid Maybe (TreeAbove b) treeAboveAbove <- Int -> Gen (Maybe (TreeAbove b)) -> Gen (Maybe (TreeAbove b)) forall a. Int -> Gen a -> Gen a resize Int b Gen (Maybe (TreeAbove b)) forall a. GenValid a => Gen a genValid b treeAboveNode <- Int -> Gen b -> Gen b forall a. Int -> Gen a -> Gen a resize Int c Gen b forall a. GenValid a => Gen a genValid [CTree b] treeAboveRights <- Int -> Gen [CTree b] -> Gen [CTree b] forall a. Int -> Gen a -> Gen a resize Int d Gen [CTree b] forall a. GenValid a => Gen a genValid TreeAbove b -> Gen (TreeAbove b) forall (f :: * -> *) a. Applicative f => a -> f a pure TreeAbove :: forall b. [CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b TreeAbove {b [CTree b] Maybe (TreeAbove b) treeAboveLefts :: [CTree b] treeAboveAbove :: Maybe (TreeAbove b) treeAboveNode :: b treeAboveRights :: [CTree b] treeAboveRights :: [CTree b] treeAboveNode :: b treeAboveAbove :: Maybe (TreeAbove b) treeAboveLefts :: [CTree b] ..} shrinkValid :: TreeAbove b -> [TreeAbove b] shrinkValid = TreeAbove b -> [TreeAbove b] forall a. (Generic a, GValidRecursivelyShrink (Rep a), GValidSubterms (Rep a) a) => a -> [a] shrinkValidStructurallyWithoutExtraFiltering