Spock 0.6.0.0 → 0.6.1.0
raw patch · 5 files changed
+78/−21 lines, 5 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Web.Spock: combineRoute :: Text -> Text -> Text
+ Web.Spock: subcomponent :: MonadIO m => Text -> SpockT m () -> SpockT m ()
Files
- Spock.cabal +1/−1
- src/Tests.hs +1/−0
- src/Web/Spock.hs +4/−3
- src/Web/Spock/Core.hs +1/−0
- src/Web/Spock/Wire.hs +71/−17
Spock.cabal view
@@ -1,5 +1,5 @@ name: Spock-version: 0.6.0.0+version: 0.6.1.0 synopsis: Another Haskell web framework for rapid development description: This toolbox provides everything you need to get a quick start into web hacking with haskell: routing, middleware, json, blaze, sessions, cookies, database helper, csrf-protection, global state Homepage: https://github.com/agrafix/Spock
src/Tests.hs view
@@ -3,6 +3,7 @@ import Test.Framework import {-@ HTF_TESTS @-} Tests.Routing+import {-@ HTF_TESTS @-} Tests.Wire main :: IO () main = htfMain htf_importedTests
src/Web/Spock.hs view
@@ -6,8 +6,11 @@ module Web.Spock ( -- * Spock's core spock, SpockM, SpockAction+ , spockT, SpockT, ActionT -- * Defining routes- , get, post, C.head, put, delete, patch, defRoute, Http.StdMethod (..)+ , get, post, C.head, put, delete, patch, defRoute+ , subcomponent, Http.StdMethod (..)+ , combineRoute -- * Handeling requests , request, header, cookie, body, jsonBody, files, UploadedFile (..) , params, param@@ -28,8 +31,6 @@ , safeActionPath -- * Digestive Functors , runForm- -- * Raw Spock- , SpockT, ActionT, spockT -- * Internals for extending Spock , getSpockHeart, runSpockIO, WebStateM, WebState )
src/Web/Spock/Core.hs view
@@ -8,6 +8,7 @@ , files, params, param, setStatus, setHeader, redirect , setCookie, setCookie' , bytes, lazyBytes, text, html, file, json, blaze+ , combineRoute, subcomponent ) where
src/Web/Spock/Wire.hs view
@@ -13,7 +13,6 @@ import Control.Exception import Control.Monad.RWS.Strict import Control.Monad.Reader.Class ()-import Control.Monad.State.Strict import Control.Monad.Trans.Resource import Data.Hashable import Data.Maybe@@ -40,10 +39,13 @@ type SpockRoutingTree m = RoutingTree (ActionT m ()) type SpockTreeMap m = HM.HashMap StdMethod (SpockRoutingTree m) +type SpockRouteMap m = HM.HashMap StdMethod (HM.HashMap T.Text (ActionT m ()))+ data SpockState m = SpockState- { ss_treeMap :: !(SpockTreeMap m)+ { ss_treeMap :: !(SpockRouteMap m) , ss_middleware :: Wai.Middleware+ , ss_spockLift :: forall a. m a -> IO a } data UploadedFile@@ -73,24 +75,19 @@ , rs_responseBody :: ResponseBody } +type BaseRoute = T.Text+ newtype ActionT m a = ActionT { runActionT :: RWST RequestInfo () ResponseState m a } deriving (Monad, Functor, Applicative, MonadIO, MonadTrans, MonadReader RequestInfo, MonadState ResponseState) newtype SpockT (m :: * -> *) a- = SpockT { runSpockT :: StateT (SpockState m) m a }- deriving (Monad, Functor, Applicative, MonadIO, MonadState (SpockState m))+ = SpockT { runSpockT :: RWST BaseRoute () (SpockState m) m a }+ deriving (Monad, Functor, Applicative, MonadIO, MonadReader BaseRoute, MonadState (SpockState m)) instance MonadTrans SpockT where lift = SpockT . lift -initState :: forall (m :: * -> *). SpockState m-initState =- SpockState- { ss_treeMap = HM.empty- , ss_middleware = id- }- respStateToResponse :: ResponseState -> Wai.Response respStateToResponse (ResponseState headers status body) = case body of@@ -135,14 +132,21 @@ -> SpockT m () -> IO Wai.Application buildApp spockLift spockActions =- do spockState <- spockLift $ execStateT (runSpockT spockActions) initState- let app :: Wai.Application+ do let initState =+ SpockState+ { ss_treeMap = HM.empty+ , ss_middleware = id+ , ss_spockLift = spockLift+ }+ (spockState, ()) <- spockLift $ execRWST (runSpockT spockActions) "/" initState+ let routingTreeMap = buildRoutingTree (ss_treeMap spockState)+ app :: Wai.Application app req respond = case parseMethod $ Wai.requestMethod req of Left _ -> respond invalidReq Right stdMethod ->- case HM.lookup stdMethod $ ss_treeMap spockState of+ case HM.lookup stdMethod routingTreeMap of Just routeTree -> case matchRoute' (Wai.pathInfo req) routeTree of Just (captures, action) ->@@ -187,7 +191,57 @@ -- | Define a route matching a provided 'StdMethod' and route defRoute :: (MonadIO m) => StdMethod -> T.Text -> ActionT m () -> SpockT m () defRoute method route action =- modify $ \st -> st { ss_treeMap = HM.insertWith updFun method (addToTree emptyRoutingTree) (ss_treeMap st) }+ do baseRoute <- ask+ let fullRoute = baseRoute `combineRoute` route+ modify $ \st -> st { ss_treeMap = HM.insertWith HM.union method (HM.singleton fullRoute action) (ss_treeMap st) }++-- | Combine two routes, ensuring that the slashes don't get messed up+combineRoute :: T.Text -> T.Text -> T.Text+combineRoute r1 r2 =+ case T.uncons r1 of+ Nothing -> T.concat ["/", r2']+ Just ('/', _) -> T.concat [r1', r2']+ Just _ -> T.concat ["/", r1', r2'] where- updFun _ oldTree = addToTree oldTree- addToTree = addToRoutingTree route action+ r1' =+ if T.last r1 == '/'+ then r1+ else if T.null r2+ then r1+ else T.concat [r1, "/"]+ r2' =+ if T.null r2+ then ""+ else if T.head r2 == '/' then T.drop 1 r2 else r2++-- | Define a subcomponent+--+-- > subcomponent "/api" $+-- > do get "/user" $ text "USER"+-- > post "/new-user" $ text "OK!"+--+-- >>> curl http://localhost:8080/api/user+-- USER+--+subcomponent :: (MonadIO m) => T.Text -> SpockT m () -> SpockT m ()+subcomponent baseRoute defs =+ do parentState <- get+ parentRoute <- ask+ let initState =+ parentState+ { ss_treeMap = HM.empty }+ (finalState, ()) <-+ liftIO $ (ss_spockLift parentState) $+ execRWST (runSpockT defs) (parentRoute `combineRoute` baseRoute) initState+ modify $ \st ->+ st+ { ss_treeMap = HM.union (ss_treeMap st) (ss_treeMap finalState)+ , ss_middleware = (ss_middleware finalState) . (ss_middleware st)+ }++buildRoutingTree :: SpockRouteMap m -> SpockTreeMap m+buildRoutingTree routeMap =+ HM.map (\v -> foldl treeBuilder emptyRoutingTree $ HM.toList v) routeMap+ where+ treeBuilder tree (route, action) =+ addToRoutingTree route action tree