在 Free Monad 上缩放实例
Zoom instance over Free Monad
我正在尝试构建一个免费的 monad（使用 free），它的行为就像一个 StateT monad，但它还允许您 运行 monad 在基本状态 AppState.我有一个单独的构造函数 LiftAction 来保存这些类型。这个想法是你保持 zooming 动作直到它们到达 AppState，它可以在其扩展映射中存储不同的状态。
这是我之前（失败）使用 mtl 的尝试：
无论如何，因为它基本上是 StateT 的包装器，所以我给了它一个 MonadState 实例，但现在我正在努力添加使用 [= 缩放 monad 状态的能力22=]；我遇到了一些奇怪的编译器错误，我无法理解（镜头错误通常不是非常用户友好）。
这是我的代码和初步尝试：
{-# 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.
的类型
我之前通过定义我自己的缩放函数有一个工作版本，它在给定 'Lens' 的情况下缩放底层 StateT，但诀窍是我希望它也适用于 Traversal's , 所以最干净的方法是编写缩放实例。
有人知道如何编译它吗？提前致谢！！如果可能的话，请在发布前尝试整理您的答案，谢谢！
虽然我无法编译之前的版本，但我想出了一个可接受的解决方案，使用 FreeT 作为 State monad 的包装器，它只是将提升值的缩放推迟到以后，不幸的是我需要手动结果实现 MonadTrans 和 MonadFree，这不是很容易弄清楚。解释 FreeT 也有点棘手，没有太多好的教程，除了 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（使用 free），它的行为就像一个 StateT monad，但它还允许您 运行 monad 在基本状态 AppState.我有一个单独的构造函数 LiftAction 来保存这些类型。这个想法是你保持 zooming 动作直到它们到达 AppState，它可以在其扩展映射中存储不同的状态。
这是我之前（失败）使用 mtl 的尝试：
无论如何，因为它基本上是 StateT 的包装器，所以我给了它一个 MonadState 实例，但现在我正在努力添加使用 [= 缩放 monad 状态的能力22=]；我遇到了一些奇怪的编译器错误，我无法理解（镜头错误通常不是非常用户友好）。
这是我的代码和初步尝试：
{-# 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.
我之前通过定义我自己的缩放函数有一个工作版本，它在给定 'Lens' 的情况下缩放底层 StateT，但诀窍是我希望它也适用于 Traversal's , 所以最干净的方法是编写缩放实例。
有人知道如何编译它吗？提前致谢！！如果可能的话，请在发布前尝试整理您的答案，谢谢！
虽然我无法编译之前的版本，但我想出了一个可接受的解决方案，使用 FreeT 作为 State monad 的包装器，它只是将提升值的缩放推迟到以后，不幸的是我需要手动结果实现 MonadTrans 和 MonadFree，这不是很容易弄清楚。解释 FreeT 也有点棘手，没有太多好的教程，除了 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