module Data.Comp.Arbitrary
( ArbitraryF(..)
)where
import Control.Applicative
import Data.Comp.Derive
import Data.Comp.Derive.Utils
import Data.Comp.Ops
import Data.Comp.Term
import Test.QuickCheck
instance (ArbitraryF f) => Arbitrary (Term f) where
arbitrary = Term <$> arbitraryF
shrink (Term expr) = map Term $ shrinkF expr
instance (ArbitraryF f, Arbitrary p) => ArbitraryF (f :&: p) where
arbitraryF' = map addP arbitraryF'
where addP (i,gen) = (i,(:&:) <$> gen <*> arbitrary)
arbitraryF = (:&:) <$> arbitraryF <*> arbitrary
shrinkF (v :&: p) = tail [v' :&: p'| v' <- v: shrinkF v, p' <- p : shrink p ]
instance (ArbitraryF f) => ArbitraryF (Context f) where
arbitraryF = oneof [Term <$> arbitraryF , Hole <$> arbitrary]
shrinkF (Term expr) = map Term $ shrinkF expr
shrinkF (Hole a) = map Hole $ shrink a
instance (ArbitraryF f, Arbitrary a) => Arbitrary (Context f a) where
arbitrary = arbitraryF
shrink = shrinkF
instance (ArbitraryF f , ArbitraryF g) => ArbitraryF (f :+: g) where
arbitraryF' = map inl arbitraryF' ++ map inr arbitraryF'
where inl (i,gen) = (i,Inl <$> gen)
inr (i,gen) = (i,Inr <$> gen)
shrinkF (Inl val) = map Inl (shrinkF val)
shrinkF (Inr val) = map Inr (shrinkF val)
$(derive [makeArbitraryF] $ [''Maybe,''[]] ++ tupleTypes 2 10)