-----------------------------------------------------------------------
-- |
-- Module: Network.UrlDisp
-- Copyright: (c) Artyom Shalkhakov 2009, Sterling Clover 2008
-- License: BSD 3 Clause
-- Maintainer: artyom.shalkhakov@gmail.com
-- Stability: experimental
-- Portability: portable
--
-- URL dispatching (routing) library, based on Sterling Clover's HVAC.
-----------------------------------------------------------------------
module Network.UrlDisp (
    -- * Types
    UrlDisp,
    UrlS,
    -- * Controller combinators
    h, (|/), (|//), (|?), (|\), (|\\), (|.),
    path, meth, param, takePath, readPath, endPath,
    -- * Running UrlDisp
    runUrlDisp, evalUrlDisp
    ) where

import Control.Monad.Maybe
import Control.Monad.State.Strict

import Network.CGI
import Network.CGI.Monad

import Network.UrlDisp.Types
import Network.UrlDisp.Controller

-- | Given path and a sequence of actions chained using combinators
-- defined in controller API, run them in the CGI monad.
runUrlDisp :: (MonadCGI m)
           => String      -- ^ path (hierarchical part of the URL)
           -> UrlDisp m a
           -> m (Maybe a)
runUrlDisp p hndl = runMaybeT (evalStateT hndl (UrlS {pPath = pinfo}))
    where pinfo = (filter (not . null) . splitPath) p
          splitPath :: String -> [String]
          splitPath xs = let (zs, ys) = break (=='/') xs
                         in zs : case ys of
                             [] -> []
                             _:ws -> splitPath ws

-- | The same as runUrlDisp, but yields CGIResult. If URL dispatching
-- failed, then a 404 not found error is returned.
evalUrlDisp :: (MonadCGI m, MonadIO m) => UrlDisp m CGIResult -> m CGIResult
evalUrlDisp handler = pathInfo >>= \s -> runUrlDisp s handler >>=
    maybe (outputNotFound s) return

{-
-- 1) we can't rely on existance of MaybeT MPlus instance
--    in the Control.Monad.Maybe
-- 2) uncommenting this gives compilation failure (duplicate instance decls)
--    because Control.Monad.Maybe in fact does have the instance declared,
--    contrary to the docs
instance Monad m => MonadPlus (MaybeT m) where
    mzero = MaybeT $ return Nothing
    mplus x y = MaybeT $ do
        x' <- runMaybeT x
        case x' of
            Just _ -> return x'
            Nothing -> runMaybeT y
-}