Mapping over a heterogenous data structure with a generic function

Question

I'm working on an HList implementation and I'm stuck trying to implement a map function for it. I've tried a lot of different approaches but with each one I reach compiler errors related to that function.

Following is an example of how I want to use a generic function Just to apply it to all elements of the input data structure.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

-- | An input heterogenous data structure
recursivePairs :: (Int, (Char, (Bool, ())))
recursivePairs = (1, ('a', (True, ())))

-- | This is how I want to use it
recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap Just recursivePairs

class HMap f input output where
  hMap :: f -> input -> output

-- | A counterpart of a Nil pattern match for a list
instance HMap f () () where
  hMap _ _ = ()

-- | A counterpart of a Cons pattern match for a list
instance 
  ( HMap f iTail oTail, 
    Apply f iHead oHead ) =>
  HMap f (iHead, iTail) (oHead, oTail) 
  where
    hMap f (head, tail) = (apply f head, hMap f tail)

class Apply f input output where
  apply :: f -> input -> output

instance Apply (input -> output) input output where
  apply = id

With this I'm getting the following compiler error:

No instance for (Apply (a0 -> Maybe a0) Int (Maybe Int))
  arising from a use of `hMap'
The type variable `a0' is ambiguous

Is there at all a way to solve this and if not then why?

Answer 1

The problem is that you are trying to use a polymorphic function with different arguments, but your Apply instance takes a function (a mono-type). You can easily fix this multiple ways

data JustIfy = JustIfy
instance Apply JustIfy a (Maybe a) where
  apply _ = Just

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap JustIfy recursivePairs

works with your code just fine

EDIT: A more general approach to the same thing is (requiring RankNTypes)

--A "universal" action that works on all types
newtype Univ f = Univ (forall x. x -> f x)
instance Apply (Univ f) x (f x) where
   apply (Univ f) x = f x

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap (Univ Just) recursivePairs

or if you are using a recent ish version of GHC and are willing to turn on more extensions

newtype Univ' c f = Univ' (forall x. c x => x -> f x)
instance c x => Apply (Univ' c f) x (f x) where
  apply (Univ' f) x = f x

class All x
instance All x

recursivePairs' :: (Maybe Int, (Maybe Char, (Maybe Bool, ())))
recursivePairs' = hMap (Univ' Just :: Univ' All Maybe) recursivePairs

which is nice since then it lets you do things like include a "show" in the function you map with.

For a more general solution, check out Oleg's Type level lambda caclulus which allows you to write code at the value level and then auto-magically infers the appropriate type level program. Unfortunetly, Oleg's solution is at this point rather old, and uses a nominal implementation of the LC which I don't particularly like. I've been thinking about how to do better, but might hold off until deciable equality comes to type families.

My view is that HLists should these days be done using GADTs and DataKinds rather than tuples. Type families are preferable to functional dependencies, but currently are more limited because they lack decidable equality.

Answer 2

Although the following does not exactly answer the question (so I won't be accepting it), it does solve the problem concerning mapping the structure without requiring any additional instances for applicative functors:

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

import Control.Applicative

main = do
  print $ (hPure recursivePairs :: (Maybe Int, (Maybe Char, (Maybe Bool, ()))))
  print $ (hPure recursivePairs :: ([Int], ([Char], ([Bool], ()))))

recursivePairs :: (Int, (Char, (Bool, ())))
recursivePairs = (1, ('a', (True, ())))

class HPure input output where
  hPure :: input -> output

instance HPure () () where
  hPure _ = ()

instance  
  ( Applicative f, 
    HPure iTail oTail ) => 
  HPure (iHead, iTail) (f iHead, oTail) 
  where hPure (iHead, iTail) = (pure iHead, hPure iTail)

Outputs:

(Just 1,(Just 'a',(Just True,())))
([1],("a",([True],())))