{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module Data.Array.Comfort.Shape.Test (tests) where

import qualified Data.Array.Comfort.Shape as Shape
import Data.Array.Comfort.Shape.Utility (isRight)

import Control.Applicative (pure)
import Data.Tuple.HT (mapSnd)

import qualified Test.QuickCheck as QC


inBounds :: (Shape.Indexed sh) => sh -> Bool
inBounds :: forall sh. Indexed sh => sh -> Bool
inBounds sh
sh  =  forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh) forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh


forAllIndices ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix, QC.Testable prop) =>
   sh -> (ix -> prop) -> QC.Property
forAllIndices :: forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh ix -> prop
f =
   let ixs :: [Index sh]
ixs = forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh
   in Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Index sh]
ixs)  forall prop. Testable prop => Bool -> prop -> Property
QC.==>  forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll (forall a. [a] -> Gen a
QC.elements [Index sh]
ixs) ix -> prop
f

-- ToDo: we need to check for indices outside of bounds, too
inBoundsOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
inBoundsOffset :: forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsOffset sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh ix
ix forall a. Eq a => a -> a -> Bool
==
      forall a b. Either a b -> Bool
isRight (forall a. Result Checked a -> Either String a
Shape.getChecked (forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
ix))

inBoundsSizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
inBoundsSizeOffset :: forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsSizeOffset sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall sh. Indexed sh => sh -> Index sh -> Bool
Shape.inBounds sh
sh ix
ix forall a. Eq a => a -> a -> Bool
==
      forall a b. Either a b -> Bool
isRight (forall a. Result Checked a -> Either String a
Shape.getChecked (forall a b. (a, b) -> b
snd (forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh) ix
ix))

sizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
sizeOffset :: forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
sizeOffset sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> a -> b
$ix
ix) (forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.sizeOffset sh
sh)
      forall a. Eq a => a -> a -> Bool
==
      (forall sh. C sh => sh -> Int
Shape.size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
ix)

uncheckedSizeOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
uncheckedSizeOffset :: forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedSizeOffset sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> a -> b
$ix
ix) (forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.uncheckedSizeOffset sh
sh) forall a. Eq a => a -> a -> Bool
==
         (forall sh. C sh => sh -> Int
Shape.size sh
sh, forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
ix)

unifiedSizeOffsetA ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedSizeOffsetA :: forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetA CheckSingleton check
check sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall a b. (a -> b) -> a -> b
$ix
ix) (forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh) forall a. Eq a => a -> a -> Bool
==
         (forall sh. C sh => sh -> Int
Shape.size sh
sh, forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
ix)

unifiedSizeOffsetB ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedSizeOffsetB :: forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetB CheckSingleton check
check sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      (forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ix
ix)) forall a b. (a -> b) -> a -> b
$ forall sh check.
(Indexed sh, Checking check) =>
sh -> (Int, Index sh -> Result check Int)
Shape.unifiedSizeOffset sh
sh)
      forall a. Eq a => a -> a -> Bool
==
      case CheckSingleton check
check of
         CheckSingleton check
Shape.Checked ->
            forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ix
ix)) (forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.sizeOffset sh
sh)
         CheckSingleton check
Shape.Unchecked ->
            forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ix
ix)) (forall sh. Indexed sh => sh -> (Int, Index sh -> Int)
Shape.uncheckedSizeOffset sh
sh)

uncheckedOffset ::
   (Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) => sh -> QC.Property
uncheckedOffset :: forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedOffset sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
ix forall a. Eq a => a -> a -> Bool
== forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
ix

unifiedOffset ::
   (Shape.Checking check, Shape.Indexed sh, Shape.Index sh ~ ix, Show ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedOffset :: forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedOffset CheckSingleton check
check sh
sh =
   forall sh ix prop.
(Indexed sh, Index sh ~ ix, Show ix, Testable prop) =>
sh -> (ix -> prop) -> Property
forAllIndices sh
sh forall a b. (a -> b) -> a -> b
$ \ix
ix ->
      forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (forall sh check.
(Indexed sh, Checking check) =>
sh -> Index sh -> Result check Int
Shape.unifiedOffset sh
sh ix
ix) forall a. Eq a => a -> a -> Bool
==
      case CheckSingleton check
check of
         CheckSingleton check
Shape.Checked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh ix
ix
         CheckSingleton check
Shape.Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall sh. Indexed sh => sh -> Index sh -> Int
Shape.uncheckedOffset sh
sh ix
ix

lengthIndices :: (Shape.Indexed sh) => sh -> Bool
lengthIndices :: forall sh. Indexed sh => sh -> Bool
lengthIndices sh
sh  =  forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) forall a. Eq a => a -> a -> Bool
== forall sh. C sh => sh -> Int
Shape.size sh
sh

indexOffsets :: (Shape.Indexed sh) => sh -> Bool
indexOffsets :: forall sh. Indexed sh => sh -> Bool
indexOffsets sh
sh =
   forall a b. (a -> b) -> [a] -> [b]
map (forall sh. Indexed sh => sh -> Index sh -> Int
Shape.offset sh
sh) (forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) forall a. Eq a => a -> a -> Bool
== forall a. Int -> [a] -> [a]
take (forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..]

invIndices :: (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool
invIndices :: forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
invIndices sh
sh =
   forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh forall a. Eq a => a -> a -> Bool
==
   forall a b. (a -> b) -> [a] -> [b]
map (forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.indexFromOffset sh
sh) (forall a. Int -> [a] -> [a]
take (forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

uncheckedInvIndices ::
   (Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) => sh -> Bool
uncheckedInvIndices :: forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
uncheckedInvIndices sh
sh =
   forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh forall a. Eq a => a -> a -> Bool
==
   forall a b. (a -> b) -> [a] -> [b]
map (forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.uncheckedIndexFromOffset sh
sh) (forall a. Int -> [a] -> [a]
take (forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

unifiedInvIndicesA ::
   (Shape.Checking check, Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) =>
   Shape.CheckSingleton check -> sh -> Bool
unifiedInvIndicesA :: forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Bool
unifiedInvIndicesA CheckSingleton check
check sh
sh =
   forall a b. (a -> b) -> [a] -> [b]
map forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall sh. Indexed sh => sh -> [Index sh]
Shape.indices sh
sh) forall a. Eq a => a -> a -> Bool
==
   forall a b. (a -> b) -> [a] -> [b]
map (forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
Shape.unifiedIndexFromOffset sh
sh)
      (forall a. Int -> [a] -> [a]
take (forall sh. C sh => sh -> Int
Shape.size sh
sh) [Int
0..])

unifiedInvIndicesB ::
   (Shape.Checking check, Shape.InvIndexed sh, Shape.Index sh ~ ix, Eq ix) =>
   Shape.CheckSingleton check -> sh -> QC.Property
unifiedInvIndicesB :: forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Property
unifiedInvIndicesB CheckSingleton check
check sh
sh =
   let n :: Int
n = forall sh. C sh => sh -> Int
Shape.size sh
sh in Int
nforall a. Ord a => a -> a -> Bool
>Int
0 forall prop. Testable prop => Bool -> prop -> Property
QC.==>
   forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int
nforall a. Num a => a -> a -> a
-Int
1)) forall a b. (a -> b) -> a -> b
$ \Int
k ->
   forall check a.
CheckSingleton check -> Result check a -> Result check a
Shape.requireCheck CheckSingleton check
check (forall sh check.
(InvIndexed sh, Checking check) =>
sh -> Int -> Result check (Index sh)
Shape.unifiedIndexFromOffset sh
sh Int
k) forall a. Eq a => a -> a -> Bool
==
   case CheckSingleton check
check of
      CheckSingleton check
Shape.Checked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.indexFromOffset sh
sh Int
k
      CheckSingleton check
Shape.Unchecked -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall sh. InvIndexed sh => sh -> Int -> Index sh
Shape.uncheckedIndexFromOffset sh
sh Int
k


unifiedTests ::
   (Shape.Checking check,
    Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>
   Shape.CheckSingleton check -> QC.Gen sh -> [(String, QC.Property)]
unifiedTests :: forall check sh ix.
(Checking check, InvIndexed sh, Show sh, Index sh ~ ix, Eq ix,
 Show ix) =>
CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton check
check Gen sh
gen =
   (String
"unifiedSizeOffsetA", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetA CheckSingleton check
check)) forall a. a -> [a] -> [a]
:
   (String
"unifiedSizeOffsetB", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedSizeOffsetB CheckSingleton check
check)) forall a. a -> [a] -> [a]
:
   (String
"unifiedOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (forall check sh ix.
(Checking check, Indexed sh, Index sh ~ ix, Show ix) =>
CheckSingleton check -> sh -> Property
unifiedOffset CheckSingleton check
check)) forall a. a -> [a] -> [a]
:
   (String
"unifiedInvIndicesA", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Bool
unifiedInvIndicesA CheckSingleton check
check)) forall a. a -> [a] -> [a]
:
   (String
"unifiedInvIndicesB", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen (forall check sh ix.
(Checking check, InvIndexed sh, Index sh ~ ix, Eq ix) =>
CheckSingleton check -> sh -> Property
unifiedInvIndicesB CheckSingleton check
check)) forall a. a -> [a] -> [a]
:
   []

-- cf. Test.Utility
prefix :: String -> [(String, test)] -> [(String, test)]
prefix :: forall test. String -> [(String, test)] -> [(String, test)]
prefix String
msg =
   forall a b. (a -> b) -> [a] -> [b]
map (\(String
str,test
test) -> (String
msg forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ String
str, test
test))

tests ::
   (Shape.InvIndexed sh, Show sh, Shape.Index sh ~ ix, Eq ix, Show ix) =>
   QC.Gen sh -> [(String, QC.Property)]
tests :: forall sh ix.
(InvIndexed sh, Show sh, Index sh ~ ix, Eq ix, Show ix) =>
Gen sh -> [(String, Property)]
tests Gen sh
gen =
   (String
"inBounds", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh. Indexed sh => sh -> Bool
inBounds) forall a. a -> [a] -> [a]
:
   (String
"inBoundsOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsOffset) forall a. a -> [a] -> [a]
:
   (String
"inBoundsSizeOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
inBoundsSizeOffset) forall a. a -> [a] -> [a]
:
   (String
"sizeOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
sizeOffset) forall a. a -> [a] -> [a]
:
   (String
"uncheckedSizeOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedSizeOffset) forall a. a -> [a] -> [a]
:
   (String
"uncheckedOffset", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix.
(Indexed sh, Index sh ~ ix, Show ix) =>
sh -> Property
uncheckedOffset) forall a. a -> [a] -> [a]
:
   (String
"lengthIndices", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh. Indexed sh => sh -> Bool
lengthIndices) forall a. a -> [a] -> [a]
:
   (String
"indexOffsets", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh. Indexed sh => sh -> Bool
indexOffsets) forall a. a -> [a] -> [a]
:
   (String
"invIndices", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
invIndices) forall a. a -> [a] -> [a]
:
   (String
"uncheckedInvIndices", forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
QC.forAll Gen sh
gen forall sh ix. (InvIndexed sh, Index sh ~ ix, Eq ix) => sh -> Bool
uncheckedInvIndices) forall a. a -> [a] -> [a]
:
   forall test. String -> [(String, test)] -> [(String, test)]
prefix String
"Checked" (forall check sh ix.
(Checking check, InvIndexed sh, Show sh, Index sh ~ ix, Eq ix,
 Show ix) =>
CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton Checked
Shape.Checked Gen sh
gen) forall a. [a] -> [a] -> [a]
++
   forall test. String -> [(String, test)] -> [(String, test)]
prefix String
"Unchecked" (forall check sh ix.
(Checking check, InvIndexed sh, Show sh, Index sh ~ ix, Eq ix,
 Show ix) =>
CheckSingleton check -> Gen sh -> [(String, Property)]
unifiedTests CheckSingleton Unchecked
Shape.Unchecked Gen sh
gen) forall a. [a] -> [a] -> [a]
++
   []