Arbitrary for Fix with generic-random and recursion-schemes

ArbitraryFix.hs

{-# LANGUAGE
    DeriveGeneric,
    FlexibleContexts,
    FlexibleInstances,
    TypeFamilies,
    RankNTypes #-}

import GHC.Generics
import Generic.Random
import Generic.Data (gliftShowsPrec)
import Data.Functor.Foldable
import Test.QuickCheck
import Data.Functor.Classes

arbitraryFix ::
  (x ~ Fix f, GArbitrary SizedOptsDef (f x)) =>
  Weights (f x) ->  -- Distribution of constructors
  Gen (f x) ->      -- Base case when size reaches 0
  Gen (Fix f)
arbitraryFix w baseCase = Fix <$> (genericArbitraryRec w `withBaseCase` baseCase)

-- Example

data Foo a = Bar | Baz a deriving (Show, Generic, Generic1)

instance Arbitrary (Fix Foo) where
  arbitrary = arbitraryFix
    (1 % 3 % ())  -- Distribution: 1/4 Bar, 3/4 Baz
    (pure Bar)    -- Generate Bar at size 0

instance Show1 Foo where
  liftShowsPrec = gliftShowsPrec

main :: IO ()
main = sample (arbitrary :: Gen (Fix Foo))