{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.QuickCheck.Instances.Array () where

import Prelude ()
import Test.QuickCheck.Instances.CustomPrelude

import Control.Applicative (liftA2)
import Data.Ix             (Ix (..))

import Test.QuickCheck

import qualified Data.Array.IArray  as Array
import qualified Data.Array.Unboxed as Array

-------------------------------------------------------------------------------
-- array
-------------------------------------------------------------------------------

instance (Num i, Ix i, Arbitrary i) => Arbitrary1 (Array.Array i) where
    liftArbitrary :: Gen a -> Gen (Array i a)
liftArbitrary = (i -> [a] -> Array i a) -> Gen i -> Gen [a] -> Gen (Array i a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 i -> [a] -> Array i a
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray Gen i
forall a. Arbitrary a => Gen a
arbitrary (Gen [a] -> Gen (Array i a))
-> (Gen a -> Gen [a]) -> Gen a -> Gen (Array i a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen a -> Gen [a]
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary
    liftShrink :: (a -> [a]) -> Array i a -> [Array i a]
liftShrink = (a -> [a]) -> Array i a -> [Array i a]
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a, Arbitrary i) =>
(a -> [a]) -> arr i a -> [arr i a]
shrinkArray

instance (Num i, Ix i, Arbitrary i, Arbitrary a) => Arbitrary (Array.Array i a) where
    arbitrary :: Gen (Array i a)
arbitrary = Gen (Array i a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
    shrink :: Array i a -> [Array i a]
shrink = Array i a -> [Array i a]
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => f a -> [f a]
shrink1

instance (Ix i, CoArbitrary i, CoArbitrary a) => CoArbitrary (Array.Array i a) where
    coarbitrary :: Array i a -> Gen b -> Gen b
coarbitrary Array i a
arr = ((i, i), [a]) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Array i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds Array i a
arr, Array i a -> [a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems Array i a
arr)


instance (Num i, Ix i, Array.IArray Array.UArray a, Arbitrary i, Arbitrary a) => Arbitrary (Array.UArray i a) where
    arbitrary :: Gen (UArray i a)
arbitrary = (i -> [a] -> UArray i a) -> Gen i -> Gen [a] -> Gen (UArray i a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 i -> [a] -> UArray i a
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray Gen i
forall a. Arbitrary a => Gen a
arbitrary Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: UArray i a -> [UArray i a]
shrink = (a -> [a]) -> UArray i a -> [UArray i a]
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a, Arbitrary i) =>
(a -> [a]) -> arr i a -> [arr i a]
shrinkArray a -> [a]
forall a. Arbitrary a => a -> [a]
shrink

instance (Ix i, Array.IArray Array.UArray a, CoArbitrary i, CoArbitrary a) => CoArbitrary (Array.UArray i a) where
    coarbitrary :: UArray i a -> Gen b -> Gen b
coarbitrary UArray i a
arr = ((i, i), [a]) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (UArray i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds UArray i a
arr, UArray i a -> [a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems UArray i a
arr)


shrinkArray
    :: (Num i, Ix i, Array.IArray arr a, Arbitrary i)
    => (a -> [a]) -> arr i a -> [arr i a]
shrinkArray :: (a -> [a]) -> arr i a -> [arr i a]
shrinkArray a -> [a]
shr arr i a
arr =
  [ i -> [a] -> arr i a
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray i
lo [a]
xs | [a]
xs <- (a -> [a]) -> [a] -> [[a]]
forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr (arr i a -> [a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems arr i a
arr) ] [arr i a] -> [arr i a] -> [arr i a]
forall a. [a] -> [a] -> [a]
++
  [ i -> [a] -> arr i a
forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray i
lo' (arr i a -> [a]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems arr i a
arr) | i
lo' <- i -> [i]
forall a. Arbitrary a => a -> [a]
shrink i
lo ]
  where
    (i
lo, i
_) = arr i a -> (i, i)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds arr i a
arr

makeArray :: (Num i, Ix i, Array.IArray arr a) => i -> [a] -> arr i a
makeArray :: i -> [a] -> arr i a
makeArray i
lo [a]
xs = (i, i) -> [a] -> arr i a
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Array.listArray (i
lo, i
lo i -> i -> i
forall a. Num a => a -> a -> a
+ Int -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) [a]
xs