Since the MonadBase superclass is in the way, you could define a custom (EffMonadBaseControl m r) with no superclass (or at least not that one) and then instance (MonadBase m (Eff r), EffMonadBaseControl m r) => MonadBaseControl m (Eff r) (Here I also factored out Eff because why not.) Another way may be to have MonadBase instances for Eff to follow the same structure of going through one effect at a time, instead of jumping to the last element directly via the OpenUnion API as freer-simple does. On 02/01/2018 06:08 PM, John Wiegley wrote:

...

...

...

...

...

"LB" == Lana Black writes:

LB> As far as I understand, MonadBaseControl class does the following: LB> captures the current state. Performs the action passed to lifeBaseWith or LB> other wrapper functions. Returns the result wrapped in the captured state.

LB> Here's the instance I could come up with.

LB> instance (MonadBase m (Eff r), Typeable m, SetMember Lift (Lift m) r) => LB> MonadBaseControl m (Eff r) where LB> type StM (Eff r) a = Eff r a LB> liftBaseWith f = lift (f return) LB> restoreM = id

LB> It obviously doesn't work, but I currently have no idea how to fix it, LB> because `Eff r a' contains the state that needs to be captured and cannot LB> be decomposed without losing data as far as I can see.

Hmmm... all these type classes are getting in my way. I thought I had a good start here, but it's proving hard to use. Maybe others have an idea how to continue.

{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}

module FreerQuestion where

import Control.Monad.Base import Control.Monad.Freer import Control.Monad.Freer.Internal import Control.Monad.Freer.Reader import Control.Monad.Freer.State import Control.Monad.Trans.Class import Control.Monad.Trans.Control import Data.OpenUnion import Data.OpenUnion.Internal

instance MonadBase m m => MonadBaseControl m (Eff '[m]) where type StM (Eff '[m]) a = a liftBaseWith f = sendM (f runM) restoreM = return

instance (Data.OpenUnion.LastMember x (r ': s), Data.OpenUnion.Internal.FindElem x s (Reader e : r : s), MonadBase m x, MonadBaseControl m (Eff (r ': s))) => MonadBaseControl m (Eff (Reader e ': r : s)) where type StM (Eff (Reader e ': r ': s)) a = StM (Eff (r ': s)) a liftBaseWith f = do e <- ask raise $ liftBaseWith $ \runInBase -> f $ \k -> runInBase (runReader e k) restoreM = raise . restoreM

instance (Data.OpenUnion.LastMember x (r ': s), MonadBase m x, Data.OpenUnion.Internal.FindElem x s (State e : r : s), MonadBaseControl m (Eff (r ': s))) => MonadBaseControl m (Eff (State e ': r : s)) where type StM (Eff (State e ': r ': s)) a = StM (Eff (r ': s)) (a, e) liftBaseWith f = do e <- get @e raise $ liftBaseWith $ \runInBase -> f $ \k -> runInBase (runState e k) restoreM x = do (a, e :: e) <- raise (restoreM x) put e return a

foo :: (Member (Reader Int) r, Member (State Int) r, Member IO r) => Eff r () foo = do r <- ask @Int put @Int 1000 () <- control $ \runInBase -> do putStrLn "In IO!" s' <- runInBase $ do put @Int 2000 putStrLn "Back in IO!" return s' s <- get @Int send @IO $ print s

main :: IO () main = runM . evalState (200 :: Int) . runReader (10 :: Int) $ foo

-- John Wiegley GPG fingerprint = 4710 CF98 AF9B 327B B80F http://newartisans.com 60E1 46C4 BD1A 7AC1 4BA2 _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.