Simulating interacting stateful objects in Haskell

淺唱寂寞╮ 提交于 2019-11-29 13:29:35

I think good practice would dictate that you should actually make a System data type to wrap your two machines, and then you might as well use 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)

Also, just to test this code, we can check at GHCi that it does what we want:

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

Advantages:

  • By using records and lens, there will be no refactoring if I decide to add extra fields. For example, say I want a third machine, then all I do is change System:

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

    But nothing else in my existing code will change - just now I will be able to use machine3 like I use machine1 and machine2.

  • By using lens, I can scale more easily to nested structures. Note that I just avoided the very simple addToState and getValue functions completely. Since a Lens is actually just a function, machine1.register is just regular function composition. For example, lets say I want a machine to now have an array of registers, then getting or setting particular registers is still simple. We just modify Machine and 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
    

    Note that this is equivalent to having a function like the following in Python:

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

    You can again test this out on 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)]}})
    

EDIT

The OP has specified that he would like to have a way of embedding a State Machine a into a State System a. lens, as always, has such a function if you go digging deep enough. zoom (and its sibling magnify) provide facilities for "zooming" out/in of State/Reader (it only makes sense to zoom out of State and magnify into Reader).

Then, if we want to implement doInteraction while keeping as black boxes getValue and addToState, we get

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`

Notice however that if we do this we really must commit to a particular state monad transformer (as opposed to the generic MonadState), since not all ways of storing state are going to be necessarily "zoomable" in this way. That said, RWST is another state monad transformer supported by zoom.

One option is to make your state transformations into pure functions operating on Machine values:

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

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

Then you can lift them into State as needed, writing State actions on multiple machines like so:

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

Where first (resp. second) is a function from Control.Arrow, used here with the type:

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

That is, it modifies the first element of a tuple.

Then runState doInteraction (Register 3, Register 5) produces (8, (Register 0, Register 8)) as expected.

(In general I think you could do this sort of “zooming in” on subvalues with lenses, but I’m not really familiar enough to offer an example.)

You could also use Gabriel Gonzales' Pipes library for the case you've illustrated. The tutorial for the library is one of the best pieces of Haskell documentation in existence.

Below illustrates a simple example (untested).

-- 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

You can then combine using the >-> operator. An example would be to run

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

Note that is possible, although a little more involved to have bi-directional pipes, which is gives you communications between both machines. Using some of the other pipes ecosystems, you can also have asynchronous pipes to model non-deterministic or parallel operation of machines.

I believe the same can be achieved with the conduit library, but I don't have much experience with it.

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!