Calculate N-Ary (with different types !!) Cartesian Product in Haskell

Question

I know that the function sequence can handle the [[1, 2], [3, 4]] -> [[1, 3], [1, 4], [2, 3], [2, 4]] problem.

But I think the real cartesian product should handle the ([1, 2], ['a', 'b']) -> [(1, 'a'), (1, 'b'), (2, 'a'), (2, 'b')] problem, and should care about neigher if the type of each list is different nor the outer tuple's type( & size).

So, the cartProd function I want has a type like this: ([a1], [a2], [a3] ...) -> [(a1, a2, a3 ...)]

I know there is some problem here with the type system. But is there any way to implement a perfect version of this cartProd ?

Answer 1

The usual heterogeneous list can be used here:

{-# LANGUAGE
   UndecidableInstances, GADTs,
   TypeFamilies, MultiParamTypeClasses,
   FunctionalDependencies, DataKinds, TypeOperators,
   FlexibleInstances #-}

import Control.Applicative

data HList xs where
  Nil  :: HList '[]
  (:>) :: x -> HList xs -> HList (x ': xs)
infixr 5 :>

-- A Show instance, for illustrative purposes here. 
instance Show (HList '[]) where
  show _ = "Nil"

instance (Show x, Show (HList xs)) => Show (HList (x ': xs)) where
  show (x :> xs) = show x ++ " : " ++ show xs

We usually write functions on HLists using classes, with one instance for Nil and another for the :> case. However, it wouldn't be pretty to have a class for just a single use case (namely cartesian products here), so let's generalize the problem to applicative sequencing:

class Applicative f => HSequence f (xs :: [*]) (ys :: [*]) | xs -> ys, ys f -> xs where
  hsequence :: HList xs -> f (HList ys)

instance Applicative f => HSequence f '[] '[] where
  hsequence = pure

instance (Applicative g, HSequence f xs ys, y ~ x, f ~ g) =>
         HSequence g (f x ': xs) (y ': ys) where
  hsequence (fx :> fxs) = (:>) <$> fx <*> hsequence fxs

Note the use of ~ constraints in the instance definition. It greatly helps type inference (along with the functional dependencies in the class declaration); the general idea is to move as much information as possible from the instance head to the constraints, because that lets GHC delay solving them until there is sufficient contextual information.

Now cartesian products work out of the box:

> hsequence ([1, 2] :> "ab" :> Nil)
[1 : 'a' : Nil,1 : 'b' : Nil,2 : 'a' : Nil,2 : 'b' : Nil]

And we can also use hsequence with any Applicative :

> hsequence (Just "foo" :> Just () :> Just 10 :> Nil)
Just "foo" : () : 10 : Nil

EDIT: I found out (thanks dfeuer) that the same functionality is available from the existing hlist package:

import Data.HList.CommonMain

> hSequence ([3, 4] .*. "abc" .*. HNil)
[H[3, 'a'],H[3, 'b'],H[3, 'c'],H[4, 'a'],H[4, 'b'],H[4, 'c']]

Answer 2

Using Template Haskell it is possible to achieve this.

{-# LANGUAGE TemplateHaskell #-}
f :: ExpQ -> ExpQ
f ess = do es <- ess
           case es of
             (TupE e) -> return $ h e
             _ -> fail "f expects tuple of lists"
  where
    h ts = let ns = zipWith (\_ -> mkName . ('x':) . show) ts [0..]
           in CompE $ (zipWith (BindS . VarP) ns ts) ++
                      [NoBindS $ TupE $ map VarE ns]

Then perhaps a little awkward to use, but that's the price of supporting any tuples:

Prelude> take 7 $ $(f [| ([1..], [1..2], "ab") |] )
[(1,1,'a'),(1,1,'b'),(1,2,'a'),(1,2,'b'),(2,1,'a'),(2,1,'b'),(2,2,'a')]

Answer 3

I found a better solution myself, this solution is perfect for user, but it's implementation is sort of ugly (must create instance of every tuple, just like zip):

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}

class CartProd a b | a -> b where
    cartProd :: a -> b

instance CartProd ([a], [b]) [(a, b)] where
    cartProd (as, bs) = [(a, b) | a <- as, b <- bs]

instance CartProd ([a], [b], [c]) [(a, b, c)] where
    cartProd (as, bs, cs) = [(a, b, c) | a <- as, b <- bs, c <- cs]

c = cartProd (['a'..'c'], [0..2])
d = cartProd (['a'..'c'], [0..2], ['x'..'z'])

We can also provide a better version of zip this way, so that we can use a single function name zip' instead of zip , zip3 , zip4 ...:

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-}

class Zip a b | a -> b where
    zip' :: a -> b

instance Zip ([a], [b]) [(a, b)] where
    zip' (as, bs) = zip as bs

instance Zip ([a], [b], [c]) [(a, b, c)] where
    zip' (as, bs, cs) = zip3 as bs cs

a = zip' (['a'..'z'], [0..])
b = zip' (['a'..'z'], [0..], ['x'..'z'])