current community

your communities

more stack exchange communities

Stack Exchange
tour help
Take the 2-minute tour ×
Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.
up vote 2 down vote favorite

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.

share|improve this question
1  
Please state only the code's purpose in the title. –  Jamal♦ Mar 31 at 13:11

1 Answer 1

up vote 1 down vote

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 ()
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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