Kleisli Arrow in Netwire 5?

createRGBSurfaceEndian :: [SurfaceFlag] -> Int -> Int -> Int -> IO Surface fillRect :: Surface -> Maybe Rect -> Pixel -> IO Bool blitSurface :: Surface -> Maybe Rect -> Surface -> Maybe Rect -> IO Bool flip :: Surface -> IO ()

Update 1

This code type checks, but now I am trying to interface it with SDL for testing

wTestOutput :: (Monoid e) => Wire s e IO () SDL.Surface wTestOutput = mkGen_ $ \a -> (makeSurf a >>= return . Right) where makeSurf :: a -> IO SDL.Surface makeSurf _ = do s <- SDL.createRGBSurfaceEndian [SDL.SWSurface] 800 600 32 SDL.fillRect s (Just testRect) (SDL.Pixel 0xFF000000) return s testRect = SDL.Rect 100 100 0 0

Now, after playing around with Arrows, I will answer my own question using the function putStrLn. It has type String -> IO (), which is a -> m b, so the method should generalize to all Kleisli wires. I also illustrate how to drive the wire, and the result is amazingly simple.

The entire code is written in Literate Haskell, so just copy it and run.

First, there are some imports for the Netwire 5 library

import Control.Wire
import Control.Arrow
import Prelude hiding ((.), id)

Now, this is the core of making a Kleisli Wire. Assume you have a function with type a -> m b that needs to be lifted into a wire. Now, notice that mkGen_ has type mkGen_ :: Monad m => (a -> m (Either e b)) -> Wire s e m a b

So, to make a wire out of a -> m b, we first need to get a function with type a -> m (Either () b). Notice that Left inhibits the wire, while Right activates it, so the inner part is Either () b instead of Either b (). Actually, if you try the latter, an obscure compile error will tell you get this in the wrong way.

To get a -> m (Either () b), first consider how to get m (Either () b) from m b, we extract the value from the monad (m b), lift it to Right, then return to the monad m. In short: mB >>= return . Right. Since we don't have the value "mB" here, we make a lambda expression to get a -> m (Either () b):

liftToEither :: (Monad m) => (a -> m b) -> (a -> m (Either () b))
liftToEither f = \a -> (f a >>= return . Right)

Now, we can make a Kleisli wire:

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> (f a >>= return . Right)

So, let's try the canonical "hello, world" wire!

helloWire :: Wire s () IO () ()
helloWire = pure "hello, world" >>> mkKleisli putStrLn

Now comes the main function to illustrate how to drive the wire. Note that comparing to the source of testWire in the Control.Wire.Run from the Netwire library, there is no use of liftIO: the outer program knows nothing about how the wires work internally. It merely steps the wires ignoring what is in it. Maybe this Just means better composition than using Nothing about Kleisli Wires? (No pun intended!)

main = go clockSession_ helloWire
    where
      go s w = do
        (ds, s') <- stepSession s
        (mx, w') <- stepWire w ds (Right ())
        go s' w'

Now here comes the code. Unfortunately StackOverflow does not work quite well with Literate Haskell...

{-# LANGUAGE Arrows #-}

module Main where

import Control.Wire
import Control.Monad
import Control.Arrow
import Prelude hiding ((.), id)

mkKleisli :: (Monad m, Monoid e) => (a -> m b) -> Wire s e m a b
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

helloWire :: Wire s () IO () ()
helloWire = pure "hello, world" >>> mkKleisli putStrLn

main = go clockSession_ helloWire
    where
      go s w = do
        (ds, s') <- stepSession s
        (mx, w') <- stepWire w ds (Right ())
        go s' w'

Update

Thanks to Cubic's inspiration. liftToEither can actually be written in, you guess it, liftM:

liftToEither f = \a -> liftM Right $ f a
mkKleisli f = mkGen_ $ \a -> liftM Right $ f a

Update 1

Recommended topics

Hot tags