{-# 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 :: forall a. Gen a -> Gen (Array i a)
liftArbitrary = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray forall a. Arbitrary a => Gen a
arbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary
    liftShrink :: forall a. (a -> [a]) -> Array i a -> [Array i a]
liftShrink = 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 = forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
    shrink :: Array i a -> [Array i a]
shrink = 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 :: forall b. Array i a -> Gen b -> Gen b
coarbitrary Array i a
arr = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds Array i a
arr, 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 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray forall a. Arbitrary a => Gen a
arbitrary forall a. Arbitrary a => Gen a
arbitrary
    shrink :: UArray i a -> [UArray i a]
shrink = forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a, Arbitrary i) =>
(a -> [a]) -> arr i a -> [arr i a]
shrinkArray 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 :: forall b. UArray i a -> Gen b -> Gen b
coarbitrary UArray i a
arr = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
Array.bounds UArray i a
arr, 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 :: forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a, Arbitrary i) =>
(a -> [a]) -> arr i a -> [arr i a]
shrinkArray a -> [a]
shr arr i a
arr =
  [ forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray i
lo [a]
xs | [a]
xs <- forall (f :: * -> *) a. Arbitrary1 f => (a -> [a]) -> f a -> [f a]
liftShrink a -> [a]
shr (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems arr i a
arr) ] forall a. [a] -> [a] -> [a]
++
  [ forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray i
lo' (forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
Array.elems arr i a
arr) | i
lo' <- forall a. Arbitrary a => a -> [a]
shrink i
lo ]
  where
    (i
lo, 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 :: forall i (arr :: * -> * -> *) a.
(Num i, Ix i, IArray arr a) =>
i -> [a] -> arr i a
makeArray i
lo [a]
xs = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
Array.listArray (i
lo, i
lo forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs forall a. Num a => a -> a -> a
- Int
1)) [a]
xs