[Haskell-cafe] MultiParamClasses question

Eugeny N Dzhurinsky bofh at redwerk.com
Tue May 25 14:51:06 EDT 2010


Hello, all!

I'm trying to create set of polymorphic functions for working with custom
containers. I decided to try out typeclass and define generic function, which
uses the methods from the typeclass. The quick and naive solution is listed
below:

================================================================================
{-# OPTIONS_GHC -XMultiParamTypeClasses -XTypeSynonymInstances #-}
import Data.List as L

class Storage k t a b where
    stExists :: k -> t -> b -> Bool
    stAdjust :: k -> t -> ( a -> a ) -> b -> b
    stInsert :: k -> t -> a -> b -> b
    stList :: b -> [a]

type IxPair k t = ( k, t, String, String)

data Pair = Pair { name, value :: String }

type IxPairParser k t = Pair -> Maybe (IxPair k t)

type RecordUpdateF r = String -> String -> r -> r

convertPairsToRecords :: (Storage k t a b) => b -> RecordUpdateF a -> IxPairParser k t -> a -> [Pair] -> [a]
convertPairsToRecords storg updateRecF parsePairF initRec = stList . processWithPairs
    where
        processWithPairs = foldl' ( (. parsePairF) . updateStorage ) storg
        updateStorage st Nothing = st
        updateStorage st ( Just (idx, sType, name, value) ) | stExists idx sType st = stAdjust idx sType (updateRecF name value) st
                                                            | otherwise = stInsert idx sType (updateRecF name value initRec) st
================================================================================

so I want to provide methods for checking if a record with given key exists,
update a record, insert a record and get list of records. Sounds similar as
for Map, but I want also to be able to operate on map of maps, or lists, or
whatever.

I don't really see any problem with the code above, however GHC 6.12.1 does
think that I am doing something weird. And it gives me this error log:

================================================================================
test.hs:19:60:
    Could not deduce (Storage k t a1 b)
      from the context (Storage k1 t1 a1 b)
      arising from a use of `stList' at test.hs:19:60-65
    Possible fix:
      add (Storage k t a1 b) to the context of
        the type signature for `convertPairsToRecords'
    In the first argument of `(.)', namely `stList'
    In the expression: stList . processWithPairs
    In the definition of `convertPairsToRecords':
        convertPairsToRecords storg updateRecF parsePairF initRec
                                = stList . processWithPairs
                                where
                                    processWithPairs = foldl' ((. parsePairF) . updateStorage) storg
                                    updateStorage st Nothing = st
                                    updateStorage st (Just (idx, sType, name, value))
                                                    | stExists idx sType st
                                                    = stAdjust idx sType (updateRecF name value) st
                                                    | otherwise
                                                    = stInsert
                                                        idx sType (updateRecF name value initRec) st

test.hs:21:53:
    Could not deduce (Storage k1 t1 a b)
      from the context (Storage k1 t1 a1 b)
      arising from a use of `updateStorage' at test.hs:21:53-65
    Possible fix:
      add (Storage k1 t1 a b) to the context of
        the type signature for `convertPairsToRecords'
    In the second argument of `(.)', namely `updateStorage'
    In the first argument of `foldl'', namely
        `((. parsePairF) . updateStorage)'
    In the expression: foldl' ((. parsePairF) . updateStorage) storg
================================================================================

Can somebody please advice, what am I doing in wrong way?

Thank you all in advance!

-- 
Eugene Dzhurinsky
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 196 bytes
Desc: not available
Url : http://www.haskell.org/pipermail/haskell-cafe/attachments/20100525/5027b03d/attachment.bin


More information about the Haskell-Cafe mailing list