[Haskell-cafe] Question about abstraction
Bas van Dijk
v.dijk.bas at gmail.com
Wed Jul 2 06:53:14 EDT 2008
Dear list,
I have I question about the following code I was playing with:
(you can past the following right into your editor)
----------------------------------------------------------------------
import Data.Foldable (Foldable, foldMap)
import Data.Monoid (mempty, mappend)
import Data.Traversable (Traversable, traverse)
import Control.Applicative (pure, (<$>), (<*>))
-- I was playing with the following tree-like datastructure (my plan
-- is to make some kind of kd-tree but that's not important now):
data T a = L | N C2 a (T a) (T a)
(T a) (T a)
type C2 = (Float, Float)
-- A fold always comes in handy:
foldT :: b -> (C2 -> a -> b -> b
-> b -> b -> b) -> T a -> b
foldT e _ L = e
foldT e n (N c x tl tr
bl br) = n c x (foldT e n tl) (foldT e n tr)
(foldT e n bl) (foldT e n br)
instance Functor T where
fmap f = foldT L (\p -> N p . f)
-- Now I defined the following instances:
instance Foldable T where
foldMap f = foldT mempty $ \_ x tl tr
bl br -> f x `mappend` tl `mappend` tr
`mappend` bl `mappend` br
instance Traversable T where
traverse f = foldT (pure L) $ \p x tl tr
bl br -> N p <$> f x <*> tl <*> tr
<*> bl <*> br
----------------------------------------------------------------------
-- If you look at the previous two functions you see a similar pattern:
-- they both combine an initial value: 'f x' and 'N p <$> f x' respectively
-- with the childs using a combining function: 'mappend' and '<*>'
respectively.
-- My question is: can I abstract from that?
-- It looks like I can using a function like:
combineWith :: b -> (b -> a -> b) -> a -> a
-> a -> a -> b
n `combineWith` f = \tl tr
bl br -> n `f` tl `f` tr
`f` bl `f` br
-- Now 'foldMap' becomes:
instance Foldable T where
foldMap f = foldT mempty $ \_ x -> f x `combineWith` mappend
-- But 'traverse' won't typecheck:
instance Traversable T where
traverse f = foldT (pure L) $ \p x -> (N p <$> f x) `combineWith` (<*>)
-- Is it possible to make 'combineWith' more general so that the
-- previous typechecks (maybe using arbitrary-rank polymorphism but I
-- don't see how)?
----------------------------------------------------------------------
Thanks,
Bas van Dijk
More information about the Haskell-Cafe
mailing list