{-# OPTIONS_GHC -fth -fno-warn-missing-methods -cpp #-}

-- | Derivation for 'Test.QuickCheck.Arbitrary' (version 2 of quickcheck.)
--
-- * The resulting instances of @arbitrary@ generate each constructor
-- of the data type with equal probability.
--
-- * No form of size control is used.
module Data.Derive.Arbitrary2(makeArbitrary2) where

import Language.Haskell.TH.All


#ifdef GUESS

import Test.QuickCheck
import Data.DeriveGuess

example = (,) "Arbitrary2" [d|

    instance Arbitrary a => Arbitrary (DataName a) where
        arbitrary = do
            x <- choose (0,3)
            case x of
                0 -> do return CtorZero
                1 -> do x1 <- arbitrary
                        return (CtorOne x1)
                2 -> do x1 <- arbitrary
                        x2 <- arbitrary
                        return (CtorTwo x1 x2)
                3 -> do x1 <- arbitrary
                        x2 <- arbitrary
                        return (CtorTwo' x1 x2)
    |]

#endif

makeArbitrary2 :: Derivation
makeArbitrary2 = derivation arbitrary' "Arbitrary2"
arbitrary' dat = [InstanceD (concat ([(map (\tdat -> (AppT (ConT (mkName 
    "Arbitrary")) tdat)) (dataVars dat))])) (head [(AppT (ConT (mkName 
    "Arbitrary")) (lK (dataName dat) (dataVars dat)))])[(ValD (VarP (mkName 
    "arbitrary")) (NormalB (DoE [(BindS (VarP (mkName "x")) (AppE (VarE (mkName
    "choose")) (TupE [
-- NOTE BIG TIME:
    (SigE (LitE (IntegerL 0)) (ConT (mkName "Int")))
-- The above was generated by the 'guess' function to just be
-- (LitE (IntegerL 0)) ...
-- but we must annotate it with an Int type so that auto-generated
-- instances actually work since otherwise we get an ambiguous type
-- freak-out
    ,(LitE (IntegerL (toInteger (length (
    dataCtors dat) - 1))))]))),(NoBindS (CaseE (VarE (mkName "x")) ((map (\(
    ctorInd,ctor) -> (Match (LitP (IntegerL ctorInd)) (NormalB (DoE ((map (
    \field -> (BindS (VarP (mkName ("x" ++ show field))) (VarE (mkName 
    "arbitrary")))) (id [1..ctorArity ctor]))++[(NoBindS (AppE (VarE (mkName 
    "return")) (applyWith (ConE (mkName ("" ++ ctorName ctor))) ((map (\field 
    -> (VarE (mkName ("x" ++ show field)))) (id [1..ctorArity ctor]))++[]))))]
    ++[]))) [])) (id (zip [0..] (dataCtors dat))))++[])))])) [])]]