Ответ 1

Я считаю, что хорошая практика диктует, что вы должны сделать тип данных System для переноса ваших двух машин, а затем вы можете использовать lens.

{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}

import Control.Lens
import Control.Monad.State.Lazy

-- With these records, it will be very easy to add extra machines or registers
-- without having to refactor any of the code that follows
data Machine = Machine { _register :: Int } deriving (Show)
data System = System { _machine1, _machine2 :: Machine } deriving (Show)

-- This is some TemplateHaskell magic that makes special `register`, `machine1`,
-- and `machine2` functions.
makeLenses ''Machine
makeLenses ''System


doInteraction :: MonadState System m => m Int
doInteraction = do
    a <- use (machine1.register)
    machine1.register -= a
    machine2.register += a
    use (machine2.register)

Кроме того, чтобы проверить этот код, мы можем проверить в GHCi, что он делает то, что мы хотим:

ghci> runState doInteraction (System (Machine 3) (Machine 4))
(7,System {_machine1 = Machine {_register = 0}, _machine2 = Machine {_register = 7}})

Преимущества:

• Используя записи и lens, рефакторинг не будет, если я решит добавить дополнительные поля. Например, скажем, я хочу третий компьютер, тогда все, что я делаю, это изменить System:

  data System = System
    { _machine1, _machine2, _machine3 :: Machine } deriving (Show)
  

  Но ничего другого в моем существующем коде не изменится - теперь я смогу использовать machine3, как я использую machine1 и machine2.

• Используя lens, я могу более легко масштабировать вложенные структуры. Обратите внимание, что я просто полностью избегал очень простых функций addToState и getValue. Поскольку lens на самом деле является просто функцией, machine1.register является просто регулярной композицией функции. Например, скажем, я хочу, чтобы машина теперь имела массив регистров, тогда получение или установка определенных регистров по-прежнему просты. Мы просто изменяем Machine и doInteraction:

  import Data.Array.Unboxed (UArray)
  data Machine = Machine { _registers :: UArray Int Int } deriving (Show)
  
  -- code snipped
  
  doInteraction2 :: MonadState System m => m Int
  doInteraction2 = do
      Just a <- preuse (machine1.registers.ix 2) -- get 3rd reg on machine1
      machine1.registers.ix 2 -= a               -- modify 3rd reg on machine1
      machine2.registers.ix 1 += a               -- modify 2nd reg on machine2
      Just b <- preuse (machine2.registers.ix 1) -- get 2nd reg on machine2
      return b
  

  Обратите внимание, что это эквивалентно наличию в Python функции, подобной следующей:

  def doInteraction2(machine1,machine2):
    a = machine1.registers[2]
    machine1.registers[2] -= a
    machine2.registers[1] += a
    b = machine2.registers[1]
    return b
  

  Вы можете снова проверить это на GHCi:

  ghci> import Data.Array.IArray (listArray)
  ghci> let regs1 = listArray (0,3) [0,0,6,0]
  ghci> let regs2 = listArray (0,3) [0,7,3,0]
  ghci> runState doInteraction (System (Machine regs1) (Machine regs2))
  (13,System {_machine1 = Machine {_registers = array (0,3) [(0,0),(1,0),(2,0),(3,0)]}, _machine2 = Machine {_registers = array (0,3) [(0,0),(1,13),(2,3),(3,0)]}})
  

ИЗМЕНИТЬ

ОП указал, что он хотел бы иметь способ вложения State Machine a в State System a. lens, как всегда, имеет такую ​​функцию, если вы будете копать достаточно глубоко. zoom (и его брат magnify) предоставляют средства для "масштабирования" out/in of State/Reader (имеет смысл уменьшить изображение State и увеличить до Reader).

Затем, если мы хотим реализовать doInteraction, сохраняя в качестве черных ящиков getValue и addToState, получаем

getValue :: State Machine Int
addToState :: Int -> State Machine ()

doInteraction3 :: State System Int
doInteraction3 = do
  a <- zoom machine1 getValue     -- call `getValue` with state `machine1`
  zoom machine1 (addToState (-a)) -- call `addToState (-a)` with state `machine1` 
  zoom machine2 (addToState a)    -- call `addToState a` with state `machine2`
  zoom machine2 getValue          -- call `getValue` with state `machine2`

Обратите внимание, что если мы это сделаем, мы действительно должны зафиксировать определенный государственный монадный трансформатор (в отличие от общего MonadState), так как не все способы сохранения состояния будут обязательно "масштабируемы" таким образом. Тем не менее, RWST является другим государственным монадным трансформатором, поддерживаемым zoom.

Ответ 2

Один из вариантов - превратить преобразования состояния в чистые функции, действующие на значения Machine:

getValue :: Machine -> Int
getValue (Register x) = x

addToState :: Int -> Machine -> Machine
addToState i (Register x) = Register (x + i)

Затем вы можете поднять их на State по мере необходимости, нажимая State действия на нескольких машинах следующим образом:

doInteraction :: State (Machine, Machine) Int
doInteraction = do
  a <- gets $ getValue . fst
  modify $ first $ addToState (-a)
  modify $ second $ addToState a
  gets $ getValue . snd

Где first (соответственно second) - это функция из Control.Arrow, используемая здесь с типом:

(a -> b) -> (a, c) -> (b, c)

То есть, он изменяет первый элемент кортежа.

Затем runState doInteraction (Register 3, Register 5) производит (8, (Register 0, Register 8)), как ожидалось.

(В общем, я думаю, что вы могли бы сделать такое "масштабирование" на субвациях с объективами, но Im действительно не достаточно знакомы, чтобы предложить пример.)

Ответ 3

Вы также можете использовать библиотеку Gabriel Gonzales 'Pipes для случая, который вы проиллюстрировали. Учебное пособие для библиотеки является одним из лучших образцов документации Haskell.

Ниже приведен простой пример (непроверенный).

-- machine 1 adds its input to current state
machine1 :: (MonadIO m) => Pipe i o m ()
machine1 = flip evalStateT 0 $ forever $ do
               -- gets pipe input
               a <- lift await
               -- get current local state
               s <- get
               -- <whatever>
               let r = a + s
               -- update state
               put r
               -- fire down pipeline
               yield r

-- machine 2 multiplies its input by current state
machine2 :: (MonadIO m) => Pipe i o m ()
machine2 = flip evalStateT 0 $ forever $ do
               -- gets pipe input
               a <- lift await
               -- get current local state
               s <- get
               -- <whatever>
               let r = a * s
               -- update state
               put r
               -- fire down pipeline
               yield r

Затем вы можете объединить с помощью операторa > → . Примером может служить запуск

run :: IO ()
run :: runEffect $ P.stdinLn >-> machine1 >-> machine2 >-> P.stdoutLn

Обратите внимание, что это возможно, хотя немного больше связано с двунаправленными трубами, что дает вам связь между обеими машинами. Используя некоторые другие экосистемы труб, вы также можете иметь асинхронные каналы для моделирования недетерминированной или параллельной работы машин.

Я считаю, что то же самое может быть достигнуто с помощью библиотеки каналов, но у меня нет большого опыта в этом.