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

module Cursor.List.Gen
  ( listCursorWithGen,
    listCursorWithIndex0,
  )
where

import Cursor.List
import Data.GenValidity
import Test.QuickCheck

instance GenValid a => GenValid (ListCursor a) where
  genValid :: Gen (ListCursor a)
genValid =
    (Int -> Gen (ListCursor a)) -> Gen (ListCursor a)
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen (ListCursor a)) -> Gen (ListCursor a))
-> (Int -> Gen (ListCursor a)) -> Gen (ListCursor a)
forall a b. (a -> b) -> a -> b
$ \Int
n -> do
      (Int
a, Int
b) <- Int -> Gen (Int, Int)
genSplit Int
n
      [a]
listCursorPrev <- Int -> Gen [a] -> Gen [a]
forall a. Int -> Gen a -> Gen a
resize Int
a Gen [a]
forall a. GenValid a => Gen a
genValid
      [a]
listCursorNext <- Int -> Gen [a] -> Gen [a]
forall a. Int -> Gen a -> Gen a
resize Int
b Gen [a]
forall a. GenValid a => Gen a
genValid
      ListCursor a -> Gen (ListCursor a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListCursor :: forall a. [a] -> [a] -> ListCursor a
ListCursor {[a]
listCursorPrev :: [a]
listCursorNext :: [a]
listCursorNext :: [a]
listCursorPrev :: [a]
..}
  shrinkValid :: ListCursor a -> [ListCursor a]
shrinkValid (ListCursor [a]
prev [a]
next) =
    [[a] -> [a] -> ListCursor a
forall a. [a] -> [a] -> ListCursor a
ListCursor [a]
prev' [a]
next' | ([a]
prev', [a]
next') <- ([a], [a]) -> [([a], [a])]
forall a. GenValid a => a -> [a]
shrinkValid ([a]
prev, [a]
next)]

listCursorWithGen :: Gen a -> Gen (ListCursor a)
listCursorWithGen :: Gen a -> Gen (ListCursor a)
listCursorWithGen Gen a
gen = [a] -> [a] -> ListCursor a
forall a. [a] -> [a] -> ListCursor a
ListCursor ([a] -> [a] -> ListCursor a)
-> Gen [a] -> Gen ([a] -> ListCursor 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
gen Gen ([a] -> ListCursor a) -> Gen [a] -> Gen (ListCursor 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
gen

listCursorWithIndex0 :: Gen a -> Gen (ListCursor a)
listCursorWithIndex0 :: Gen a -> Gen (ListCursor a)
listCursorWithIndex0 Gen a
gen = [a] -> [a] -> ListCursor a
forall a. [a] -> [a] -> ListCursor a
ListCursor [] ([a] -> ListCursor a) -> Gen [a] -> Gen (ListCursor 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
gen