[Haskell-cafe] extensible effects + classy lenses

Roman Cheplyaka roma at ro-che.info
Wed Mar 9 07:47:45 UTC 2016


In show . read ambiguity, is it a weakness of show or read? :)

This isn't a weakness of extensible effects per se; rather, this a
consequence of extensible effects and classy lenses being too
polymorphic, so that they can't be combined without a further
disambiguation.

In monad-classes, there is a 'Zoom' effect which, given a lens from
'big' into 'small', transforms State requests over 'small' into State
effects over 'big'. If you work with only a handful of lenses but use
them often, it may be worth considering.

I also remember someone developing an EE library based on the ideas from
monad-classes and mtlx, where you disambiguate every single effect with
singleton types.

But in general, for best experience, make one of those two things less
polymorphic: mtl + classy lenses (Kmett's preferred way) or EE +
monomorphic lenses (my preferred way).

Roman

On 03/09/2016 01:59 AM, Mitchell Rosen wrote:
> Hi all,
> 
> I'm trying to combine an extensible effects style state with classy
> lenses. That is, instead of pinning the type of my state down, I'd like
> to only require the pieces I need.
> 
> For example,
> 
> {-# language FlexibleContexts #-}
> 
> import Control.Monad.Freer
> import Control.Monad.Freer.State
> 
> class HasInt s where
>   getInt :: s -> Int
> 
> foo :: (Member (State s) effs, HasInt s) => Eff effs Int
> foo = get
> 
> However, this fails to typecheck:
> 
>     Overlapping instances for Member (State s0) effs
>     Matching givens (or their superclasses):
>       (Member (State s) effs)
>         bound by the type signature for
>                    foo :: (Member (State s) effs, HasInt s) => Eff effs Int
>         at example.hs:9:8-56
>     Matching instances:
>       instance Data.Open.Union.Member'
>                  t r (Data.Open.Union.FindElem t r) =>
>                Member t r
>         -- Defined in ‘Data.Open.Union’
>     (The choice depends on the instantiation of ‘effs, s0’)
>     In the ambiguity check for the type signature for ‘foo’:
>       foo :: forall (effs :: [* -> *]) s.
>              (Member (State s) effs, HasInt s) =>
>              Eff effs Int
>     To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
>     In the type signature for ‘foo’:
>       foo :: (Member (State s) effs, HasInt s) => Eff effs Int
> 
> Is this a weakness of extensible effects, or is there another way to
> express this function?
> 
> Thanks,
> Mitchell
> 
> 
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> 



More information about the Haskell-Cafe mailing list