How can I abstract a common Haskell recursive applicative functor pattern

Question

While using applicative functors in Haskell I've often run into situations where I end up with repetitive code like this:

instance Arbitrary MyType where
  arbitrary = MyType <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary

In this example I'd like to say:

instance Arbitrary MyType where
  arbitrary = applyMany MyType 4 arbitrary

but I can't figure out how to make applyMany (or something similar to it). I can't even figure out what the type would be but it would take a data constructor, an Int (n), and a function to apply n times. This happens when creating instances for QuickCheck, SmallCheck, Data.Binary, Xml serialization, and other recursive situations.

So how could I define applyMany?

Answer 1

Check out derive. Any other good generics library should be able to do this as well; derive is just the one I am familiar with. For example:

{-# LANGUAGE TemplateHaskell #-}
import Data.DeriveTH
import Test.QuickCheck

$( derive makeArbitrary ''MyType )

To address the question you actually asked, FUZxxl is right, this is not possible in plain vanilla Haskell. As you point out, it is not clear what its type should even be. It is possible with Template Haskell metaprogramming (not too pleasant). If you go that route, you should probably just use a generics library which has already done the hard research for you. I believe it is also possible using type-level naturals and typeclasses, but unfortunately such type-level solutions are usually difficult to abstract over. Conor McBride is working on that problem.

Answer 2

I think you can do it with OverlappingInstances hack:

{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeFamilies, OverlappingInstances #-}
import Test.QuickCheck
import Control.Applicative


class Arbitrable a b where
    convert :: Gen a -> Gen b

instance (Arbitrary a, Arbitrable b c) => Arbitrable (a->b) c where
    convert a = convert (a <*> arbitrary)

instance (a ~ b) => Arbitrable a b where
    convert = id

-- Should work for any type with Arbitrary parameters
data MyType a b c d = MyType a b c d deriving (Show, Eq)

instance Arbitrary (MyType Char Int Double Bool) where
    arbitrary = convert (pure MyType)

check = quickCheck ((\s -> s == s) :: (MyType Char Int Double Bool -> Bool))

Answer 3

Not satisfied with my other answer, I have come up with an awesomer one.

-- arb.hs
import Test.QuickCheck
import Control.Monad (liftM)

data SimpleType = SimpleType Int Char Bool String deriving(Show, Eq)
uncurry4 f (a,b,c,d) = f a b c d

instance Arbitrary SimpleType where
    arbitrary = uncurry4 SimpleType `liftM` arbitrary
    -- ^ this line is teh pwnzors.
    --  Note how easily it can be adapted to other "simple" data types

---

ghci> :l arb.hs
[1 of 1] Compiling Main             ( arb.hs, interpreted )
Ok, modules loaded: Main.
ghci> sample (arbitrary :: Gen SimpleType)
>>>a bunch of "Loading package" statements<<<
SimpleType 1 'B' False ""
SimpleType 0 '\n' True ""
SimpleType 0 '\186' False "\208! \227"
...

Lengthy explanation of how I figured this out

So here's how I got it. I was wondering, "well how is there already an Arbitrary instance for (Int, Int, Int, Int)? I'm sure no one wrote it, so it must be derived somehow. Sure enough, I found the following in the docs for instances of Arbitrary:

(Arbitrary a, Arbitrary b, Arbitrary c, Arbitrary d) => Arbitrary (a, b, c, d)

Well, if they already have that defined, then why not abuse it? Simple types that are merely composed of smaller Arbitrary data types are not much different than just a tuple.

So now I need to somehow transform the "arbitrary" method for the 4-tuple so that it works for my type. Uncurrying is probably involved.

Stop. Hoogle time!

(We can easily define our own uncurry4, so assume we already have this to operate with.)

I have a generator, arbitrary :: Gen (q,r,s,t) (where q,r,s,t are all instances of Arbitrary). But let's just say it's arbitrary :: Gen a. In other words, a represents (q,r,s,t). I have a function, uncurry4, which has type (q -> r -> s -> t -> b) -> (q,r,s,t) -> b. We are obviously going to apply uncurry4 to our SimpleType constructor. So uncurry4 SimpleType has type (q,r,s,t) -> SimpleType. Let's keep the return value generic, though, because Hoogle doesn't know about our SimpleType. So remembering our definition of a, we have essentially uncurry4 SimpleType :: a -> b.

So I've got a Gen a and a function a -> b. And I want a Gen b result. (Remember, for our situation, a is (q,r,s,t) and b is SimpleType). So I am looking for a function with this type signature: Gen a -> (a -> b) -> Gen b. Hoogling that, and knowing that Gen is an instance of Monad, I immediately recognize liftM as the monadical-magical solution to my problems.

Hoogle saves the day again. I knew there was probably some "lifting" combinator to get the desired result, but I honestly didn't think to use liftM (durrr!) until I hoogled the type signature.

Answer 4

Here is what I'v got at least:

{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

module ApplyMany where

import Control.Applicative
import TypeLevel.NaturalNumber -- from type-level-natural-number package

class GetVal a where
  getVal :: a

class Applicative f => ApplyMany n f g where
  type Res n g
  app :: n -> f g -> f (Res n g)

instance Applicative f => ApplyMany Zero f g where
  type Res Zero g = g
  app _ fg = fg

instance
  (Applicative f, GetVal (f a), ApplyMany n f g)
  => ApplyMany (SuccessorTo n) f (a -> g)
  where
    type Res (SuccessorTo n) (a -> g) = Res n g
    app n fg = app (predecessorOf n) (fg<*>getVal)

Usage example:

import Test.QuickCheck

data MyType = MyType Char Int Bool deriving Show
instance Arbitrary a => GetVal (Gen a) where getVal = arbitrary

test3 = app n3 (pure MyType) :: Gen MyType
test2 = app n2 (pure MyType) :: Gen (Bool -> MyType)
test1 = app n1 (pure MyType) :: Gen (Int -> Bool -> MyType)
test0 = app n0 (pure MyType) :: Gen (Char -> Int -> Bool -> MyType)

Btw, I think this solution is not very useful in real world. Especially without local type-classes.

Answer 5

Check out liftA2 and liftA3. Also, you can easily write your own applyTwice or applyThrice methods like so:

applyTwice :: (a -> a -> b) -> a -> b
applyTwice f x = f x x

applyThrice :: (a -> a -> a -> b) -> a -> b
applyThrice f x = f x x x

There's no easy way I can see to get the generic applyMany you're asking for, but writing trivial helpers such as these is neither difficult nor uncommon.

---

[edit] So it turns out, you'd think something like this would work

liftA4 f a b c d = f <$> a <*> b <*> c <*> d
quadraApply f x = f x x x x

data MyType = MyType Int String Double Char

instance Arbitrary MyType where
    arbitrary = (liftA4 MyType) `quadraApply` arbitrary

But it doesn't. (liftA4 MyType) has a type signature of (Applicative f) => f Int -> f String -> f Double -> f Char -> f MyType. This is incompatible with the first parameter of quadraApply, which has a type signature of (a -> a -> a -> a -> b) -> a -> b. It would only work for data structures that hold multiple values of the same Arbitrary type.

data FourOf a = FourOf a a a a

instance (Arbitrary a) => Arbitrary (FourOf a) where
    arbitrary = (liftA4 FourOf) `quadraApply` arbitrary

ghci> sample (arbitrary :: Gen (FourOf Int))

Of course you could just do this if you had that situation

ghci> :l +Control.Monad
ghci> let uncurry4 f (a, b, c, d) = f a b c d
ghci> samples <- sample (arbitrary :: Gen (Int, Int, Int, Int))
ghci> forM_ samples (print . uncurry4 FourOf)

There might be some language pragma that can shoehorn the "arbitrary" function into the more diverse data types. But that's currently beyond my level of Haskell-fu.

Answer 6

This is not possible with Haskell. The problem is, that your function will have a type, that depends on the numeric argument. With a type system that allows dependent types, that should be possible, but I guess not in Haskell.

What you can try is using polymorphism and tyeclasses to archieve this, but it could become hacky and you need a big bunch of extensions to satisfy the compiler.