Is it possible to rewrite this example using the ghc arrow notation?

Question

I invented some kind of “arrow of state”:

import Prelude hiding (id, (.))
import Control.Monad.State
import Control.Arrow
import Control.Category

data StateA s a b = StateA {runStateA :: s -> a -> (b, s)}

instance Category (StateA s) where
  id = StateA (\s a -> (a, s))

  (StateA f) . (StateA g) = StateA $ \s x -> let (b, s') = g s x in f s' b

instance Arrow (StateA s) where
  arr f = StateA $ \s a -> (f a, s)

  first (StateA f) = StateA $ \s (b, d) -> let (c, s') = f s b in ((c, d), s)

put' :: s -> StateA s b ()
put' s = StateA $ \_ _ -> ((), s)

get' :: StateA s b s
get' = StateA $ \s _ -> (s, s)

merge :: (s -> s -> s) -> StateA s a b -> StateA s a c -> StateA s a (b, c)
merge f (StateA a) (StateA b) = StateA $ \s x ->
  let (ra, sa) = a s x
      (rb, sb) = b s x 
  in ((ra, rb), f sa sb)


 test = (flip runStateA) s bar 
   where bar = ((put' 7) >>> get') &&& get'

This definition seems to work the way I wanted: at least test 3 5 gives

((7,3), 3)

Note that this behavior is intentionally different from the regular state monad enclosed in the arrow, like this:

liftKC = Kleisli . const

putM :: a -> Kleisli (State a) b ()
putM = liftKC . put

getM :: Kleisli (State a) b a
getM = liftKC get

foo :: (Num a) => Kleisli (State a) a (a, a)
foo = (putM 7 >>> getM) &&& getM

testKleisli a b = (flip runState) a $
                  (flip runKleisli) b foo

how testKleisli 3 5 returns

((7, 7), 7).

The fact is that you can manage the state in some "parallel branches of computing" separately, and then somehow merge it.

I am not familiar with the arrow designation, but it is inconvenient here: it seems that desugars creates a new "branch" for each calculation. Is it possible to rewrite the "bar" function (from the where clause) of a test using the arrow notation?

Answer 1

bar = ((put' 7) >>> get') &&& get'

, .

do, proc , , >>=, .

, , x , :

bar' = proc x -> do
        wasput <- put' 7 >>> get' -< x
        justgot <- get' -< x
        returnA -< (wasput,justgot)

, ,

bar'' = proc x -> do
        wasput <- get' <<< put' 7 -< x
        justgot <- get' -< x
        returnA -< (wasput,justgot)

test :

test s b = (flip runStateA) s b

,

ghci> test bar 3 5
((7,3),3)
ghci> test bar' 3 5
((7,3),3)
ghci> test bar'' 3 5
((7,3),3)

>>>?

, (>>>):

bar''' = proc x -> do
        put7 <- put' 7 -< x
        wasput <- get' -< put7
        justgot <- get' -< x
        returnA -< (wasput,justgot)

oops, no:

ghci> test bar''' 3 5
((3,3),3)

, , put' 7 get', >>> <<<.

, . ...

, , , , , , :

first (f >>> g) = first f >>> first g

dup :: Arrow a => a t (t, t)
dup = arr (\x -> (x,x))    

ghci> test (dup >>> (first (put' 7    >>>     get'))) 1 3
((7,3),1)
ghci> test (dup >>> (first (put' 7) >>> first get')) 1 3
((1,3),1)

, put' 7 first, !

:

, , , , .

Unfortunately, whist is very interesting and extremely distracting, this is not a real Arrow.