在免费Monad上缩放实例 [英] Zoom instance over Free Monad
问题描述
我正在尝试构建一个免费的monad(使用 免费 )，其行为类似于StateT单子，但也允许您在基本状态 AppState 上运行单子.我有一个单独的构造器 LiftAction ，其中包含那些类型.这个想法是让 zoom ing Actions保持向下，直到它们到达AppState，AppState可以在其扩展映射内存储不同的状态.
I'm attempting to build a free monad (using free) which acts just like a StateT monad, but which allows you to also run monads over a base state AppState. I have a separate constructor LiftAction which holds those types. The idea is that you keep zooming Actions down until they reach AppState, which can store different states inside its extension map.
这是我之前使用mtl的尝试(失败):在嵌套状态转换器中移动(mtl)
Here was my earlier (failed) attempt using mtl: Lift through nested state transformers (mtl)
无论如何，因为它基本上是 StateT 的包装器，所以我给了它一个 MonadState 实例，但是现在我正在努力增加缩放单子状态的功能使用镜头库；我遇到一些奇怪的编译器错误，我难以理解(镜头错误通常对用户不友好).
Anyways, since it's basically a wrapper over StateT I've given it a MonadState instance, but now I'm working on adding the ability to zoom the monad's state using the lens library; I'm getting some weird compiler errors I'm having trouble understanding (the lens errors aren't usually terribly user friendly).
这是我的代码和初次尝试:
Here's my code and initial attempt:
{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
module Eve.Internal.AppF
( Action(..)
, App
, AppState(..)
, liftAction
, execApp
) where
import Control.Monad.State
import Control.Monad.Free
import Control.Lens
type App a = Action AppState a
data AppState = AppState
{ baseExts :: Int -- Assume this actually contains many nested states which we can zoom
}
data ActionF s next =
LiftAction (Action AppState next)
| LiftIO (IO next)
| StateAction (StateT s IO next)
deriving Functor
newtype Action s a = Action
{ getAction :: Free (ActionF s) a
} deriving (Functor, Applicative, Monad)
liftActionF :: ActionF s next -> Action s next
liftActionF = Action . liftF
instance MonadState s (Action s) where
state = liftActionF . StateAction . state
liftAction :: Action AppState a -> Action s a
liftAction = liftActionF . LiftAction
execApp :: Action AppState a -> StateT AppState IO a
execApp (Action actionF) = foldFree toState actionF
where
toState (LiftAction act) = execApp act
toState (LiftIO io) = liftIO io
toState (StateAction st) = st
type instance Zoomed (Action s) = Zoomed (StateT s IO)
instance Zoom (Action s) (Action t) s t where
zoom l (Action actionF) = Action $ hoistFree (zoomActionF l) actionF
where
zoomActionF _ (LiftAction act) = LiftAction act
zoomActionF _ (LiftIO io) = LiftIO io
zoomActionF lns (StateAction act) = StateAction $ zoom lns act
我遇到了错误:
/Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:65: error:
• Couldn't match type ‘a’ with ‘c’
‘a’ is a rigid type variable bound by
a type expected by the context:
forall a. ActionF s a -> ActionF t a
at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:42
‘c’ is a rigid type variable bound by
the type signature for:
zoom :: forall c.
LensLike' (Zoomed (Action s) c) t s -> Action s c -> Action t c
at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:7
Expected type: LensLike'
(Control.Lens.Internal.Zoom.Focusing IO a) t s
Actual type: LensLike' (Zoomed (Action s) c) t s
• In the first argument of ‘zoomActionF’, namely ‘l’
In the first argument of ‘hoistFree’, namely ‘(zoomActionF l)’
In the second argument of ‘($)’, namely
‘hoistFree (zoomActionF l) actionF’
• Relevant bindings include
actionF :: Free (ActionF s) c
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:22)
l :: LensLike' (Zoomed (Action s) c) t s
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:12)
zoom :: LensLike' (Zoomed (Action s) c) t s
-> Action s c -> Action t c
(bound at /Users/chris/dev/eve/src/Eve/Internal/AppF.hs:53:7)
据我所知，这是令人困惑的，因为StateT嵌入在Free构造函数中，并且无法跟踪 a 的类型.
So far as I can tell it's getting confused because the StateT is embedded in the Free constructor and it loses track of the type of a.
我以前通过定义自己的缩放功能(具有给定的镜头"缩放基础StateT)来获得工作版本，但诀窍是我希望它也可以与 Traversal' s一起使用，因此最干净的方法是编写zoom实例.
I previously had a working version by defining my own zoom function which zoomed the underlying StateT given a 'Lens', but the trick is that I'd like this to also work with Traversal's, so the cleanest way would be to write the zoom instance.
任何人都知道如何进行编译?提前致谢！！如果可能的话，请尽量在发布之前尝试编译您的答案，谢谢！
Anyone have an idea of how to get this to compile? Thanks in advance!! If at all possible please try compiling your answers before posting, thanks!
推荐答案
虽然我无法编译以前的版本，但是我想出了一个可以接受的解决方案，使用FreeT作为State monad的包装器，可以简单地阻止缩放直到后来的提升值，不幸的是，我需要手动实现 MonadTrans 和 MonadFree ，这并不是一件容易的事.另外，除了Gabriel Gonzalez的(略过时)指南之外，对FreeT的解释还有些棘手，没有太多好的教程.
While I couldn't ever get the previous to compile, I came up with an acceptable solution using FreeT as a wrapper around the State monad which simply defers the zooming of the lifted values till later, unfortunately I needed to manually implement MonadTrans and MonadFree as a result, which wasn't terribly easy to figure out. Also interpreting FreeT is a bit tricky without too many good tutorials out there except a (slightly out of date) guide by Gabriel Gonzalez.
这就是我最后得到的
{-# language GeneralizedNewtypeDeriving #-}
{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language RankNTypes #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}
{-# language ScopedTypeVariables #-}
module Eve.Internal.Actions
( AppF(..)
, ActionT(..)
, AppT
, execApp
, liftAction
) where
import Control.Monad.State
import Control.Monad.Trans.Free
import Control.Lens
-- | An 'App' has the same base and zoomed values.
type AppT s m a = ActionT s s m a
-- | A Free Functor for storing lifted App actions.
newtype AppF base m next = LiftAction (StateT base m next)
deriving (Functor, Applicative)
-- | Base Action type. Allows paramaterization over application state,
-- zoomed state and underlying monad.
newtype ActionT base zoomed m a = ActionT
{ getAction :: FreeT (AppF base m) (StateT zoomed m) a
} deriving (Functor, Applicative, Monad, MonadIO, MonadState zoomed)
instance Monad n => MonadFree (AppF base n) (ActionT base zoomed n) where
wrap (LiftAction act) = join . ActionT . liftF . LiftAction $ act
instance MonadTrans (ActionT base zoomed) where
lift = ActionT . lift . lift
-- | Helper method to run FreeTs.
unLift :: Monad m => FreeT (AppF base m) (StateT base m) a -> StateT base m a
unLift m = do
step <- runFreeT m
case step of
Pure a -> return a
Free (LiftAction next) -> next >>= unLift
-- | Allows 'zoom'ing 'Action's.
type instance Zoomed (ActionT base zoomed m) =
Zoomed (FreeT (AppF base m) (StateT zoomed m))
instance Monad m => Zoom (ActionT base s m) (ActionT base t m) s t where
zoom l (ActionT action) = ActionT $ zoom l action
-- | Given a 'Lens' or 'Traversal' or something similar from "Control.Lens"
-- which focuses the state (t) of an 'Action' from a base state (s),
-- this will convert @Action t a -> Action s a@.
--
-- Given a lens @HasStates s => Lens' s t@ it can also convert
-- @Action t a -> App a@
runAction :: Zoom m n s t => LensLike' (Zoomed m c) t s -> m c -> n c
runAction = zoom
-- | Allows you to run an 'App' or 'AppM' inside of an 'Action' or 'ActionM'
liftAction :: Monad m => AppT base m a -> ActionT base zoomed m a
liftAction = liftF . LiftAction . unLift . getAction
-- | Runs an application and returns the value and state.
runApp :: Monad m => base -> AppT base m a -> m (a, base)
runApp baseState = flip runStateT baseState . unLift . getAction
-- | Runs an application and returns the resulting state.
execApp :: Monad m => base -> AppT base m a -> m base
execApp baseState = fmap snd . runApp baseState
这篇关于在免费Monad上缩放实例的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
