On Tue, Oct 31, 2006 I wrote:
Consider the following sequence of functions that replace a single element in an n-dimensional list:
replace0 :: a -> a -> a replace1 :: Int -> a -> [a] -> [a] replace2 :: Int -> Int -> a -> [[a]] -> [[a]]
Generalize this using type classes.
Thanks to everyone for the refernces about the variadic composition operator. However, that technique only provides a variable number of arguments at the end of the argument list (like in C, etc.). The puzzle as stated requires them at the beginning. Below is a proposed full solution. Unfortunately, it compiles neither in Hugs nor in GHC. But I don't understand why not. GHC says: Functional dependencies conflict between instance declarations: instance Replace Zero a a (a -> a -> a) instance (...) => Replace (Succ n) a [l] f' Not true. The type constraints on the second instance prevent any overlap. Hugs says: ERROR "./Replace.hs":63 - Instance is more general than a dependency allows *** Instance : Replace (Succ a) b [c] d *** For class : Replace a b c d *** Under dependency : a b -> c d Not true. The type constraints limit the scope to within the fundeps. Here is the program:
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
We will need ordinals to count the number of initial function arguments.
data Zero = Zero data Succ o = Succ o
class Ordinal o where ordinal :: o
instance Ordinal Zero where ordinal = Zero
instance Ordinal n => Ordinal (Succ n) where ordinal = Succ ordinal
Args is a model for functions with a variable number of initial arguments of homogeneous type.
data Args a b = Args0 b | ArgsN (a -> Args a b)
instance Functor (Args a) where fmap f (Args0 x) = Args0 $ f x fmap f (ArgsN g) = ArgsN $ fmap f . g
constN is a simple example of an Args. It models a variation on const (well, flip const, actually) that ignores a variable number of initial arguments.
class Ordinal n => ConstN n where constN :: n -> b -> Args a b
instance ConstN Zero where constN _ = Args0
instance ConstN n => ConstN (Succ n) where constN (Succ o) = ArgsN . const . constN o
We can convert any Args into the actual function that it represents. (The inverse is also possible, but we do not need that here.)
class Ordinal n => ArgsToFunc n a b f where argsToFunc :: n -> Args a b -> f
instance ArgsToFunc Zero a b b where argsToFunc _ (Args0 b) = b
instance ArgsToFunc n a b f => ArgsToFunc (Succ n) a b (a -> f) where argsToFunc (Succ o) (ArgsN g) = argsToFunc o . g
When the return type is itself a function, we will need to flip arguments of the internal function out of the Args.
flipOutArgs :: Args a (b -> c) -> b -> Args a c flipOutArgs (Args0 f) = Args0 . f flipOutArgs (ArgsN f) x = ArgsN $ flip flipOutArgs x . f
flipInArgs is the inverse of flipOutArgs. It requires an ordinal, because we need to know how far in to flip the argument.
class Ordinal n => FlipInArgs n where flipInArgs :: n -> (b -> Args a c) -> Args a (b -> c)
instance FlipInArgs Zero where flipInArgs _ f = Args0 $ argsToFunc Zero . f
instance FlipInArgs n => FlipInArgs (Succ n) where flipInArgs (Succ o) f = ArgsN $ flipInArgs o . g where g x y = let ArgsN h = f y in h x
Now we are ready to construct replace.
class ArgsToFunc n Int (a -> l -> l) f => Replace n a l f | n a -> l f, f -> n a l where replaceA :: n -> Args Int a replace :: f
instance Replace Zero a a (a -> a -> a) where replaceA _ = Args0 const replace = const
instance (Replace n a l f, FlipInArgs n, ConstN n, ArgsToFunc (Succ n) Int (a -> [l] -> [l]) f') => Replace (Succ n) a [l] f' where replaceA (Succ o) = ArgsN mkReplace where mkReplace i = flipInArgs o $ flipInArgs o . mkRepl o i mkRepl o i x xs | null t = constN o h | otherwise = fmap (h ++) $ fmap (: tail t) $ flipOutArgs (flipOutArgs (replaceA o) x) xs where (h, t) = splitAt i xs replace = argsToFunc ordinal $ replaceA ordinal