{-# LANGUAGE FlexibleContexts #-}
module Network.UrlDisp.Controller (
    path, meth, param, takePath, readPath, endPath,
    h, (|/), (|//), (|?), (|\), (|\\), (|.)
  ) where

import Network.UrlDisp.Types
import Control.Applicative ((<$>), Alternative(..))
import Control.Monad.State.Strict
import Network.CGI

maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
    [(x,"")] -> Just x
    _ -> Nothing

-- | Filters on and consumes the next element of the url path.
-- @ path \"str\" @ will match requests whose next path element is \"str\"
-- Consumption of the path element backtracks on failure.
path :: (MonadState UrlS m, Alternative m) => String -> m ()
path x = pPath <$> get >>= f where
    f (p:ps) = if p == x then modify (\par -> par {pPath = ps}) else empty
    f _ = empty

-- | Filters on the request method.
-- @ meth \"GET\" @ will match requests made using get.
meth :: (MonadCGI m, Alternative m) => String -> m ()
meth x = requestMethod >>= \r -> if r == x then return () else empty

-- | Filters on any parameter (via put or get).
-- @ param (\"cmd\", \"foo\") @ will match on ?cmd=foo
param :: (MonadCGI m, Alternative m) => (String, String) -> m ()
param (k,v) = getInput k >>= maybe empty (\x -> if x == v then return () else empty)

-- | Matches and consumes the next element of the path if
-- that element can be successfully read as the proper type. The parsed
-- element is returned.
readPath :: (Read a, MonadState UrlS m, Alternative m) => m a
readPath = pPath <$> get >>= f where
    f (p:ps) = maybe empty ((modify (\par -> par {pPath = ps}) >>) . return) (maybeRead p)
    f _ = empty

-- | Combinator that consumes the next element of the path and passes it
-- as an unparsed string into the following lambda expression.
-- @ h `takePath` \\x -> output (x++\"99\") @ will match on \"\/12\" and
-- output \"1299\"
-- Consumption of the path element backtracks on failure.
takePath :: (MonadState UrlS m, Alternative m) => m String
takePath = pPath <$> get >>= f where
    f (p:ps) = modify (\par -> par {pPath = ps}) >> return p
    f _ = empty

-- | Only matches if the remaining path is empty.
endPath :: (MonadState UrlS m, Alternative m) => m ()
endPath = pPath <$> get >>= \pss -> if null pss then return () else empty

-- another variant of the API

infixl 4 |/, |//, |?, |\, |\\, |.

-- | A null CGI action, used to begin a string of path combinators
h :: (MonadCGI m) => m ()
h = return ()

-- | Combinator that filters on and consumes the next element of the url
-- path.
-- @ h |\/ \"dir\" |\/ \"subdir\" @ will match \"\/dir\/subdir\".
-- Consumtion of the path element backtracks on failure.
(|/) :: (MonadState UrlS m, Alternative m) => m a -> String -> m ()
x |/ y = x >> path y

-- | Combinator that filters on the request method.
-- @ h |\/\/ \"GET\" @ will match requests made using get.
(|//) :: (MonadCGI m, Alternative m) => m a -> String -> m ()
x |// y = x >> meth y

-- | Combinator that filters on any parameter (via put or get).
-- @ h |? (\"cmd\",\"foo\") @ will match on ?cmd=foo
(|?) :: (MonadCGI m, Alternative m) => m a -> (String, String) -> m ()
x |? y = x >> param y

-- | Combinator that matches and consumes the next element of the path
-- if path element can be successfully read as the proper type and passed
-- to the following lambda expression.
-- @ h |\\ \\x -> output (x + (1.5::Float)) @ will match on \"\/12\"
-- and output \"13.5\". Consumption of the path element backtracks
-- on failure.
(|\) :: (Read x, MonadState UrlS m, Alternative m) => m a -> (x -> m b) -> m b
x |\ f = x >> readPath >>= f

-- | Combinator that consumes the next element of the path and passes it
-- as an unparsed string into the following lambda expression.
-- @ h |\\\\ \\x -> output (x++\"99\") @ will match on \"\/12\"
-- and output \"1299\"
-- Consumtion of the path element backtracks on failure.
(|\\) :: (MonadState UrlS m, Alternative m) => m a -> (String -> m b) -> m b
x |\\ f = x >> takePath >>= f

-- | Combinator that only matches if the remaining path is empty.
(|.) :: (MonadState UrlS m, Alternative m) => m a -> m  b -> m b
x |. f = x >> endPath >> f