Stitching functions together using the ReaderT and StateT Monads

Question

I am beginning with Haskell and I need help stitching functions together using the ReaderT and StateT Monads.

Ideally, if that is at all possible, all functions would have the same signature (which I understand those Monads should help with) and would be able to read the environment and alter the state.

The piece of code below is supposed to simply open a Socket in openClientSocket using an initial environment initialNetwork, inject the socket and address in the chain, then call the "next" function func which is passed as a parameter (function sendMsg in this case).

However I am facing multiple issues:

• a) how should I make the call to the passed func in openClientConnection ?

• b) the HNT Monad is composed (?) with other Monads. How do I read and manipulate the inner Monads ?

Could someone then please help me fix this code and if possible, derive/explain the "ideal" pattern to achieve the goal described in the subject.

Many Thanks

b.

import Control.Monad.Reader
import Control.Monad.State

import Network.Socket
import Network.Multicast

_MULTICAST_IP_ADDR_ :: HostName
_MULTICAST_IP_ADDR_ = "224.0.0.99"

_MULTICAST_PORT_ :: PortNumber
_MULTICAST_PORT_ = 9999

data NetworkEnv = NetworkEnv {
    getMulticastIP :: HostName,
    getMulticastPort :: PortNumber
} deriving (Show)
type NetworkEnvT = ReaderT NetworkEnv

data ClientSocket = ClientSocket { 
    getClientSocket :: Socket, 
    getAddress:: SockAddr 
} deriving (Show)
type ClientSocketT = StateT ClientSocket

type HNT m = ClientSocketT (NetworkEnvT m)

initialNetwork :: NetworkEnv
initialNetwork = NetworkEnv { getMulticastIP = _MULTICAST_IP_ADDR_, getMulticastPort = _MULTICAST_PORT_ } 


openClientConnection :: HNT m a -> m a 
openClientConnection func = do
    env <- ask
    (sock, addr) <- liftIO $ multicastSender (getMulticastIP env) (getMulticastPort env)
    put $ ClientSocket sock addr
    func   -- <== How do I call func (sendMsg) here ??


sendMsg :: String -> HNT IO ()
sendMsg msg = do
    NetworkEnv ip port <- ask
    ClientSocket sock addr <- get
    _ <- liftIO $ sendTo sock msg addr
    liftIO $ print "done"

doRun = runReaderT ( openClientConnection . (sendMsg "Hello") ) initialNetwork 

Answer 1

I managed the solution below; I am sure it can be improved and Error handling is not fully in place but it does obey the contract.

From all my readings, what really, really, helped me is this paper from Martin Grabmüller and realizing that the program runs inside a Monad: it is not a parameter to a function call (too many years of OO programming and injection calls)

import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Control.Monad.Error

import Network.Socket
import Network.Multicast
 
_MULTICAST_IP_ADDR_ :: HostName
_MULTICAST_IP_ADDR_ = "224.0.0.99"

_MULTICAST_PORT_ :: PortNumber
_MULTICAST_PORT_ = 9999
 
data NetworkEnv = NetworkEnv {
    getMulticastIP :: HostName,
    getMulticastPort :: PortNumber
} deriving (Show)


data ClientSocket = ClientSocket { 
    getClientSocket :: Socket, 
    getAddress:: SockAddr 
} deriving (Show)


type HNError = String
type LogMessages = [String]

type HNT a = ReaderT NetworkEnv (ErrorT HNError (WriterT LogMessages (StateT ClientSocket IO))) a

runHNT :: ClientSocket -> NetworkEnv -> HNT a -> IO( (Either HNError a, LogMessages), ClientSocket) 
runHNT st env app = runStateT (runWriterT ( runErrorT (runReaderT app env) )) st

initialNetwork :: NetworkEnv
initialNetwork = NetworkEnv { getMulticastIP = _MULTICAST_IP_ADDR_, getMulticastPort = _MULTICAST_PORT_ }

initialState :: ClientSocket
initialState = ClientSocket undefined undefined

openClientConnection :: HNT ()
openClientConnection = do
    env <- ask
    (sock, addr) <- liftIO $ multicastSender (getMulticastIP env) (getMulticastPort env)
    put $ ClientSocket sock addr


sendMsg :: String -> HNT ()
sendMsg msg = do
    ClientSocket sock addr <- get
    _ <- liftIO $ sendTo sock msg addr
    tell ["Sent " ++ msg ++ " to socket" ]

myApp :: HNT ()
myApp = do
    env <- ask
    liftIO $ print (show env)


doRun :: IO ((Either HNError (), LogMessages), ClientSocket)
doRun = runHNT initialState initialNetwork ( openClientConnection >> sendMsg "Hello" >> myApp )