I think I'm starting to get the "way of arrows".

My implementation was incorrect. I've seen it with the hand made test listed below [1].

The output of "first arrA" and "first arrB" should be joined together and form a new stream with the length of the shortest output of both ("arrA *** arrB"), and this wasn't happening.

I've found package "streamproc" at Hackage and that gave me some insights.

Yet I think "streamproc" is also wrong, as it does not buffer the second stream.

You can check it at line 58 of SP.hs [3] that it ignores the first element of the pair.

But I didn't write a test to check what is the implication of this, I'll try to do this as a next step into understanding arrows.

That exercise really helped me!

My new implementation, wich I think is correct now, is listed below [2].

Thanks!

Thiago

[1]:

inputA :: [String]

inputA = ["a", "b", "hello", "c", "d", "e", "hello", "f", "g", "e", "x"]

arrA :: SP String String

arrA = Get (\a -> if a == "hello" then (Put a (Put "world" arrA))

else (Put "unknown" arrA))

arrB :: SP String String

arrB = Get (\a -> if a == "my" then (Get (\a -> if a == "name" then (Get (\a -> if a == "is" then Get (\a -> Put ("name: " ++ a) arrB)

else arrB))

else arrB)

inputB :: [String]

inputB = ["a", "b", "my", "name", "is", "thiago", "and", "I", "am", "so", "cool"]

inputAB :: [(String, String)]

inputAB = zip inputA inputB

main :: IO ()

main = let actualOutputB = runSP arrB inputB

actualOutputB1 = runSP (first arrB) (zip inputB (repeat "a"))

actualOutputA = runSP arrA inputA

actualOutputA1 = runSP (first arrA) (zip inputA (repeat "a"))

actualOutputAB = runSP (arrA *** arrB) inputAB

in do putStrLn $ "inputAB: " ++ show inputAB

putStrLn $ "outputA: " ++ show actualOutputA

putStrLn $ "outputA1: " ++ show actualOutputA1

putStrLn $ "outputB: " ++ show actualOutputB

putStrLn $ "outputB1: " ++ show actualOutputB1

putStrLn $ "outputAB: " ++ show actualOutputAB

[2]:

module SP where

import Prelude hiding (id, (.))

import Control.Category

import Control.Arrow

import Test.QuickCheck

data SP a b = Put b (SP a b) | Get (a -> SP a b)

runSP :: SP a b -> [a] -> [b]

runSP (Put b s) as = b:runSP s as

runSP (Get k) (a:as) = runSP (k a) as

runSP (Get k) [] = []

compose :: SP b c -> SP a b -> SP a c

compose (Put a s) g = Put a (compose s g)

compose (Get k) (Put a s) = compose (k a) s

compose f (Get k) = Get (\a -> compose f (k a))

instance Category SP where

id = arr id

(.) = compose

instance Arrow SP where

arr f = Get (\a -> Put (f a) (arr f))

first = queued empty empty

queued :: Queue a -> Queue c -> SP a b -> SP (a, c) (b, c)

queued qa qc (Put a s) = case pop qc of Nothing -> Get (\(a', c) -> Put (a, c) (queued (push a' qa) qc s))

Just (c, qc') -> Put (a, c) (queued qa qc' s)

queued qa qc (Get k) = case pop qa of Nothing -> Get (\(a, c) -> queued qa (push c qc) (k a))

Just (a, qa') -> queued qa' qc (k a)

data Queue a = Queue [a]

empty :: Queue a

empty = Queue []

push :: a -> Queue a -> Queue a

push a (Queue as) = Queue (a:as)

pop :: Queue a -> Maybe (a, Queue a)

pop (Queue []) = Nothing

pop (Queue (a:as)) = Just (a, Queue as)

delayed :: (a, c) -> SP a b -> SP (a, c) (b, c)

delayed (a, c) (Put b s) = Put (b, c) (delayed (a, c) s)

delayed (a, c) (Get k) = firstWithValue (k a) c

firstWithValue :: SP a b -> c -> SP (a, c) (b, c)

firstWithValue (Put a s) c = Put (a, c) (firstWithValue s c)

firstWithValue (Get k) _ = Get (\(a, c) -> firstWithValue (k a) c)

input :: [(String, String)]

input = [("a1", "a2"), ("b1", "b2"), ("c1", "c2"), ("d1", "d2")]

myArrow :: SP (String, String) (String, String)

myArrow = (delay "db1" >>> delay "da1") *** (delay "db2" >>> delay "da2")

delay :: a -> SP a a

delay b = Put b (arr id)