[Haskell-cafe] arr f

[Chris Kuklewicz]

Sven Biedermann wrote:
> Hello Henrik & Ross,
> 
> Man thanks for your input. I have realised that I should have explained
> my problem better.
> 
> So, I try...
> 
> I want to create a datatype like this:
> 
> 	data D a b = DepVoid (a->b)   | -- a = ()
> 			 DepSingle (a->b) | -- a = a      simple ones
> 			 DepPair (a->b)   | -- a = (c,d)
> 			 DepTriple (a->b) | -- a = (c,d,e)
> 			 ...
> 			 DepFun (a->b)      -- a = (c->d)
> 			 ...

You have a serious typing problem in Haskell with that.  Every constructor could
be replaced with DepSingle.

> Its easy to construct them:
> 
> 	mkArrVoid :: (() -> c) -> D () c
> 	mkArrVoid f	= DepVoid f
> 
> 	mkArrPair :: ((a,b) -> c) -> D (a,b) c
> 	mkArrPair f = DepPair f  
> 
> 	...
> 
> Now I want to make D an instance of Arrow:
> 
> 	instance Arrow (D) where -- my problems stems from
> 		arr f = ???
> 
> I have no clue to glue the mkArr* functions together to reach what I
> want: a different Dep* for different functions f.
> What can I pattern match, here? What can I do else?

This is not easily fixable, since (arr = DepSingle ) is always a valid choice
for the compiler to make.  Thus typeclass solutions badly overlap.

> 
> Greetings
> 
> Sven
> 

I can come closer with a GADT.  The serious typing problem is still there.  So I
made arr and pure into error messages.

{-# OPTIONS -farrows -fglasgow-exts #-}
import Control.Arrow

-- GADT style
data D x y where
  DepVoid :: (()->b) -> D () b
  DepSingle :: (a->b) -> D a b
  DepPair :: ((a1,a2)->b) -> D (a1,a2) b
  DepFun :: ( (a1->a2) -> b ) -> D (a1->a2) b

-- And these are the constructors, so we could skip them
mkArrVoid = DepVoid
mkArrSingle = DepSingle
mkArrPair = DepPair
mkArrFun = DepFun

-- The destructor is more annoying (template haskell would help)
-- http://haskell.org/hawiki/GADT_20with_20record_20syntax might make this easier
getF :: D x y -> (x -> y)
getF (DepVoid f) = f
getF (DepSingle f) = f
getF (DepPair f) = f
getF (DepFun f) = f

-- This is useful for diagnosing which constructor you have, for testing
getF' :: D x y -> Int
getF' (DepVoid f) = 1
getF' (DepSingle f) = 2
getF' (DepPair f) = 3
getF' (DepFun f) = 4

instance Arrow D where
  arr _ = error "Use Dep* instead" -- or arr = DepSingle
  pure _ = error "Use Dep* instead" -- or pure = DepSingle
  first arrD = let toPair :: (x->y) -> D (x,d) (y,d)
                   toPair f = DepPair (\(b,d) -> (f b,d) )
               in toPair (getF arrD)
  -- (template haskell would help with defining >>>)
  (>>>) arr1 arr2 = let comp f = (getF arr2) . f
                    in case arr1 of
                         DepVoid f -> DepVoid (comp f)
                         DepSingle f -> DepSingle (comp f)
                         DepPair f -> DepPair (comp f)
                         DepFun f -> DepFun (comp f)

-- This >>> loses the constructor info of arr1 but is simpler
(>>>>) arr1 arr2 = DepSingle ( (getF arr2) . (getF arr1) )