1-intro.hs

{-# Language Arrows #-}

import Control.Arrow
import Control.Monad (forever)
import Control.Monad.Trans (lift)
import qualified Control.Arrow.Machine as P
import qualified Data.Machine as Mc
import Data.Machine ((<~))


askP = P.constructT P.kleisli0 $
  do
    lift $ putStrLn "情報を入力して下さい"
    forever $
      do
        lbl <- P.await
        lift $ putStr (lbl ++ ": ")

        ct <- lift $ getLine

        P.yield (lbl, ct)

registerP =
  do
    r <- runKleisli (P.run askP) ["Zip code", "Address", "Name"]
    print r


askMc = Mc.construct $
  do
    lift $ putStrLn "情報を入力して下さい"
    forever $
      do
        lbl <- Mc.await
        lift $ putStr (lbl ++ ": ")

        ct <- lift $ getLine

        Mc.yield (lbl, ct)

registerMc =
  do
    r <- Mc.runT $ askMc <~ Mc.source ["Zip code", "Address", "Name"]
    print r
    

-- Print with label.
pWL :: Show a => String -> a -> IO ()
pWL l x = putStrLn $ l ++ show x

doProcess = P.repeatedly $
  do
    x <- P.await
    P.yield (x+1)
    P.yield (x+2)

body = proc evx ->
  do
    P.anytime (P.kleisli $ pWL "input ") -< evx
    evy <- doProcess -< evx
    P.anytime (P.kleisli $ pWL "output ") -< evy
    returnA -< evy

main =
  do
    result <- runKleisli (P.run body) [1, 10, 100]
    pWL "final result " result