packages feed

UrlDisp (empty) → 0.1.3

raw patch · 6 files changed

+256/−0 lines, 6 filesdep +MaybeTdep +basedep +cgisetup-changed

Dependencies added: MaybeT, base, cgi, mtl

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Artyom Shalkhakov 2009, Sterling Clover 2008++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Network/UrlDisp.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------+-- |+-- 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+-}+
+ Network/UrlDisp/Controller.hs view
@@ -0,0 +1,102 @@+{-# 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+
+ Network/UrlDisp/Types.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving #-}+module Network.UrlDisp.Types (UrlS(..), UrlDisp) where++import Control.Applicative (Alternative(..), Applicative(..))+-- import Control.Monad.Reader+import Control.Monad.Maybe+import Control.Monad.State.Strict++import Network.CGI.Monad++data UrlS = UrlS { pPath :: [String] }++-- just a shorthand+type UrlDisp m a = StateT UrlS (MaybeT m) a++-- boilerplate, lots of it+instance (MonadCGI m) => MonadCGI (StateT s m) where+    cgiAddHeader n v = lift $ cgiAddHeader n v+    cgiGet = lift . cgiGet++instance (MonadCGI m) => MonadCGI (MaybeT m) where+    cgiAddHeader n v = lift $ cgiAddHeader n v+    cgiGet = lift . cgiGet++instance (Monad m) => Applicative (StateT UrlS (MaybeT (CGIT m))) where+    pure = return+    (<*>) = ap++instance (Monad m) => Alternative (StateT UrlS (MaybeT (CGIT m))) where+    empty = lift mzero+    a <|> b = StateT $ \s -> mplus (runStateT a s) (runStateT b s)+
+ Setup.lhs view
@@ -0,0 +1,7 @@+#!/usr/bin/env runghc++> module Main where+> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ UrlDisp.cabal view
@@ -0,0 +1,22 @@+name: UrlDisp+version: 0.1.3+author: Artyom Shalkhakov, Sterling Clover+copyright: Artyom Shalkhakov, Sterling Clover+maintainer: Artyom Shalkhakov <artyom.shalkhakov@gmail.com>++license: BSD3+license-File: LICENSE++synopsis: Url dispatcher. Helps to retain friendly URLs in web applications.+description: The aim of urldisp is to provide a simple, declarative and expressive URL routing in web applications.+category: Network, Web++build-type: Simple+cabal-version: >= 1.2+tested-with: GHC == 6.10.1++library+    build-depends: base >= 4, cgi >= 3001.1.0, mtl, MaybeT+    exposed-modules: Network.UrlDisp+    other-modules: Network.UrlDisp.Types, Network.UrlDisp.Controller+    ghc-options: -Wall