Dear Sumit,

You are right that there's something's fishy about the free monadic modeling of accept.

The following parallel construction will prove instructive:

The native effect:

   send :: chan -> ByteString -> IO Bool

is modeled in the free monad by the constructor for the base functor

   Send :: chan -> ByteString -> (Bool -> next) -> NetworkActivity chan next
   
which is the data wrapping used in the value level

   sendit :: chan -> ByteString -> Free (NetworkActivity chan) Bool
   sendit chan buf = liftF (Send chan buf identity)
   
Analogously, the native

   accept :: chan -> IO chan

is modeled by

   Accept :: chan -> (chan -> next) -> NetworkActivity chan next

used in

   acc :: chan -> Free (NetworkActivity chan) chan
   acc chan = liftF (Accept chan identity)

Except that you used a different constructor for the base functor. Not

   Accept :: chan -> (chan -> next) -> NetworkActivity chan next

but

   Accept :: chan -> next -> (chan -> next) -> NetworkActivity chan next

which is equivalent to

   Accept :: chan -> (Maybe chan -> next) -> NetworkActivity chan next
   
The new free monadic term that substitutes for the native accept is the same like before

   acc chan = liftF (Accept chan identity)

only with a different type

   acc :: chan -> Free (NetworkActivity chan) (Maybe chan)

modeling a native

   accept :: chan -> IO (Maybe chan)

Given a native API, its free monad encoding is entirely boilerplate. I wrote about the boilerplate process here (skip the sections that don't concern you):

http://www.atamo.com/articles/free-monads-wont-detox-your-colon/

Best, Kim-Ee

-- Kim-Ee

On Fri, Oct 14, 2016 at 6:44 AM, Sumit Raja <sumitraja@gmail.com> wrote:
> I would really like to help you, but without your imports, packages, etc,
> it is really hard to interpret your program.  Like where does decodeUtf8
> come from, or receive, or TCPSocket?  If they are functions you wrote, I
> don't need their code, the types would be sufficient.
>
Imports are:

import Protolude
import Control.Monad.Free
import System.Socket
import System.Socket.Family.Inet
import System.Socket.Type.Stream
import System.Socket.Protocol.TCP
import Control.Exception ( bracket, catch )
import Data.ByteString as BS (uncons)

    decodeUtf8 :: ByteString -> Text
    encodeUtf8 :: Text -> ByteString

I'm using the socket library for the actual networking
(https://hackage.haskell.org/package/socket-0.6.0.1)

    type TCPSocket = Socket Inet Stream TCP
    receive :: Socket f t p -> Int -> MessageFlags -> IO ByteString Source
    send :: Socket f t p -> ByteString -> MessageFlags -> IO Int
    accept :: (Family f, Storable (SocketAddress f)) => Socket f t p
-> IO (Socket f t p, SocketAddress f)

If it helps the full source is at
https://bitbucket.org/sumitraja/network-free/src/a4fcbc74c9e178e81d8b10b60d912b32c542b661/src/Lib.hs.

Looking forward to your assistance.

Thanks

Sumit
_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners