happstack-helpers 0.44 → 0.45

raw patch · 2 files changed

+26/−7 lines, 2 filesdep +DebugTraceHelpersdep ~MissingH

Dependencies added: DebugTraceHelpers

Dependency ranges changed: MissingH

Files

• Happstack/Server/Helpers.hs +23/−5
• happstack-helpers.cabal +3/−2

@@ -1,5 +1,6 @@+{-# LANGUAGE ScopedTypeVariables #-} module Happstack.Server.Helpers-    ( smartserver, exactdir, smartserver',getData'+    ( smartserver, exactdir, smartserver',getData',vhosts,vhost     ) where  import Happstack.Server@@ -8,14 +9,16 @@ import Control.Concurrent import System.Time import Control.Monad-+import Debug.Trace.Helpers+import Data.Maybe (fromMaybe)+import qualified Data.ByteString.Char8 as B -- run the happs server on some port -- include cookie fix, various other enhancements that make things simpler smartserver' :: (Methods st, Component st, ToMessage b, Monad m, Functor m) =>                  (m (Maybe (Either Response a, FilterFun Response)) ->                  IO (Maybe (Either Response b, FilterFun Response))) ->-                Conf -> String -> ServerPartT m a -> Proxy st -> IO ()-smartserver' f conf progName handler stateProxy = withProgName progName $ do+                Conf -> ServerPartT m a -> Proxy st -> IO ()+smartserver' f conf handler stateProxy = do       putStrLn . ( "starting happs server" ++ ) =<< time       control <- startSystemState stateProxy -- start the HAppS state system @@ -34,7 +37,7 @@          where time = return . ("\ntime: " ++ ) . show  =<< getClockTime  smartserver :: (Methods st, Component st, ToMessage a) =>-               Conf -> String -> ServerPartT IO a -> Proxy st -> IO ()+               Conf -> ServerPartT IO a -> Proxy st -> IO () smartserver = smartserver' id  exactdir :: (Monad m) => String -> ServerPartT m a -> ServerPartT m a@@ -49,3 +52,18 @@  getData' :: (ServerMonad m, FromData a, MonadPlus m) => m a getData' = getData >>= maybe mzero return++-- | multiple vhosts to a server, eg+-- | vhosts [("mysite.com",80),("www.mysite.com",80)] mySiteController+vhosts hosts sp = msum . map (\h -> vhost h sp) $ hosts++{- | vhost doms h = msum . map (\d -> site d h) doms+     similar to apache vhost. given (domain,port) and a main request handler, handle requests if it's the specified domain and port +     vhost ("mysite.com",80) mySiteController+-}+vhost :: (String,Int) ->  ServerPartT IO Response -> ServerPartT IO Response+vhost  vh@(domain, port) sp = do+  (p :: Int) <- liftM ( snd . rqPeer ) askRq+  (d :: String) <- (B.unpack . fromMaybe (error "Happstack.Helpers.Server.vhost, no host header")) `liftM` getHeaderM "host"+  guardRq $ \rq -> (d,p) == vh+  sp

@@ -1,5 +1,5 @@ Name: happstack-helpers-Version: 0.44+Version: 0.45 License: BSD3 License-file: bsd3.txt Description: Functions I found I was using repeatedly when programming Happstack based web-apps. @@ -41,7 +41,7 @@                , HStringTemplate >= 0.4.0 && < 0.7.0                , HStringTemplateHelpers >= 0.0.14                 , safe >= 0.2 && < 0.3-               , MissingH >= 1.0.0 && < 2.0.0+               , MissingH == 1.0.3                , containers >= 0.2.0.0 && < 0.3.0.0                , parsec >= 2.1.0.0 && < 2.2.0.0                , haskell98 >= 1.0.0.0 && < 2.0.0.0@@ -52,4 +52,5 @@                , old-time >= 1.0.0.0 && < 1.1.0.0                , pureMD5 >= 1.0.0.0 && < 1.1.0.0                , PBKDF2 >= 0.3 && < 0.4+               , DebugTraceHelpers   ghc-options: -Wall