ArrowLoop

ALoop.hs

{-# LANGUAGE Arrows #-}
module ALoop where

import Control.Arrow ( returnA, ArrowLoop(loop) )


-- loop f b = let (c,d) = f (b,d) in c
fact :: Int -> Int
fact = loop $ \(x, f) -> (f x, \n -> if n == 0 then 1 else n * f (n - 1))

--
fact2 :: (->) Int Int
fact2 = proc x ->
  do
    rec
      v <- returnA -< f x
      f <- returnA -< (\n -> if n == 0 then 1 else n * f (n - 1))
    returnA -< v

Kleisli.hs

{-# LANGUAGE Arrows #-}
module Kleisli where

import Control.Applicative       ( empty )
import Control.Arrow             ( returnA, Kleisli(..) )
import Control.Monad.IO.Class    ( liftIO )
import Control.Monad.Trans.Maybe ( MaybeT(..) )

mainLoop :: Kleisli (MaybeT IO) ([String], Int) Int
mainLoop =
  proc (strs, n) ->
    if null strs then returnA -< n
    else do
      -- _  <- Kleisli (\_   -> putStrLn "mainLoop start.") -< strs
      _  <- Kleisli (\str -> liftIO $ putStrLn $ "go " ++ str)    -< head strs
      _  <- Kleisli (const empty)    -< ()
      n2 <- mainLoop                                     -< (tail strs, n + 1)
      returnA                                            -< n2

main :: IO (Maybe Int)
main = runMaybeT $ runKleisli mainLoop (["zero", "first", "second", "third"], 0)

{-
Prelude> :l Kleisli
[1 of 1] Compiling Kleisli          ( Kleisli.hs, interpreted )
Ok, one module loaded.
*Kleisli> main
go zero
Nothing
*Kleisli> 
-}

Kleisli2.hs

{-# LANGUAGE Arrows #-}
module Kleisli2 where

import Control.Applicative       ( empty )
import Control.Arrow             ( returnA, Kleisli(..) )
import Control.Monad.IO.Class    ( liftIO )
import Control.Monad.Trans.Class ( lift )
import Control.Monad.Trans.Maybe ( MaybeT(..) )
import Control.Monad.Trans.State ( StateT(runStateT), put )

sub :: Kleisli (MaybeT (StateT Bool IO)) ([String], Int) Int
sub =
  proc (strs, n) ->
    if null strs then returnA -< n
    else do
      -- _  <- Kleisli (\_   -> putStrLn "mainLoop start.") -< strs
      _  <- Kleisli (\str -> liftIO $ putStrLn $ "Maybe1 " ++ str)    -< head strs
      _  <- Kleisli (const $ lift $ put False)    -< ()
      _  <- Kleisli (const empty)    -< ()
      _  <- Kleisli (\str -> liftIO $ putStrLn $ "Maybe2 " ++ str)    -< head strs
      returnA                                            -< n

mainLoop :: Kleisli (StateT Bool IO) ([String], Int) Int
mainLoop =
  proc (strs, n) ->
    if null strs then returnA -< n
    else do
      -- _  <- Kleisli (\_   -> putStrLn "mainLoop start.") -< strs
      _  <- Kleisli (\str -> liftIO $ putStrLn $ "go " ++ str)    -< head strs
      _  <- Kleisli (\(strs, n) -> runMaybeT $ runKleisli sub (strs, n)  ) -< (strs, n)
      n2 <- mainLoop                                     -< (tail strs, n + 1)
      returnA                                            -< n2

hoge :: StateT Bool IO Int
hoge = runKleisli mainLoop (["zero", "first", "second", "third"], 0)

main :: IO (Int, Bool)
main = runStateT hoge True


{-
*Kleisli2> :l Kleisli2
[1 of 1] Compiling Kleisli2         ( Kleisli2.hs, interpreted )
Ok, one module loaded.
*Kleisli2> main
go zero
Maybe1 zero
go first
Maybe1 first
go second
Maybe1 second
go third
Maybe1 third
(4,False)
*Kleisli2> 
-}