Cartesian product of heterogeneous lists

Question

Of course, producing a Cartesian product of heterogeneous lists can be done in a number of way in Haskell, such as:

[(x,y) | x <- [1,2,3], y <- [4,5,6]]

or

(,) <$> [1,2,3] <*> [4,5,6]

But what I want is a function like this:

heteroCartesian :: 
  (a1, a2, ... , an) -> 
  (b1, b2, ... , bn) -> 
  ((a1,b1), (a1,b2), ... , (a1,bn), (a2,b1), (a2,b2), ... , (a2,bn), (an,b1), ... ,(an,b2), ... , (an,bn))

So I can do something like this:

f (1,'a',True) (2,'b') == 
((1,2),(1,'b'),('a',2),('a','b'),(True,2),(True,'b'))

I don't mind whether I'm using tuples or something else, but I need to retain the type information like I have above.

The reason why I want this is to create test cases. I've got a bunch of say n functions and m values. Eventually I will map a function over these which reduces them all to the same type (a Test) but up to that point there's a bunch of different types for the n*m testcases I want to perform (it's actually not that simple as some functions can only take restricted subsets of the values).

So naturally it would good to have other functions these heterogeneous lists, like some sort of map for example.

I've had a look at HList, but it hasn't been updated in the last year and a bit, and I wasn't sure if it was the most appropriate tool anyway.

Answer 1

It appears HList has indeed bit rotted a bit. Nonetheless, nothing stops us from rolling our own HList! In fact, we can also heavily rely on singletons for our type level list operations. First, some imports:

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

import Data.Singletons
import Data.Promotion.Prelude.List

Then the actual definition of an HList (simpler than the one the package of that name uses, for reasons described here and here).

data HList (l :: [*]) where
  HNil :: HList '[]
  HCons :: x -> HList xs -> HList (x ': xs)

-- Notice we are using `:++` from singletons
append :: HList xs -> HList ys -> HList (xs :++ ys)
append HNil xs = xs
append (x `HCons` xs) ys = x `HCons` (xs `append` ys)

-- Notice we are using `Map` and `TyCon1` from singletons. Bow before the magic
-- of type level HOFs. ;)
addTuple :: z -> HList xs -> HList (Map (TyCon1 ((,) z)) xs)
addTuple _ HNil = HNil
addTuple x (y `HCons` ys) = (x,y) `HCons` addTuple x ys

-- These instances aren't needed, but they let us check the output of our code
instance (Show x, Show (HList xs)) => Show (HList (x ': xs)) where
  show (x `HCons` xs) = show x ++ " " ++ show xs
instance Show (HList '[]) where
  show HNil = ""

Finally, we get to the cartesian product itself:

type family Cartesian (ys :: [*]) (xs :: [*]) :: [*] where
  Cartesian '[] xs = '[]
  Cartesian (y ': ys) xs = Map (TyCon1 ((,) y)) xs :++ Cartesian ys xs

cartesian :: HList xs -> HList ys -> HList (xs `Cartesian` ys)
cartesian HNil _ = HNil
cartesian (y `HCons` ys) xs = addTuple y xs `append` cartesian ys xs

Which we can test works:

ghci> h1 = HCons True $ HCons LT $ HCons () $ HCons (1 :: Int) HNil
ghci> h2 = HCons () $ HCons "hello" $ HCons 'a' HNil
ghci> h1 `cartesian` h2
(True,()) (True,"hello") (True,'a') (LT,()) (LT,"hello") (LT,'a') ((),()) ((),"hello") ((),'a') (1,()) (1,"hello") (1,'a')

---

With all that said, I'm not sure this is really worth it for tests. Fundamentally, I expect tests to be simpler and more readable than the code I am testing. And HList is not my idea of a simple test. But, to each his own. :)

Answer 2

A way to solve this, is by using template Haskell for that:

import Control.Monad(replicateM)
import Language.Haskell.TH.Syntax(newName,Pat(TupP,VarP),Exp(LamE,TupE,VarE))

heteroCartesian m n = do
    as <- replicateM m $ newName "a"
    bs <- replicateM n $ newName "b"
    return $ LamE [TupP (map VarP as),TupP (map VarP bs)] $ TupE $ [TupE [VarE ai,VarE bi] | ai <- as, bi <- bs]

Now in another file, you can use the function:

{-# LANGUAGE TemplateHaskell #-}

heteroCartesian23 = $(heteroCartesian 2 3)

In that case heteroCartesian23 will have type heteroCartesian23 :: (a1,a2) -> (b1,b2,b3) -> ((a1,b1),(a1,b2),(a1,b3),(a2,b1),(a2,b2),(a2,b3)).

Or you can use it in ghci:

$ ghci -XTemplateHaskell library.hs
GHCi, version 7.10.3: http://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( ha.hs, interpreted )
Ok, modules loaded: Main.
*Main> :t $(heteroCartesian 3 4)
$(heteroCartesian 3 4)
  :: (t, t1, t5)
     -> (t2, t3, t4, t6)
     -> ((t, t2),
         (t, t3),
         (t, t4),
         (t, t6),
         (t1, t2),
         (t1, t3),
         (t1, t4),
         (t1, t6),
         (t5, t2),
         (t5, t3),
         (t5, t4),
         (t5, t6))