bitterharvest’s diary

A Bitter Harvestは小説の題名。作者は豪州のPeter Yeldham。苦闘の末に勝ちえた偏見からの解放は命との引換になったという悲しい物語

乱舞するメッセージ(4)

1.会計システムを完成させる

様々な準備が整ったので、会計システムをいよいよ完成させることにする。これまでのシステムの欠点は、複雑なメッセージの送受ができないことと、担当者ごとにメッセージを送るための通信路を設けていることである。会社の規模が大きくなった時、伝票にはもう少し豊富な内容を記入したくなるであろうし、担当者が増えたときにそのたびごとに通信路を設けるのも煩わしい。
そこで、送信側が沢山あり受信側が一つである通信路を設け、送信側は担当者が伝票を送るために使い、受信側は会計担当者が伝票を受け取るために使うこととする。このため、送信側には担当者ごとに送信のための口があるものとする。
f:id:bitterharvest:20140731064825p:plain
このような通信路は、送信側が複数、あるいは受信側が複数の通信路は複数のものが共有して利用することになるので、CHPではShared Channelと呼ばれている。とくに、送信側が複数で、受信側が1である通信路はanyToOneChanellと呼ばれている。
この通信路においては、送り手はメッセージを送ろうとするとき、最初に通信路を確保しておかないといけない。これは、claimという関数を用いて行う。通信路が確保できたときは通常通り、通信路にメッセージを書き込む。
claimという関数は、第一引数にチャネルの終端を、第二引数に書込みの関数writeChannelを、第三引数はメッセージとなる。しかし、writeChannelは第一引数をチャネルの終端、第二引数をメッセージとしているので、flipでwriteChanellの引数の順番を入れ替える。これにより、claimとeriteChannelが正しく機能するようにしている。
メッセージは、将来のデータベースのことも考えて、データベースのレコードと同じ形式のものを用意し、その型をAccountとする。とりあえず、フィールドは送信者とトランザクションの対象となった商品の個数ということにする。フィールドを増やすことで、より多くの情報をが送信できるようになる。

2.プログラム

出来上がったプログラムは以下のとおりである。

import Control.Concurrent.CHP
import qualified Control.Concurrent.CHP.Common as CHP
import Control.Concurrent.CHP.Console
import Control.Monad
import Control.Monad.Trans
import System.Random

main :: IO ()
main = do runCHP_(consoleProcess concurrentAgents)

data Message = Message {sender :: [Char], number :: Int} 

salesPerson :: Shared Chanout Message -> CHP ()
salesPerson chanout = forever $ 
  do writeC
     randomDelay
  where
     writeC = liftIO_CHP (getStdRandom (randomR (1,50))) >>= \x -> claim chanout (flip writeChannel Message {sender = "salesperson", number = x}) 
     randomDelay = liftIO_CHP (getStdRandom (randomR (2500000,5000000))) >>= waitFor

data Account = Account {cash :: Int, sales :: Int, purchasing :: Int, stock :: Int, goods :: Int}
initBook = Account {cash = 100000, sales = 0, purchasing = 0, stock = 100000, goods = 0}

buyer :: Shared Chanout Message -> CHP ()
buyer chanout = forever $ 
  do writeC
     randomDelay
  where
     writeC = liftIO_CHP (getStdRandom (randomR (51,100))) >>= \x -> claim chanout (flip writeChannel Message {sender = "buyer", number = x})
     randomDelay = liftIO_CHP (getStdRandom (randomR (5000000,10000000))) >>= waitFor

acountant :: ConsoleChans -> Chanin Message -> Account -> CHP ()
acountant chans chanin book =
  printBook book >> 
    readChannel chanin >>= \y -> outProcess book y
  where
    printBook :: Account -> CHP()
    printBook x = do printString ("Cash: " ++ show (cash x)  ++ "\n")
                     printString ("Sales: " ++ show (sales x)  ++ "\n")
                     printString ("Purchasing: " ++ show (purchasing x)  ++ "\n")
                     printString ("Stock: " ++ show (stock x)  ++ "\n")
                     printString ("Goods: " ++ show (goods x)  ++ "\n")
                     printString "\n"
    outProcess :: Account -> Message -> CHP ()
    outProcess x y
      | sender y == "salesperson" = 
          printString ("New Sales:" ++ show (number y) ++ "\n") >> 
            acountant chans chanin Account {cash = cash x + 100 * (number y), sales = sales x + 100 * (number y), purchasing = purchasing x, stock = stock x, goods = goods x - (number y)}
      | sender y == "buyer" = printString ("New Purchasing:" ++ show (number y) ++ "\n") >> 
            acountant chans chanin Account {cash = cash x - 80 * (number y) , sales = sales x, purchasing = purchasing x + 80 * (number y), stock = stock x, goods = goods x + (number y)}
      | otherwise = mapM_(writeChannel (cStderr chans)) ("Unknown person sends a message \n")
    printString = mapM_(writeChannel (cStdout chans))

concurrentAgents :: ConsoleChans -> CHP ()
concurrentAgents
  chans = do shared <- anyToOneChannel
             runParallel_
               [ salesPerson (writer shared)
               , buyer (writer shared)
               , acountant chans (reader shared) initBook]

3.問題

財務諸表、棚卸資産を表示できるようにしなさい。