[Haskell-cafe] MonadBaseControl and Freer
John Wiegley
johnw at newartisans.com
Thu Feb 1 23:08:58 UTC 2018
>>>>> "LB" == Lana Black <lanablack at amok.cc> 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
More information about the Haskell-Cafe
mailing list