{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-- | Controller is a monad, superset of IO.
-- All application controllers are executed in this monad.
-- Controller type has three type parameters. First is type of configuration
-- for controller (usually it will be @ActionConfig@ or @StaticConfig@). Second and
-- third are types of possible results of controller.
--
-- There are three possible ways to combine Controller actions. First, you can
-- execute actions one by one, just as in IO monad. Secondly, if you decide
-- that you already have a result, you can return that result with @returnNow@
-- function -- all subsequent computations will not be executed. Third, you can
-- at any moment reject all the computation (in application controller, this
-- will mean `I do not want process this URL!').
module Framework.Controller
    (-- * Data types
     Controller, AController,
     HttpController, StaticController,
     ContextProcessor,
     RequestExcHandler, ControllerExcHandler,
     -- * Controller-monad specific functions
     MonadIO (..),
     returnNow, reject,
     concatC, changeR, changeS,
     assertC,
     evalController
    ) where

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

import Framework.Types
import Framework.TEngine.Types

---------------------------------------------------------------------------------------
-- * Data types

-- | Controller may reject url, return a value for further processing,
-- or return a value right now to avoid succeding computations
data ControllerResult r a = Reject                 -- ^ `No, I wann't process this URL!'
                          | RightNow r             -- ^ `Return this response and do not look what is writen below!'
                          | Result a               -- ^ `I return this value; use it in following computations.'

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

-- | Type of application-level controllers
type HttpController = Controller ActionConfig HttpResponse HttpResponse
-- | Type of application-level controllers, that use StaticConfig
type StaticController = Controller StaticConfig HttpResponse HttpResponse
-- | Most common type of controllers
type AController a = Controller ActionConfig HttpResponse a

-------------------------------------------------------------------------------------------

type ContextProcessor = Controller ActionConfig Context Context

type RequestExcHandler = HttpRequest -> Int -> String -> Controller StaticConfig HttpResponse ()
type ControllerExcHandler = HttpRequest -> Int -> String -> AController ()

-------------------------------------------------------------------------------------------

instance Monad (Controller s r) where
--     return :: a -> Controller s a
    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, s') <- cmd s
            case res of
                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, 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 $ \s -> do
        res <- act
        return (Result res, s)

---------------------------------------------------------------------------------------------
-- * Controller-monad specific functions

-- | Run all controllers in list in given environment, and concatenate results
concatC :: [Controller b [a] [a]]  -- ^ List of controllers
        -> Controller b r [a]
concatC cs = do
    s <- ask
    rs <- liftIO $ mapM (flip runController s) cs
    return $ process $ map fst rs
  where
    process []                = []
    process (Reject:_)        = []
    process ((RightNow x):_) = x
    process ((Result x):xs)   = x++process xs

-- | Run a controller, but reject if it returns RightNow t.
changeR :: Controller s r a -> Controller s q a
changeR m = do
    s <- ask
    r <- liftIO $ runController m s
    case fst r of
      Reject -> reject
      RightNow _ -> reject
      Result x -> return x

-- | Run a controller in changed environment
changeS :: (s -> s1) -> Controller s1 r a -> Controller s r a
changeS f m = Controller $ \s -> do
    (res,_) <- runController m (f s)
    return (res, s)

-- | Assert that condition is satisfied. Otherwise, reject URL.
assertC :: Bool -> Controller s r ()
assertC b = 
    if b
       then return ()
       else reject

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

-- | Reject this computation
reject :: Controller s r a
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 = do
    (res, _) <- runController m s
    return $ anyResult res
    where
        -- | Convert any result to Maybe HttpResponse
        anyResult ::  ControllerResult a a -> Maybe a
        anyResult Reject = Nothing
        anyResult (RightNow r) = Just r
        anyResult (Result r) = Just r