Polymorphic components for graphics and program state

Question

I asked this question on StackOverflow, got some answers, most notably a link to this one, and basing on that I've implemented this:

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Control.Monad.State
import Control.Monad.IO.Class
-- Module
----------------------------------------------------------------------------------------
newtype Module m a b =
 Module (a -> m (b, Module m a b))
{-
instance (Monad m) => Applicative (Module m a)
instance (Monad m) => Arrow (Module m)
instance (Monad m) => Category (Module m)
instance (Monad m) => Functor (Module m a)
-}
-- GraphicsModule
----------------------------------------------------------------------------------------
data GraphicsState = GraphicsState Int
render :: (MonadState GraphicsState m, MonadIO m) => Int -> m ()
render x = do
 (GraphicsState s) <- get
 liftIO $ print $ x + s
 put . GraphicsState $ s + 1
type GraphicsModule = Module IO Int ()
initialGraphicsState = GraphicsState 0
createGraphicsModule :: GraphicsState -> GraphicsModule 
createGraphicsModule initialState = Module $ \x -> do
 (r, s') <- runStateT (render x) initialState
 return (r, createGraphicsModule s') 
initialGraphicsModule = createGraphicsModule initialGraphicsState
runModule (Module m) x = m x
-- Program
----------------------------------------------------------------------------------------
data ProgramState = ProgramState {
 graphicsModule :: GraphicsModule
}
renderInProgram :: (MonadState ProgramState m, MonadIO m) => Int -> m ()
renderInProgram x = do
 gm <- gets graphicsModule
 (r, gm') <- liftIO $ runModule gm x
 modify $ \g -> g { graphicsModule = gm' }
initialProgramState = ProgramState initialGraphicsModule
main = runStateT prog initialProgramState
prog = do
 renderInProgram 1
 renderInProgram 1
 renderInProgram 1

I can see how this could be quite easily extended to allow more functions in a module (instead of just render). I am not sure if I'm keeping the state correctly, though. That was the only way I saw to not expose the inner, stateful context (note that the outer monad to the module is just IO).

Also I am aware of the fact that Lens could make it less verbose. I deliberately chose to not depend on Lens, and I think it's really functionally equivalent.

Answer 1

The point of the Module approach is that you don't manage any state globally. Instead, each component (Module) manages its own state internally and you just express how they are connected together.

To give a simple example, let me first implement the standard type classes for Module:

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
module Main where
import Prelude hiding ((.), id)
import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Monad
import Control.Monad.State
import Control.Monad.Trans
import Control.Monad.IO.Class
import Data.Void
-- Module
----------------------------------------------------------------------------------------
newtype Module m a b =
 Module { runModule :: a -> m (b, Module m a b) }
instance (Monad m) => Category (Module m) where
 id = Module $ \x -> return (x, id)
 (Module g) . (Module f) = Module $ \x -> do
 (u, f') <- f x
 (v, g') <- g u
 return (v, g' . f')
mkGen :: (Monad m) => (a -> m b) -> Module m a b
mkGen f = let m = Module $ \x -> do
 y <- f x
 return (y, m)
 in m
instance (Monad m) => Arrow (Module m) where
 arr f = mkGen (return . f)
 first (Module f) = Module $ \(x, y) -> do
 (r, m) <- f x
 return ((r, y), first m)
instance (Monad m) => Functor (Module m a) where
 fmap f (Module k) = Module $ \x -> do
 (y, k') <- k x
 return (f y, fmap f k')
instance (Monad m) => Applicative (Module m a) where
 pure x = let m = Module $ \_ -> return (x, m)
 in m
 (Module f) <*> (Module k) = Module $ \x -> do
 (h, f') <- f x
 (y, k') <- k x
 return (h y, f' <*> k')

The above functions allow creating modules and combining them together in various ways.

Now one of the main functions is to step a module with no input/output, producing its next state:

step :: (Monad m) => Module m () () -> m (Module m () ())
step (Module k) = liftM snd (k ())

For example, in your case you'd have a counter module, that keeps an internal state:

counter :: (Monad m) => Module m () Int
counter = let m i = Module $ \_ -> return (i, m (i + 1))
 in m 0

And a state-less module that just prints what it gets and has no output

render :: (MonadIO m, Show a) => Module m a ()
render = mkGen (liftIO . print)

Their combination is a module with no input or output, and stepping them prints the counter each time:

main :: IO ()
main = do
 let m = counter >>> render
 step m >>= step >>= step
 return ()