growler 0.2.0 → 0.3.0

raw patch · 4 files changed

+88/−32 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• growler.cabal +1/−1
• src/Web/Growler.hs +1/−1
• src/Web/Growler/Router.hs +41/−25
• src/Web/Growler/Types.hs +45/−5

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                growler-version:             0.2.0+version:             0.3.0 synopsis:            A revised version of the scotty library that attempts to be simpler and more performant. description:         Growler provides a very similar interface to scotty, with slight tweaks for performance and a few feature tradeoffs. Growler provides the ability to abort actions (handlers) with arbitrary responses, not just in the event of redirects or raising errors. Growler avoids coercing everything into lazy Text values and reading the whole request body into memory. It also eliminates the ability to abort the handler and have another handler handle the request instead (Scotty's 'next' function). 		     .

@@ -65,7 +65,7 @@ import           Web.Growler.Handler import           Web.Growler.Parsable import           Web.Growler.Router-import           Web.Growler.Types         hiding (status, headers, params, request)+import           Web.Growler.Types         hiding (status, headers, params, request, capture)  growl :: MonadIO m => (forall a. m a -> IO a) -> HandlerT m () -> GrowlerT m () -> IO () growl trans fb g = do

@@ -16,6 +16,7 @@     , capture     , regex     , function+    , mount     , literal     , route     , RoutePattern(..)@@ -24,12 +25,13 @@ import           Control.Arrow              ((***))  import           Control.Monad.State        hiding (get, put)+import qualified Control.Monad.State        as S import           Control.Monad.Trans  import qualified Data.ByteString.Char8      as B import qualified Data.ByteString.Lazy.Char8 as BL import           Data.Maybe                 (fromMaybe)-import           Data.Monoid                (mconcat)+import           Data.Monoid                ((<>), mconcat) import           Data.String                (fromString) import qualified Data.Text                  as T import qualified Data.Text.Encoding         as T@@ -42,8 +44,23 @@ import qualified Text.Regex                 as Regex  import           Web.Growler.Handler-import           Web.Growler.Types          hiding (status)+import           Web.Growler.Types          hiding (status, capture) ++mount :: Monad m => RoutePattern -> GrowlerT m () -> GrowlerT m ()+mount pat m = GrowlerT $ do+  previous <- S.get+  -- create inner scope that doesn't affect external routes+  S.put []+  fromGrowlerT m+  modify' (fmap $ \(m, p, h) -> (m, pat <> p, h))+  new <- S.get+  S.put (new ++ previous)+++handlerHook :: Monad m => (HandlerT m () -> HandlerT m ()) -> GrowlerT m ()+handlerHook f = GrowlerT $ modify' (fmap $ \(m, p, h) -> (m, p, f h))+ -- | get = 'addroute' 'GET' get :: (MonadIO m) => RoutePattern -> HandlerT m () -> GrowlerT m () get = addRoute GET@@ -96,24 +113,12 @@   else Nothing  matchRoute :: RoutePattern -> Request -> Maybe [Param]-matchRoute (Literal pat)  req | pat == path req = Just []-                              | otherwise       = Nothing-matchRoute (Function _ fun) req = fun req-matchRoute (Capture pat)  req = go (T.split (== '/') pat) (T.split (== '/') $ path req) []-    where go [] [] prs = Just prs -- request string and pattern match!-          go [] r  prs | T.null (mconcat r)  = Just prs -- in case request has trailing slashes-                       | otherwise           = Nothing  -- request string is longer than pattern-          go p  [] prs | T.null (mconcat p)  = Just prs -- in case pattern has trailing slashes-                       | otherwise           = Nothing  -- request string is not long enough-          go (p:ps) (r:rs) prs | p == r          = go ps rs prs -- equal literals, keeping checking-                               | T.null p        = Nothing      -- p is null, but r is not, fail-                               | T.head p == ':' = go ps rs $ (T.encodeUtf8 $ T.tail p, T.encodeUtf8 r) : prs -- p is a capture, add to params-                               | otherwise       = Nothing      -- both literals, but unequal, fail+matchRoute (RoutePattern p) req = let (_, _, rps) = p req in case rps of+  Fail -> Nothing+  Partial _ -> Nothing+  Complete ps -> Just ps  -- Pretend we are at the top level.-path :: Request -> T.Text-path = T.cons '/' . T.intercalate "/" . pathInfo- parseEncodedParams :: B.ByteString -> [Param] parseEncodedParams bs = [ (T.encodeUtf8 k, T.encodeUtf8 $ fromMaybe "" v) | (k,v) <- parseQueryText bs ] @@ -130,10 +135,14 @@ -- Capture: oo/ba -- regex :: String -> RoutePattern-regex pattern = Function (const $ T.pack pattern) $ \ req -> fmap (map (B.pack . show *** (T.encodeUtf8 . T.pack)) . zip [0 :: Int ..] . strip)-                                         (Regex.matchRegexAll rgx $ T.unpack $ path req)-    where rgx = Regex.mkRegex pattern-          strip (_, match, _, subs) = match : subs+regex pattern = RoutePattern go+  where+    go req = (T.pack pattern, req, maybe Fail Complete $ fmap convertParams match)+      where+        rgx = Regex.mkRegex pattern+        strip (_, match, _, subs) = match : subs+        match = Regex.matchRegexAll rgx $ T.unpack $ path req+        convertParams = map (B.pack . show *** (T.encodeUtf8 . T.pack)) . zip [0 :: Int ..] . strip  -- | Standard Sinatra-style route. Named captures are prepended with colons. --   This is the default route type generated by OverloadedString routes. i.e.@@ -162,9 +171,16 @@ -- >>> curl http://localhost:3000/ -- HTTP/1.1 ---function :: (Request -> T.Text) -> (Request -> Maybe [Param]) -> RoutePattern-function = Function+function :: (Request -> T.Text) -> (Request -> MatchResult) -> RoutePattern+function fn fps = RoutePattern $ \r -> (fn r, r, fps r)  -- | Build a route that requires the requested path match exactly, without captures. literal :: String -> RoutePattern-literal = Literal . T.pack+literal pat = RoutePattern go+  where+    go req = (packed, req { pathInfo = req' }, result)+      where+        packed = T.pack pat+        (result, req') = case T.stripPrefix packed (path req) of+          Nothing -> (Fail, [])+          Just rem -> if T.null rem then (Complete [], []) else (Partial [], dropWhile (== "") $ T.split (== '/') rem)

@@ -6,6 +6,7 @@ {-# LANGUAGE FunctionalDependencies     #-} {-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE OverloadedStrings          #-} module Web.Growler.Types where import           Blaze.ByteString.Builder  (Builder) import           Control.Applicative@@ -21,20 +22,59 @@ import qualified Data.ByteString.Lazy        as L import qualified Data.CaseInsensitive        as CI import qualified Data.HashMap.Strict         as HM+import           Data.Monoid import           Data.String                 (IsString (..)) import           Data.Text                   (Text, pack)+import qualified Data.Text                   as T+import qualified Data.Text.Encoding          as T import           Network.HTTP.Types.Header import           Network.HTTP.Types.Method import           Network.HTTP.Types.Status import           Network.Wai -data RoutePattern = Capture  Text-                  | Literal  Text-                  | Function (Request -> Text) (Request -> Maybe [Param])+data MatchResult = Fail | Partial [Param] | Complete [Param]+  deriving (Show, Eq) +newtype RoutePattern = RoutePattern { runRoutePattern :: Request -> (Text, Request, MatchResult) }++instance Monoid MatchResult where+  mappend l r = case l of+    Fail -> Fail+    Partial lps -> case r of+      Fail -> Fail+      Partial rps -> Partial (lps <> rps)+      Complete rps -> Complete (lps <> rps)+    Complete lps -> Fail+  mempty = Partial []++instance Monoid RoutePattern where+  mappend (RoutePattern a) (RoutePattern b) = RoutePattern $ \r -> let (t1, r', p1) = a r in+                                                                   let (t2, r'', p2) = b r' in+                                                                     (t1 <> t2, r'', p1 <> p2)+  mempty = RoutePattern $ \r -> ("", r, Partial [])+ instance IsString RoutePattern where-    fromString = Capture . pack+  fromString = capture . T.pack +path :: Request -> T.Text+path = T.cons '/' . T.intercalate "/" . pathInfo++capture :: Text -> RoutePattern+capture pat = RoutePattern process+  where +    process req = (pat, req { pathInfo = ss }, res)+      where+        (res, ss) = go (T.split (== '/') pat) (T.split (== '/') $ path req) []+        go [] [] prs = (Complete prs, []) -- request string and pattern match!+        go [] r  prs | T.null (mconcat r)  = (Complete prs, []) -- in case request has trailing slashes+                     | otherwise           = (Partial prs, r)  -- request string is longer than pattern+        go p  [] prs | T.null (mconcat p)  = (Complete prs, []) -- in case pattern has trailing slashes+                     | otherwise           = (Fail, [])         -- request string is not long enough+        go (p:ps) (r:rs) prs | p == r          = go ps rs prs -- equal literals, keeping checking+                             | T.null p        = (Fail, [])         -- p is null, but r is not, fail+                             | T.head p == ':' = go ps rs $ (T.encodeUtf8 $ T.tail p, T.encodeUtf8 r) : prs -- p is a capture, add to params+                             | otherwise       = (Fail, [])     -- both literals, but unequal, fail+ type Param = (C.ByteString, C.ByteString)  data BodySource = FileSource !(FilePath, Maybe FilePart)@@ -101,7 +141,7 @@  type Handler = HandlerT IO -newtype GrowlerT m a = GrowlerT { fromGrowlerT :: StateT [(StdMethod, RoutePattern, HandlerT m ())] m a}+newtype GrowlerT m a = GrowlerT { fromGrowlerT :: StateT [(StdMethod, RoutePattern, HandlerT m ())] m a }  instance Functor m => Functor (GrowlerT m) where   fmap f (GrowlerT m) = GrowlerT (fmap f m)