Haskell version of yin-yang puzzle : Kind incompatibility error

Question

I want to implement the yin-yang puzzle in Haskell. Here is my attempt (unsucceful):

-- The data type in use is recursive, so we must have a newtype defined
newtype Cl m = Cl { goOn :: MonadCont m => Cl m -> m (Cl m) }

yinyang :: (MonadIO m, MonadCont m) => m (Cl m)
yinyang = do
    yin <-  (callCC $ \k -> return (Cl k)) >>= (\c -> liftIO (putStr "@") >> goOn c)
    yang <- (callCC $ \k -> return (Cl k)) >>= (\c -> liftIO (putStr "*") >> goOn c)
    goOn yin yang

When look at the types, obviously callCC $ \k -> return (Cl k) gives a m (Cl m), so yin is of type Cl m. yang is the same thing. So I expect goOn yin yang gives the final type m (Cl m).

This implementation looks good, but the problem is it does not compile! here is the error I got:

Couldn't match kind `*' against `* -> *'
Kind incompatibility when matching types:
  m0 :: * -> *
  Cl :: (* -> *) -> *
In the first argument of `goOn', namely `yin'
In a stmt of a 'do' block: goOn yin yang

Any idea to fix this?

UPDATE

Although I found the answer by myself, I still don't understand what that error message means. Can any one explain to me? What I know already is, in the problematic version, goOn c returns something like Cl m -> m (Cl m), not the expected m (Cl m). But that is not what you can get from the error message.

Answer 1

There is a stupid error in the code. Here is the correct implementation

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <-  (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    goOn yin yang

It is very easy to run this.

main :: IO ()
main = runContT yinyang $ void.return

or even

main :: IO ()
main = runContT yinyang undefined

Although the later looks scary, but it is safe because the continuation will never have the chance to be evaluated. (The overall expression, will be evaluated to value _|_ because it never stops)

It outputs the expected result

@*@**@***...

Explained

The original attempt is to directly translate the Scheme version

(let* (
 (yin
    ((lambda (cc) (display #\@) cc) (call-with-current-continuation (lambda (c) c))))
 (yang
    ((lambda (cc) (display #\*) cc) (call-with-current-continuation (lambda (c) c)))))
(yin yang))

into Haskell. For a typed language, the key to make the above type check is to have a type t that isomorphic to t -> t. In Haskell this is done by using newtype keyword. Also, to have side effects we need IO, but it does not support callCC. To support the later we need MonadCont. So to work with both we need MonadIO and MonadCont. Also, the newtype must know which Monad it is working on, so it shall carry the Monad as its type parameter. So now we write

newtype CFix m = ...

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)

Since we are wroking on a Monad it is convenient to use do notation. So let* assignments shall be translated to yin <- and yang <-. In a MonadIO to display we use liftIO.putStr. The call-with-current-continuation translate to callCC but obviously we cannot translate to id or the like. Let's leave this for a moment.

My mistake is naively translate the combination operator of the display block and the callCC block to >>=. In Scheme or other strict language, the parameter is to be evaluated before the expression, so the callCC block shall execute before the display block. As a result, we shall use =<< instead of >>=. The code is now looks

newtype CFix m = ...

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <- (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ ...)
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ ...)
    ...

Now it is time to make it type check and see what shall we put in the ...s. callCCs signature is

MonadCont m => ((a -> m b) -> m a) -> m a

so its parameter have type

MonadCont m => (a -> m b) -> m a

for some type a and b. By looking at the code written so far, we easily conclude that yin and yang shall have the same type of callCCs return value m a. However, the original schema version uses yin and yang as functions so they have type p -> r. So here is where we need recursive types and newtype.

To obtain a m a the straight forward method is use return, and we need something have type a. Let's suppose this is came from the type constructor that we are going to define. Now to supply parameter for callCC we need to construct an a from (a -> m b). So this is what the constructor would looks like. But what is b? An easy choice is to use the same a. so we have the definition of CFix:

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

and an implementation of the callCC's parameter

\k -> return (CFix k)

we use CFix constructor to construct a CFix from the given parameter, and use return to wrap it to the desired type.

Now, how do we use yin (of type m (CFix m)) as a function? The type destructor goOn allow us to extract the inner function, so we have the definition for the last ....

newtype CFix m = CFix { goOn :: CFix m -> m (CFix m) }

yinyang :: (MonadIO m, MonadCont m) => m (CFix m)
yinyang = do
    yin <-  (\c -> liftIO (putStr "@") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    yang <- (\c -> liftIO (putStr "*") >> return c) =<< (callCC $ \k -> return (CFix k)) 
    goOn yin yang

This is final version of the program.