[Haskell-beginners] Monadic functions definitions for free monadic DSL

[Sumit Raja]

Hello,

I am trying to get my head around free monads by developing a simple
network abstraction DSL.
I've made good progress before adding TCP/IP semantics of accepting
connections. I'm now stuck with the creation of monadic functions.

I've defined the following:

    data NetworkActivity chan next = Accept chan next (chan -> next) |
            Send chan ByteString (Bool -> next) |
            Recv chan (ByteString -> next) |
            Close chan (() -> next)

    clse :: a -> Free (NetworkActivity a) Text
    clse chan = liftF (Close chan (const "Quit"))

    chatterServer :: a -> Free (NetworkActivity a) Text
    chatterServer svrchan = Free $ Accept svrchan (chatterServer
svrchan) chatterLoop

    chatterLoop :: a -> Free (NetworkActivity a) Text
    chatterLoop chan = Free $ Recv chan $ \bs -> case BS.uncons bs of
      Nothing -> clse chan
      Just x -> if bs == "Bye" then
          Free $ Close chan (\_ -> Pure "Quit")
        else
          Free (Send chan bs (\_ -> chatterLoop chan))

This works fine with the interpretTCP interpreter below accepting
multiple connections:

    interpretTCP :: Free (NetworkActivity TCPSocket) r -> IO r
    interpretTCP prg = case prg of
      Free (Accept serverSock svrLoop acceptProc) -> bracket (return serverSock)
        (\s-> interpretTCP (clse s))
        (\s-> do
          (ss, sa) <- accept s
          forkIO $ do
            _ <- interpretTCP (acceptProc ss)
            return ()
          interpretTCP svrLoop
        )
      Free (Recv sock g) -> do
        bs <- receive sock 4096 mempty
        putStrLn (decodeUtf8 bs)
        interpretTCP (g bs)
      Free (Close sock g) -> do
        close sock
        putStrLn ("Server bye!" :: Text)
        interpretTCP (g ())
      Pure r -> return r
      Free (Send sock pl g) -> do
        sent <- send sock pl mempty
        interpretTCP (g (sent > 0))

Where I'm stuck is defining the monadic version of accept and I'm
beginning to think my original
data type defined above may be wrong. As an initial step I've defined
the following:

    recv :: a -> Free (NetworkActivity a) ByteString
    recv chan = liftF (Recv chan identity)

    sendit :: a -> ByteString -> Free (NetworkActivity a) Bool
    sendit chan pl = liftF (Send chan pl identity)

    mchatterServer :: a -> Free (NetworkActivity a) Text
    mchatterServer chan = Free $ Accept chan (mchatterServer chan)
                                                                   (\s
-> return (identity s) >>= mchatterLoop)

mchatterServer works as is, the interpreter accepts multiple
connections. Similarly all good with recv and sendit.
I am struggling with converting the Accept in mchatterServer into a
function to use in the do syntax. The signature I think I should be
using is

    acc :: a -> NetworkActivity a Text -> Free (NetworkActivity a)
(NetworkActivity a Text)

What I can't figure out is why it can't follow the pattern of recv and
sendit above:

    acc chan next = liftF $ Accept chan next identity

Which results in error on identity (using Protolude):

    Expected type: a -> NetworkActivity a Text
    Actual type: NetworkActivity a Text -> NetworkActivity a Text

I can't really see how to get the types to line up and have now can't
see through the type fog. What am I missing in my reasoning about the
types?

Help much appreciated!

Thanks

Sumit