Controller is now also MonadState.

diff --git a/Framework/Controller.hs b/Framework/Controller.hs
index f313cbe..b8347c2 100644
--- a/Framework/Controller.hs
+++ b/Framework/Controller.hs
@@ -22,11 +22,12 @@ module Framework.Controller
      returnNow, reject,
      concatC, changeR,
      assertC,
-     evalController,
-     evalRightNow
+     evalController
+--      evalRightNow
     ) where

 import Control.Monad.Reader.Class
+import Control.Monad.State.Class
 import Control.Monad.Trans

 import Framework.Types
@@ -42,7 +43,7 @@ data ControllerResult r a = Reject                 -- ^ `No, I wann't process th

 -- | Controller itself
 newtype Controller s r a = Controller {
-    runController :: s -> IO (ControllerResult r a)
+    runController :: s -> IO (ControllerResult r a, s)
     }

 -- | Type of application-level controllers
@@ -63,25 +64,31 @@ type ControllerExcHandler = HttpRequest -> Int -> String -> AController ()

 instance Monad (Controller s r) where
 --     return :: a -> Controller s a
-    return v = Controller $ \_ -> return (Result v)
+    return v = Controller $ \s -> return (Result v, s)

 --     (>>=) :: Controller s a -> (a -> Controller s b) -> Controller s b
     Controller cmd >>= f =
         Controller $ \s -> do       -- `do` in IO
-            res <- cmd s
+            (res, s') <- cmd s
             case res of
-                Reject     -> return Reject
-                RightNow resp -> return $ RightNow resp
-                Result res'   -> (runController . f) res' s
+                Reject     -> return (Reject, s)
+                RightNow resp -> return (RightNow resp, s)
+                Result res'   -> (runController . f) res' s'
+
+instance MonadState s (Controller s r) where
+    get = Controller $ \s -> return (Result s, s)
+    put s = Controller $ \_ -> return (Result (), s)

 instance MonadReader s (Controller s r) where
-    ask = Controller $ \s -> return (Result s)
+    ask = Controller $ \s -> return (Result s, s)
     local f m = Controller $ runController m . f

 instance MonadIO (Controller s r) where
     -- liftIO :: IO a -> Controller s r a
     -- | `Lift' an IO action into Controller
-    liftIO act = Controller $ \_ -> Result `fmap` act
+    liftIO act = Controller $ \s -> do
+        res <- act
+        return (Result res, s)

 ---------------------------------------------------------------------------------------------
 -- * Controller-monad specific functions
@@ -92,7 +99,7 @@ concatC :: [Controller b [a] [a]]  -- ^ List of controllers
 concatC cs = do
     s <- ask
     rs <- liftIO $ mapM (flip runController s) cs
-    return $ process rs
+    return $ process $ map fst rs
   where
     process []                = []
     process (Reject:_)        = []
@@ -104,7 +111,7 @@ changeR :: Controller s r a -> Controller s q a
 changeR m = do
     s <- ask
     r <- liftIO $ runController m s
-    case r of
+    case fst r of
       Reject -> reject
       RightNow t -> reject
       Result x -> return x
@@ -118,17 +125,19 @@ assertC b =

 -- | Return given value and do not evaluate following computations
 returnNow ::  r -> Controller s r a
-returnNow v = Controller $ \_ -> return (RightNow v)
+returnNow v = Controller $ \s -> return (RightNow v, s)

 -- | Reject this computation
 reject :: Controller s r a
-reject = Controller $ \_ -> return Reject
+reject = Controller $ \s -> return (Reject, s)

 -- | Evaluate controller with given configuration
 evalController :: Controller s a a              -- ^ Controller
                -> s                             -- ^ Configuration for controller
                -> IO (Maybe a)
-evalController m s = anyResult `fmap` (runController m s)
+evalController m s = do
+    (res, s') <- (runController m s)
+    return $ anyResult res
     where
         -- | Convert any result to Maybe HttpResponse
         anyResult ::  ControllerResult a a -> Maybe a
@@ -138,13 +147,13 @@ evalController m s = anyResult `fmap` (runController m s)


 -- | Same as @evalController@, but return a value only if controller returns RightNow v.
-evalRightNow :: Controller s r a                 -- ^ Controller
-             -> s                                -- ^ Configuration for controller
-             -> IO (Maybe r)
-evalRightNow m s = anyResult `fmap` (runController m s)
-    where
-       anyResult :: ControllerResult r a -> Maybe r
-       anyResult Reject = Nothing
-       anyResult (RightNow r) = Just r
-       anyResult (Result _) = Nothing
+-- evalRightNow :: Controller s r a                 -- ^ Controller
+--              -> s                                -- ^ Configuration for controller
+--              -> IO (Maybe r)
+-- evalRightNow m s = anyResult `fmap` (runController m s)
+--     where
+--        anyResult :: ControllerResult r a -> Maybe r
+--        anyResult Reject = Nothing
+--        anyResult (RightNow r) = Just r
+--        anyResult (Result _) = Nothing