{-# 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