1

我正在尝试构建一个免费的 monad（使用free），它的作用就像 StateT monad，但它允许您也可以在 base state 上运行 monad AppState。我有一个单独的构造函数LiftAction来保存这些类型。这个想法是你一直zoom保持 Actions 直到它们到达 AppState，它可以在它的扩展映射中存储不同的状态。

这是我之前使用 mtl 的尝试（失败）：Lift through nested state transformers (mtl)

无论如何，因为它基本上是一个包装器，StateT所以我给了它一个MonadState实例，但现在我正在努力添加使用镜头库缩放 monad 状态的能力；我遇到了一些奇怪的编译器错误，我无法理解（镜头错误通常对用户不太友好）。

这是我的代码和初步尝试：

{-# 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.

我以前通过定义我自己的缩放函数有一个工作版本，它在给定“镜头”的情况下缩放底层 StateT，但诀窍是我希望它也可以与Traversal's 一起使用，所以最干净的方法是编写缩放实例.

任何人都知道如何编译它？提前致谢！！如果可能的话，请在发布之前尝试编译您的答案，谢谢！

4

1 回答 1

1

虽然我无法编译以前的版本，但我想出了一个可接受的解决方案，使用 FreeT 作为 State monad 的包装器，它只是将提升值的缩放推迟到以后，不幸的是我需要手动实现MonadTrans，MonadFree结果，这并不容易弄清楚。除了 Gabriel Gonzalez 的（稍微过时的）指南之外，没有太多好的教程，解释 FreeT 也有点棘手。

这就是我最终得到的

{-# 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
于 2017-03-10T18:40:54.507 回答