2
\$\begingroup\$

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.

\$\endgroup\$
1
\$\begingroup\$

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 ()
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.