diff --git a/growler.cabal b/growler.cabal --- a/growler.cabal +++ b/growler.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: growler -version: 0.5.0.1 +version: 0.6.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). . @@ -43,7 +43,7 @@ other-extensions: OverloadedStrings, FlexibleContexts, FlexibleInstances, LambdaCase, RankNTypes, ScopedTypeVariables build-depends: base >=4.6 && <5, lens >=4.5 && <5, - mtl >=2.2 && <3, + mtl >=2.1 && <3, bytestring >=0.10 && <0.20, http-types >=0.8 && <1, text >=1.1 && <2, @@ -53,14 +53,15 @@ blaze-builder >=0.3 && <0.7, unordered-containers >=0.2 && <0.9, aeson >= 0.8, - vector == 0.10.*, - case-insensitive == 1.2.*, - warp == 3.*, + vector >= 0.7.1, + case-insensitive >= 1.2, + warp >= 3, pipes >= 4.0 && <4.2, - pipes-aeson == 0.4.*, - pipes-wai == 3.*, + pipes-aeson >= 0.4, + pipes-wai >= 3, monad-control == 1.*, - either == 4.3.*, - transformers-base == 0.4.* + either >= 4.3.1, + transformers-base >= 0.4, + transformers >= 0.3 && < 0.5 hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Web/Growler.hs b/src/Web/Growler.hs --- a/src/Web/Growler.hs +++ b/src/Web/Growler.hs @@ -86,27 +86,27 @@ , ResponseState (..) , RoutePattern (..) ) where -import Control.Exception (catch) -import Control.Lens hiding (get) +import Control.Exception (catch) +import Control.Lens hiding (get) import Control.Monad.Identity -import Control.Monad.State hiding (get, put) +import Control.Monad.Trans.State.Strict hiding (get, put) import Control.Monad.Trans -import qualified Data.HashMap.Strict as HM +import qualified Data.HashMap.Strict as HM import Data.Maybe -import qualified Data.Vector as V +import qualified Data.Vector as V import Data.Vector.Lens import Network.HTTP.Types.Method import Network.Wai -import qualified Network.Wai.Handler.Warp as Warp -import Pipes.Aeson (DecodingError (..)) +import qualified Network.Wai.Handler.Warp as Warp +import Pipes.Aeson (DecodingError (..)) import Web.Growler.Handler import Web.Growler.Parsable import Web.Growler.Router -import Web.Growler.Types hiding (status, headers, params, request, capture) +import Web.Growler.Types hiding (status, headers, params, request, capture) -- | The simple approach to starting up a web server growl :: MonadIO m => (forall a. m a -> IO a) -- ^ A function to convert your base monad of choice into IO. - -> GrowlerConfig m + -> GrowlerConfig m -> GrowlerT m () -- ^ The router for all the other routes -> IO () growl trans fb g = do diff --git a/src/Web/Growler/Handler.hs b/src/Web/Growler/Handler.hs --- a/src/Web/Growler/Handler.hs +++ b/src/Web/Growler/Handler.hs @@ -1,31 +1,32 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE OverloadedStrings #-} module Web.Growler.Handler where -import Blaze.ByteString.Builder (Builder) +import Blaze.ByteString.Builder (Builder) import Control.Applicative import Control.Lens -import Control.Monad.RWS +import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Either -import qualified Control.Monad.State as State -import qualified Control.Monad.State.Strict as ST -import Data.Aeson hiding ((.=)) -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString.Lazy.Char8 as L +import qualified Control.Monad.Trans.RWS.Strict as RWS +import qualified Control.Monad.Trans.State.Strict as ST +import Data.Aeson hiding ((.=)) +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy.Char8 as L import Data.CaseInsensitive import Data.Maybe -import qualified Data.HashMap.Strict as HM -import Data.Text as T -import Data.Text.Encoding as T -import Data.Text.Lazy as TL -import qualified Data.Text.Lazy.Encoding as TL +import Data.Monoid ((<>)) +import qualified Data.HashMap.Strict as HM +import Data.Text as T +import Data.Text.Encoding as T +import Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TL import Network.HTTP.Types.Status import Network.Wai -import Network.Wai.Parse hiding (Param) +import Network.Wai.Parse hiding (Param) import Network.HTTP.Types import Web.Growler.Parsable -import Web.Growler.Types hiding (status, request, params) -import qualified Web.Growler.Types as L +import Web.Growler.Types hiding (status, request, params) +import qualified Web.Growler.Types as L import Pipes.Wai import Pipes.Aeson @@ -33,7 +34,7 @@ initialState = ResponseState ok200 HM.empty (LBSSource "") currentResponse :: Monad m => HandlerT m ResponseState -currentResponse = HandlerT State.get +currentResponse = HandlerT RWS.get -- | End the handler early with an arbitrary 'ResponseState'. abort :: Monad m => ResponseState -> HandlerT m () @@ -176,18 +177,18 @@ runHandler :: Monad m => ResponseState -> Maybe T.Text -> Request -> [Param] -> HandlerT m a -> m (Either ResponseState (a, ResponseState)) runHandler rs pat rq ps m = runEitherT $ do - (dx, r, ()) <- runRWST (fromHandler m) (RequestState pat (qsParams ++ ps) rq) rs + (dx, r, ()) <- RWS.runRWST (fromHandler m) (RequestState pat (qsParams ++ ps) rq) rs return (dx, r) where - qsParams = fmap (_2 %~ fromMaybe "") (queryString rq) + qsParams = fmap (_2 %~ fromMaybe "") (queryString rq) liftAround :: (Monad m) => (forall a. m a -> m a) -> HandlerT m a -> HandlerT m a liftAround f m = HandlerT $ do - (RequestState pat ps req) <- ask - currentState <- get + (RequestState pat ps req) <- RWS.ask + currentState <- RWS.get r <- lift $ lift $ f $ runHandler currentState pat req ps m case r of Left err -> lift $ left err Right (dx, state') -> do - put state' - return dx + RWS.put state' + return dx diff --git a/src/Web/Growler/Router.hs b/src/Web/Growler/Router.hs --- a/src/Web/Growler/Router.hs +++ b/src/Web/Growler/Router.hs @@ -24,31 +24,32 @@ , internalServerError ) where -import Control.Arrow ((***)) +import Control.Arrow ((***)) -import Control.Monad.State hiding (get, put) -import qualified Control.Monad.State as S -import Control.Monad.State.Class (modify') import Control.Monad.Trans +import qualified Control.Monad.Trans.State.Strict as S -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.String (fromString) -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Text.Lazy as TL +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.String (fromString) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T +import qualified Data.Text.Lazy as TL import Network.HTTP.Types -import Network.Wai (Request (..)) -import qualified Network.Wai.Parse as Parse +import Network.Wai (Request (..)) +import qualified Network.Wai.Parse as Parse -import qualified Text.Regex as Regex +import qualified Text.Regex as Regex import Web.Growler.Handler -import Web.Growler.Types hiding (status, capture) +import Web.Growler.Types hiding (status, capture) +-- TODO shim to add support for transformers 0.3. Get rid of it once +-- Nix makes it easier to escape older transformers version. +modify' f = S.get >>= (($!) S.put . f) mount :: Monad m => RoutePattern -> GrowlerT m () -> GrowlerT m () mount pat m = GrowlerT $ do @@ -111,7 +112,7 @@ -- >>> curl http://localhost:3000/foo/something -- something addRoute :: (MonadIO m) => StdMethod -> RoutePattern -> HandlerT m () -> GrowlerT m () -addRoute method pat action = GrowlerT $ modify ((method, pat, action):) +addRoute method pat action = GrowlerT $ modify' ((method, pat, action):) route :: Request -> StdMethod -> RoutePattern -> Maybe (T.Text, [Param]) route req method pat = if Right method == parseMethod (requestMethod req) diff --git a/src/Web/Growler/Types.hs b/src/Web/Growler/Types.hs --- a/src/Web/Growler/Types.hs +++ b/src/Web/Growler/Types.hs @@ -8,26 +8,26 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE OverloadedStrings #-} module Web.Growler.Types where -import Blaze.ByteString.Builder (Builder) +import Blaze.ByteString.Builder (Builder) import Control.Applicative import Control.Exception import Control.Lens.TH -import Control.Monad.Base (MonadBase(..), liftBaseDefault) -import Control.Monad.Reader -import Control.Monad.RWS -import Control.Monad.State +import Control.Monad.Base (MonadBase(..), liftBaseDefault) +import Control.Monad.Trans +import Control.Monad.Trans.RWS.Strict +import Control.Monad.Trans.State.Strict hiding (get, put) import Control.Monad.Trans.Either import Control.Monad.Trans.Control -import Data.Aeson hiding ((.=)) -import qualified Data.ByteString.Char8 as C -import qualified Data.ByteString.Lazy as L -import qualified Data.CaseInsensitive as CI -import qualified Data.HashMap.Strict as HM +import Data.Aeson hiding ((.=)) +import qualified Data.ByteString.Char8 as C +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 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 @@ -76,7 +76,7 @@ capture :: Text -> RoutePattern capture pat = RoutePattern process - where + where process req = RoutePatternResult pat (req { pathInfo = ss }) res where (res, ss) = go (T.split (== '/') pat) (T.split (== '/') $ path req) []