Идиоматический способ сокращения записи в QuickCheck
Предположим, у меня есть тип записи:
data Foo = Foo {x, y, z :: Integer}
В аккуратном способе записи произвольного экземпляра используется Control.Applicative следующим образом:
instance Arbitrary Foo where
arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary
shrink f = Foo <$> shrink (x f) <*> shrink (y f) <*> shrink (z f)
Список сокращений для Foo, таким образом, является декартовым произведением всех сокращений его членов.
Но если одна из этих сокращений вернется [], то для Foo в целом не будет никаких сокращений. Так что это не работает.
Я мог бы попытаться сохранить его, включив исходное значение в список сокращений:
shrink f = Foo <$> ((x f) : shrink (x f)) <*> ... {and so on}.
Но теперь shrink (Foo 0 0 0) вернет [Foo 0 0 0], что означает, что сжатие никогда не прекратится. Так что это тоже не работает.
Похоже, что здесь должно быть что-то другое, кроме < * > , но я не вижу, что.
Ответы
Ответ 1
Я не знаю, что будет считаться идиоматическим, но если вы хотите, чтобы каждое сокращение уменьшало хотя бы одно поле без увеличения других,
shrink f = tail $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f)
where
shrink' a = a : shrink a
сделал бы это. Экземпляр Applicative для списков таков, что исходное значение является первым в списке результатов, поэтому просто отбрасывание, которое получает список значений, действительно сокращается, следовательно, сокращение заканчивается.
Если вы хотите, чтобы все поля сокращались, если это возможно, и только нераспределяемые поля, которые нужно сохранить как есть, это немного сложнее, вам нужно сообщить, успешно ли вы получили успешную усадку или нет, и в случае, t получил в конце, верните пустой список. То, что упало с моей головы,
data Fallback a
= Fallback a
| Many [a]
unFall :: Fallback a -> [a]
unFall (Fallback _) = []
unFall (Many xs) = xs
fall :: a -> [a] -> Fallback a
fall u [] = Fallback u
fall _ xs = Many xs
instance Functor Fallback where
fmap f (Fallback u) = Fallback (f u)
fmap f (Many xs) = Many (map f xs)
instance Applicative Fallback where
pure u = Many [u]
(Fallback f) <*> (Fallback u) = Fallback (f u)
(Fallback f) <*> (Many xs) = Many (map f xs)
(Many fs) <*> (Fallback u) = Many (map ($ u) fs)
(Many fs) <*> (Many xs) = Many (fs <*> xs)
instance Arbitrary Foo where
arbitrary = Foo <$> arbitrary <*> arbitrary <*> arbitrary
shrink f = unFall $ Foo <$> shrink' (x f) <*> shrink' (y f) <*> shrink' (z f)
where
shrink' a = fall a $ shrink a
может быть, кто-то придумает более хороший способ сделать это.
Ответ 2
Если вам нужен аппликативный функтор, который будет сжиматься ровно в одной позиции, вам может понравиться тот, который я только что создал, чтобы поцарапать именно этот зуд:
data ShrinkOne a = ShrinkOne a [a]
instance Functor ShrinkOne where
fmap f (ShrinkOne o s) = ShrinkOne (f o) (map f s)
instance Applicative ShrinkOne where
pure x = ShrinkOne x []
ShrinkOne f fs <*> ShrinkOne x xs = ShrinkOne (f x) (map ($x) fs ++ map f xs)
shrinkOne :: Arbitrary a => a -> ShrinkOne a
shrinkOne x = ShrinkOne x (shrink x)
unShrinkOne :: ShrinkOne t -> [t]
unShrinkOne (ShrinkOne _ xs) = xs
Я использую его в коде, который выглядит так, чтобы сжиматься либо в левом элементе кортежа, либо в одном из полей правого элемента кортежа:
shrink (tss,m) = unShrinkOne $
((,) <$> shrinkOne tss <*> traverse shrinkOne m)
Прекрасно работает!
На самом деле, он работает так хорошо, что я загрузил его как пакет hackage.
