缩放有“双重”功能吗?

Is there a “dual” to zooming?

zoom 允许我们在实际定义更多变量的上下文中使用仅使用一些状态变量的状态操作。

{-# LANGUAGE TemplateHaskell #-}

import Control.Lens

import Control.Monad.Trans.State
import Control.Monad.IO.Class

data Galaxy = Galaxy {
    _solarSys :: SolarSystem
  , _otherStars :: String
  } deriving (Show)
data SolarSystem = SolarSystem {
    _sun :: Float
  , _planets :: Int
  } deriving (Show)

makeLenses ''SolarSystem
makeLenses ''Galaxy

main = (`runStateT`Galaxy (SolarSystem 2e+30 8) "") $ do
   zoom solarSys $ do
      sun -= 1e+23
      planets += 1
   liftIO . print =<< get
Galaxy {_solarSys = SolarSystem {_sun = 1.9999999e30, _planets = 9}, _otherStars = ""}

但是,如果我想在只定义了一些状态变量的环境中做一些事情,然后 运行 计算有一些额外的局部状态变量怎么办?喜欢

data Expedition = Expedition {
    _environment :: SolarSystem
  , _spacecraft :: Char
  } deriving (Show)
makeLenses ''Exploration

main = (`runStateT`Galaxy (SolarSystem 2e+30 8) "Milky") $ do
   zoom solarSys $ do
      spectralFilter environment (spacecraft ???~= '') $ do
         spacecraft .= '️'
         environment . planets -= 1
   liftIO . print =<< get

我怀疑 spacecraft 的初始化实际上需要一些其他光学器件,但我看不到哪个。

这个功能怎么样?

cram :: Monad m => Iso' s' (s,x) -> x -> StateT s' m r -> StateT s m r
cram someiso extra action =
    StateT (\small0 -> do let big0 = view (from someiso) (small0,extra)
                          (r,big) <- runStateT action big0
                          let (small,_) = view someiso big
                          pure (r,small))

"If you convince me that the expanded state is the small state plus extra stuff, and you give me some initial extra stuff, I can cram the expanded-state computation into the small-state one."

你必须写一个 Iso' Expedition (SolarSystem,Char)