Monads and Maybe

C T McBride c.t.mcbride@durham.ac.uk
Fri, 29 Aug 2003 10:54:27 +0100 (BST)


Hi all

Sorry I've been slow replying: I'm not around much at the moment.

Thanks for all the responses. I did think, when I started playing with
what I call eta and <$>, that I couldn't possibly be alone.

Would it be good if we sought some more standardized presentation of
this structure?  In terms of


*** 1 what to call the class and its methods: I have no particular
      attachment to any of the names I've used (also for stuff below)


*** 2 what other bits and pieces we'd like to have also; in the Epigram
      source, I currently have the more general n-ary lifting operator fun,
      defined thus (again, I'm not attached to the names)

> class Fun f => Funnel f s t | f s -> t, s t -> f, f t -> s where
>   fun :: s -> t
>   funnel :: f s -> t

> instance Funnel f t u => Funnel f (s -> t) (f s -> u) where
>   fun g = funnel (eta g)
>   funnel fg fx = funnel (fg <$> fx)

(defun base-funnel (data) (insert (concat "\n\n"
"> instance Fun f => Funnel f " data " (f " data") where\n"
">   fun    = eta\n"
">   funnel = id\n"
)))

      and then a Funnel instance for each base type, but I'd rather have

> instance Fun f => Funnel f data (f data) where
>   fun    = eta
>   funnel = id

      I believe it's that overlapping instances vs fundep problem...

      Also `ExtractableFunctor'...

> infixl 9 <^>
> class Functorial g where
>   (<^>) :: Fun f => (s -> f t) -> g s -> f (g t)

      ...and flattening...

> infixr 5 <+>
> class Monoidal x where
>   m0 :: x
>   (<+>) :: x -> x -> x

> newtype K s t = K {unK :: s} deriving (Show,Eq)

> instance Monoidal s => Fun (K s) where
>   eta _ = K m0
>   K x <$> K y = K (x <+> y)

> infixl 9 <!>

> (<!>) :: (Functorial g,Monoidal s) => (x -> s) -> g x -> s
> f <!> gx = unK ((K . f) <^> gx)


*** 3 what extra syntax might be nice for work in this style, the way
      do-notation supports monads; one interesting question is how much
      of the lifting can be inferred silently, within the scope of a
      general hint that we're `working under f'


I'm certainly interested in giving a serviceable presentation to this
style of working: I use it all the time. Is it worth trying to get
some sort of consensus?

Cheers

Conor