web-routes-happstack (empty) → 0.19

raw patch · 3 files changed

+67/−0 lines, 3 filesdep +basedep +happstack-serverdep +web-routessetup-changed

Dependencies added: base, happstack-server, web-routes

Files

• Setup.hs +2/−0
• Web/Routes/Happstack.hs +47/−0
• web-routes-happstack.cabal +18/−0

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, UndecidableInstances, PackageImports #-}+module Web.Routes.Happstack where++import Control.Applicative ((<$>))+import Control.Monad (MonadPlus(mzero))+import Data.List (intercalate)+import Happstack.Server (FilterMonad(..), ServerMonad(..), WebMonad(..), ServerPartT, Response, Request(rqPaths), ToMessage(..), dirs, runServerPartT, withRequest)+import Web.Routes.RouteT (RouteT(RouteT), liftRouteT, mapRouteT)+import Web.Routes.Site (Site, runSite)++instance (ServerMonad m) => ServerMonad (RouteT url m) where+    askRq       = liftRouteT askRq+    localRq f m = mapRouteT (localRq f) m++instance (FilterMonad a m)=> FilterMonad a (RouteT url m) where+    setFilter     = liftRouteT . setFilter+    composeFilter = liftRouteT . composeFilter+    getFilter     = mapRouteT getFilter ++instance (WebMonad a m) => WebMonad a (RouteT url m) where+    finishWith = liftRouteT . finishWith++implSite :: (Functor m, Monad m, MonadPlus m, ServerMonad m) => String -> FilePath -> Site url (m a) -> m a+implSite domain approot siteSpec =+  do r <- implSite_ domain approot siteSpec+     case r of+       (Left _) -> mzero+       (Right a) -> return a++implSite_ :: (Functor m, Monad m, MonadPlus m, ServerMonad m) => String -> FilePath -> Site url (m a) -> m (Either String a)+implSite_ domain approot siteSpec =+    dirs approot $ do rq <- askRq+                      let pathInfo = intercalate "/" (rqPaths rq)+                          f        = runSite (domain ++ approot) siteSpec pathInfo+                      case f of+                        (Left parseError) -> return (Left parseError)+                        (Right sp)   -> Right <$> (localRq (const $ rq { rqPaths = [] }) sp)+{- +implSite__ :: (Monad m) => String -> FilePath -> ([ErrorMsg] -> ServerPartT m a) -> Site url (ServerPartT m a) -> (ServerPartT m a)+implSite__ domain approot handleError siteSpec =+    dirs approot $ do rq <- askRq+                      let pathInfo = intercalate "/" (rqPaths rq)+                          f        = runSite (domain ++ approot) siteSpec pathInfo+                      case f of+                        (Failure errs) -> handleError errs+                        (Success sp)   -> localRq (const $ rq { rqPaths = [] }) sp+-}

@@ -0,0 +1,18 @@+Name:             web-routes-happstack+Version:          0.19+License:          BSD3+Author:           jeremy@seereason.com+Maintainer:       partners@seereason.com+Bug-Reports:      http://bugzilla.seereason.com/+Category:         Web, Language+Synopsis:         Adds support for using web-routes with Happstack+Cabal-Version:    >= 1.6+Build-type:       Simple++Library+        Build-Depends:    base >= 4 && < 5, happstack-server, web-routes >= 0.19+        Exposed-Modules:  Web.Routes.Happstack++source-repository head+    type:     darcs+    location: http://src.seereason.com/web-routes/