haskell hlist hnil pattern matching hfoldl

Question

I've been trying to get some code to work with Data.HList. I know I can do what I need to with ADT alone but I wanted to see how it would work with HList so I was experimenting. But I'm having trouble compiling code I wrote.

{-# LANGUAGE GADTs #-}

module TestHList where

import Data.HList.CommonMain

data MyType1 = MyType1 { x::Int, y::Int } deriving (Show)
data MyType2 = MyType2 { text::String, slen::Int } deriving (Show)
data MyType3 = MyType3 { dval1::Int, dval2::String } deriving (Show)

test1 = HCons (MyType2 { text = "Hello", slen=5 })
          (HCons (MyType1 { x=1, y=2 })
          (HCons (MyType3 { dval1=3, dval2="World" })
          HNil))

test2 = HCons (MyType1 { x=4, y=5 })
          (HCons (MyType1 { x=6, y=7 })
          (HCons (MyType2 { text="Again.", slen=6 })
          HNil))

addType1 ls1 ls2 = hAppendList ls1 ls2


class MyTypesInt a where
  sumIt :: a -> Int

instance MyTypesInt MyType1 where
  sumIt val = (x val) + (y val)

instance MyTypesInt MyType2 where
  sumIt val = slen val

instance MyTypesInt MyType3 where
  sumIt val = (dval1 val) * 2

sumTest1 v = sumIt v
sumTest2 ls = sumIt (hHead ls)

foldTest ls = hFoldl (\(v1,v2) -> v1 + (sumIt v2)) 0 ls
sumTest3 = foldTest test1

sumAll HNil = 0
sumAll ls = (sumIt (hHead ls)) + (sumAll (hTail ls))

{-
sumAll3 xs
  | xs == HNil = 0
  | otherwise = (sumIt (hHead xs)) + (sumAll3 (hTail xs))
-}

The code doesn't do anything useful it's only intended to help me understand how to use HList. The code declares 3 separate data types and makes a class and defines instances for the 3 types. My goal was to setup a list and then execute the class function, sumIt, over each element of the list based on the instance defined for them. I know test1, test2 addType1, sumTest1 and sumTest2 work. The compile errors I get are for the foldTest and sumAll functions. I think I need to define function declarations but not sure how. Here are the compile errors.

TestHList.hs:39:1:
Could not deduce (MyTypesInt a0)
  arising from the ambiguity check for `foldTest'
from the context (Num z,
                  HFoldl ((Int, a) -> Int) z xs r,
                  MyTypesInt a)
  bound by the inferred type for `foldTest':
             (Num z, HFoldl ((Int, a) -> Int) z xs r, MyTypesInt a) =>
             HList xs -> r
  at TestHList.hs:39:1-55
The type variable `a0' is ambiguous
Possible fix: add a type signature that fixes these type variable(s)
Note: there are several potential instances:
  instance MyTypesInt MyType3 -- Defined at TestHList.hs:33:10
  instance MyTypesInt MyType2 -- Defined at TestHList.hs:30:10
  instance MyTypesInt MyType1 -- Defined at TestHList.hs:27:10
When checking that `foldTest'
  has the inferred type `forall z (xs :: [*]) r a.
                         (Num z, HFoldl ((Int, a) -> Int) z xs r, MyTypesInt a) =>
                         HList xs -> r'
Probable cause: the inferred type is ambiguous

TestHList.hs:42:8:
Couldn't match type `(':) * e0 l0' with '[] *
Inaccessible code in
  a pattern with constructor
    HNil :: HList ('[] *),
  in an equation for `sumAll'
In the pattern: HNil
In an equation for `sumAll': sumAll HNil = 0

TestHList.hs:43:49:
Occurs check: cannot construct the infinite type: l0 = (':) * e0 l0
Expected type: HList ((':) * e0 ((':) * e0 l0))
  Actual type: HList ((':) * e0 l0)
In the first argument of `hTail', namely `ls'
In the first argument of `sumAll', namely `(hTail ls)'
In the second argument of `(+)', namely `(sumAll (hTail ls))'

My question is does someone know what I need to do to fix the code so it would work? I've done quite a few searches to find the answer. It's possible I've seen the answer during that search but that I'm just not understanding it.

Thanks

Update:

While researching the ideas in the answers I was given I ran across this link: http://en.wikibooks.org/wiki/Haskell/Existentially_quantified_types

After reading this it was easy to implement what I was trying to do. I'm not changing the answer. My question was specifically about how to get my code to work with Data.HList and the answers provided do that very well. But my intention was to figure out how to setup and use a heterogeneous list and I thought at the time Data.HList was the way to do it. The following code is a bit easier for me to follow, so I wanted to provide it in case someone else finds it useful.

{-# LANGUAGE ExistentialQuantification #-}

module TestHeterList where

data MyType1 = MyType1 { x::Int, y::Int } deriving (Show)
data MyType2 = MyType2 { text::String, slen::Int } deriving (Show)
data MyType3 = MyType3 { dval1::Int, dval2::String } deriving (Show)

class MyTypesInt a where
  sumIt :: a -> Int

instance MyTypesInt MyType1 where
  sumIt val = (x val) + (y val)

instance MyTypesInt MyType2 where
  sumIt val = slen val

instance MyTypesInt MyType3 where
  sumIt val = (dval1 val) * 2

data GenElem = forall s. (Show s, MyTypesInt s) => GE s
instance Show GenElem where
  show (GE s) = show s

test1 :: [GenElem]
test1 = [GE (MyType2 { text = "Hello", slen=5 }), GE (MyType1 { x=1, y=2 }), GE (MyType3 { dval1=3, dval2="World" })]

foldTest xs = foldl (\acc (GE val) -> acc + sumIt val) (0::Int) xs
sumTest1 = foldTest test1

sumAll [] = 0
sumAll (GE v : xs) = (sumIt v) + (sumAll xs)

sumTest2 = sumAll test1

Answer 1

Here's how you can make the hFoldl-based variant work:

data HSumAll = HSumAll
instance (MyTypesInt a, int ~ Int) => ApplyAB HSumAll (Int, a) int where
  applyAB HSumAll (v1, v2) = v1 + sumIt v2 

foldTest ls = hFoldl HSumAll (0 :: Int) ls
sumTest3 = foldTest test1

Making the direct version work is more tricky. First of all, you have to use pattern matching, because HList is a GADT, and the type refinement can't possibly work if you use selector functions. Furthermore, functions matching on GADTs need explicit type signatures. So you end up with something like this:

sumAll :: HList ls -> Int -- WRONG
sumAll HNil         = 0
sumAll (HCons x xs) = sumIt x + sumAll xs

This produces the following type error:

Could not deduce (MyTypesInt e) arising from a use of `sumIt' from the context (ls ~ (':) * e l1) ...

And GHC is of course right to complain. We need all the types in ls to be an instance of MyTypesInt. I've browsed the HList package to see if the library provides a way to express this, but it seems to me it doesn't. Fortunately, this is relatively easy to do these days (requires ConstraintKinds and importing GHC.Exts to get access to Constraint):

type family All (c :: * -> Constraint) (xs :: [*]) :: Constraint
type instance All c '[]       = ()
type instance All c (x ': xs) = (c x, All c xs)

Then you can say:

sumAll :: All MyTypesInt ls => HList ls -> Int
sumAll HNil         = 0
sumAll (HCons x xs) = sumIt x + sumAll xs

This typechecks and works as expected.

Answer 2

The problem with your use of hFoldl is that the function with which you are folding is not polymorphic enough to operate on arguements of type MyType1, MyType2 and MyType3 all at the same time. Consider the following simplified example:

testString = hFoldl f "" ((1 :: Int) `HCons` () `HCons` HNil)
  where
    f :: Show a => (String, a) -> String
    f = \(str, x) -> str ++ show x

Even though you may think that this would work, since Int and () can both be shown, it doesn't, because f is instantiated to (String, Int) -> String when it is applied to the first element, and this obviously cannot be applied to ().

HList may have some typeclass to fold over HLists with polymorphic functions, but I don't know it well enough, so the simple solution is to first map over the input list with an existential type constructor which hides the actual type, then apply the fold on a list of now homogenous types:

{-# LANGUAGE GADTs, ScopedTypeVariables, FlexibleContexts, 
             RankNTypes, TypeOperators, DataKinds #-}

data SomeMyType = forall a. MyTypesInt a => SMT a

testFold :: forall as xs . (SameLength' as xs, SameLength' xs as, 
             HMapAux (Fun MyTypesInt SomeMyType) as xs, 
             HFoldl ((Int, SomeMyType) -> Int) Int xs Int) => HList as -> Int
testFold = foldHidden . hide
  where  
    foldHidden :: HList xs -> Int
    foldHidden ls = hFoldl (\(v1,SMT v2) -> v1 + (sumIt v2)) (0 :: Int) ls

    hide :: HList as -> HList xs 
    hide = hMap (Fun SMT :: Fun MyTypesInt SomeMyType) 

sumTest1 = testFold test1

This probably isn't very satisfactory as you have to define a new type just to do it.

The other function is simpler. First, as to why it doesn't work: what type could you assign to sumAll? You can't assign a sensible type because the input HList xs must be a list of any length. For this you can write a simple class:

class SumAll xs where 
  sumAll :: HList xs -> Int

instance SumAll '[] where 
  sumAll HNil = 0

instance (MyTypesInt x, SumAll xs) => SumAll (x ': xs) where 
  sumAll (HCons x xs) = sumIt x + sumAll xs 

sumTest2 = sumAll test1

Of course this is just a specific version of the testFold.