{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cursor.List.NonEmpty.Gen
  ( genNonEmptyCursorBy,
    nonEmptyElemOf,
    nonEmptyWithIndex0,
    nonEmptyWith,
  )
where

import Control.Monad
import Cursor.List.NonEmpty
import Data.GenValidity
import qualified Data.List.NonEmpty as NE
import Test.QuickCheck

instance (GenValid a, GenValid b) => GenValid (NonEmptyCursor a b) where
  genValid :: Gen (NonEmptyCursor a b)
genValid = Gen a -> Gen b -> Gen (NonEmptyCursor a b)
forall a b. Gen a -> Gen b -> Gen (NonEmptyCursor a b)
genNonEmptyCursorBy Gen a
forall a. GenValid a => Gen a
genValid Gen b
forall a. GenValid a => Gen a
genValid
  shrinkValid :: NonEmptyCursor a b -> [NonEmptyCursor a b]
shrinkValid (NonEmptyCursor [b]
prev a
cur [b]
next) =
    [[b] -> a -> [b] -> NonEmptyCursor a b
forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor [b]
prev' a
cur' [b]
next' | ([b]
prev', a
cur', [b]
next') <- ([b], a, [b]) -> [([b], a, [b])]
forall a. GenValid a => a -> [a]
shrinkValid ([b]
prev, a
cur, [b]
next)]

genNonEmptyCursorBy :: Gen a -> Gen b -> Gen (NonEmptyCursor a b)
genNonEmptyCursorBy :: Gen a -> Gen b -> Gen (NonEmptyCursor a b)
genNonEmptyCursorBy Gen a
genA Gen b
genB =
  (Int -> Gen (NonEmptyCursor a b)) -> Gen (NonEmptyCursor a b)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (NonEmptyCursor a b)) -> Gen (NonEmptyCursor a b))
-> (Int -> Gen (NonEmptyCursor a b)) -> Gen (NonEmptyCursor a b)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
    [Int]
part <- Int -> Gen [Int]
arbPartition Int
n
    case [Int]
part of
      [] -> a -> NonEmptyCursor a b
forall a b. a -> NonEmptyCursor a b
singletonNonEmptyCursor (a -> NonEmptyCursor a b) -> Gen a -> Gen (NonEmptyCursor a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
0 Gen a
genA
      (Int
s : [Int]
ss) -> do
        Int
i <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ss)
        let ([Int]
as, [Int]
bs) = Int -> [Int] -> ([Int], [Int])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i [Int]
ss
        [b]
nonEmptyCursorPrev <- [Int] -> (Int -> Gen b) -> Gen [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
as ((Int -> Gen b) -> Gen [b]) -> (Int -> Gen b) -> Gen [b]
forall a b. (a -> b) -> a -> b
$ \Int
s_ -> Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s_ Gen b
genB
        a
nonEmptyCursorCurrent <- Int -> Gen a -> Gen a
forall a. Int -> Gen a -> Gen a
resize Int
s Gen a
genA
        [b]
nonEmptyCursorNext <- [Int] -> (Int -> Gen b) -> Gen [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int]
bs ((Int -> Gen b) -> Gen [b]) -> (Int -> Gen b) -> Gen [b]
forall a b. (a -> b) -> a -> b
$ \Int
s_ -> Int -> Gen b -> Gen b
forall a. Int -> Gen a -> Gen a
resize Int
s_ Gen b
genB
        NonEmptyCursor a b -> Gen (NonEmptyCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmptyCursor :: forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor {a
[b]
nonEmptyCursorPrev :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorNext :: [b]
nonEmptyCursorNext :: [b]
nonEmptyCursorCurrent :: a
nonEmptyCursorPrev :: [b]
..}

nonEmptyElemOf :: NonEmptyCursor a a -> Gen a
nonEmptyElemOf :: NonEmptyCursor a a -> Gen a
nonEmptyElemOf = [a] -> Gen a
forall a. [a] -> Gen a
elements ([a] -> Gen a)
-> (NonEmptyCursor a a -> [a]) -> NonEmptyCursor a a -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty a -> [a])
-> (NonEmptyCursor a a -> NonEmpty a) -> NonEmptyCursor a a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> NonEmptyCursor a a -> NonEmpty a
forall a b. (a -> b) -> NonEmptyCursor a b -> NonEmpty b
rebuildNonEmptyCursor a -> a
forall a. a -> a
id

nonEmptyWithIndex0 :: Gen a -> Gen (NonEmptyCursor a a)
nonEmptyWithIndex0 :: Gen a -> Gen (NonEmptyCursor a a)
nonEmptyWithIndex0 Gen a
g = [a] -> a -> [a] -> NonEmptyCursor a a
forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor [] (a -> [a] -> NonEmptyCursor a a)
-> Gen a -> Gen ([a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
g Gen ([a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g

nonEmptyWith :: a -> Gen a -> Gen (NonEmptyCursor a a)
nonEmptyWith :: a -> Gen a -> Gen (NonEmptyCursor a a)
nonEmptyWith a
a Gen a
g =
  [Gen (NonEmptyCursor a a)] -> Gen (NonEmptyCursor a a)
forall a. [Gen a] -> Gen a
oneof
    [ [a] -> a -> [a] -> NonEmptyCursor a a
forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor ([a] -> a -> [a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (a -> [a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
listWithA Gen (a -> [a] -> NonEmptyCursor a a)
-> Gen a -> Gen ([a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
g Gen ([a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g,
      [a] -> a -> [a] -> NonEmptyCursor a a
forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor ([a] -> a -> [a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (a -> [a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g Gen (a -> [a] -> NonEmptyCursor a a)
-> Gen a -> Gen ([a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a Gen ([a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g,
      [a] -> a -> [a] -> NonEmptyCursor a a
forall a b. [b] -> a -> [b] -> NonEmptyCursor a b
NonEmptyCursor ([a] -> a -> [a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (a -> [a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g Gen (a -> [a] -> NonEmptyCursor a a)
-> Gen a -> Gen ([a] -> NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen a
g Gen ([a] -> NonEmptyCursor a a)
-> Gen [a] -> Gen (NonEmptyCursor a a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [a]
listWithA
    ]
  where
    listWithA :: Gen [a]
listWithA = do
      [a]
l1 <- Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g
      [a]
l2 <- Gen a -> Gen [a]
forall a. Gen a -> Gen [a]
genListOf Gen a
g
      [a] -> Gen [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Gen [a]) -> [a] -> Gen [a]
forall a b. (a -> b) -> a -> b
$ [a]
l1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
a] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l2