Mitchell,

You could pass in another argument that specifies which 's', which might not be as much of a pain if it was an implicit parameter like here: <http://lpaste.net/154303>.


Another way to resolve the ambiguity would be to say that foo1 accesses first State in the list:

type family OuterState xs where
  OuterState (State s ': rest) = s
  OuterState (x ': xs) = OuterState xs

-- using ScopedTypeVariables
foo1 :: forall r s. (OuterState r ~ s, Member (State s) r, HasInt s) => Eff r Int
foo1 = getInt <$> (get :: Eff r s)


But I think you probably should just pin down the state type you're accessing because you can have multiple `State s`and they don't get in each other’s way at all if they have different types.

get2 :: Eff '[State Int, State Char] (Int,Char)
get2 = do i <- get; c <- get; return (i,c) -- works just fine

Regards,
Adam

On Tue, Mar 8, 2016 at 7:02 PM, Mitchell Rosen <mitchellwrosen@gmail.com> wrote:
Sorry, in "foo", the body should be "fmap getInt get". Still, same type error.


On Tuesday, March 8, 2016 at 3:59:23 PM UTC-8, 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@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe