Как ограничить QuickCheck при использовании синонимов типов?

Простое решение состоит в том, чтобы не иметь произвольного экземпляра, а вместо этого сделать что-то вроде

import Test.QuickCheck
import Control.Monad

prop_vec :: Int -> Gen [Double]
prop_vec = flip replicateM arbitrary . abs


prop_addComm :: Int -> Gen Bool
prop_addComm i  = do
  v <- prop_vec i
  u <- prop_vec i
  return $ u + v = v + u --assuming you'd added a Num instance for your vectors

Там никогда не бывает типового класса, поэтому вы получаете меньше полезных ошибок, но их проще накрутить.

Вы можете установить ограничения с помощью нотации ==>.

пример:

prop_test xs = minimum xs == (head $ sort xs)

который терпит неудачу:

*** Failed! Exception: 'Prelude.minimum: empty list' (after 1 test):
[]

теперь с ограничением:

prop_test xs = not (null xs) ==> minimum xs == (head $ sort xs)

оно работает:

*Main> quickCheck prop_test
+++ OK, passed 100 tests.

в твоем случае:

prop_test xs ys = length xs == length ys ==> undefined -- whatever you want

Другое очевидное решение — создать список кортежей и разархивировать их. Например, в ghci:

> let allSameLength (xs:xss) = all (==length xs) (map length xss)
> quickCheck (\xys -> let (xs, ys) = unzip xys in allSameLength [xs, ys])
+++ OK, passed 100 tests.
> :{
| quickCheck (\wxyzs -> let
|   (wxs, yzs) = unzip wxyzs
|   (ws, xs) = unzip wxs
|   (ys, zs) = unzip yzs
|   in allSameLength [ws, xs, ys, zs])
| :}
+++ OK, passed 100 tests.

Вот одна из возможностей. Мы определим новый класс для типов, которые могут создавать случайные значения, зависящие от размера. Затем вы можете создать список или дерево на уровне типов или что-то еще и объявить один экземпляр Arbitrary для них раз и навсегда.

import Control.Monad
import Test.QuickCheck

class SizedArbitrary a where
    sizedArbitrary :: Int -> Gen a

instance Arbitrary a => SizedArbitrary [a] where
    sizedArbitrary n = replicateM n arbitrary

data Branch a b = a :+ b deriving (Eq, Ord, Show, Read)
instance (SizedArbitrary a, SizedArbitrary b) => SizedArbitrary (Branch a b) where
    sizedArbitrary n = liftM2 (:+) (sizedArbitrary n) (sizedArbitrary n)

instance (SizedArbitrary a, SizedArbitrary b) => Arbitrary (Branch a b) where
    arbitrary = arbitrarySizedIntegral >>= sizedArbitrary . abs

Затем мы можем загрузить его в ghci и проверить, работает ли он:

*Main> let allSameLength (xs:xss) = all (==length xs) (map length xss)
*Main> quickCheck (\(xs :+ ys) -> allSameLength [xs, ys])
+++ OK, passed 100 tests.
*Main> quickCheck (\(ws :+ xs :+ ys :+ zs) -> allSameLength [ws, xs, ys, zs])
+++ OK, passed 100 tests.