haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Simplified Dispatch: do not pass req around

Browse Source
This commit is contained in:
Michael Snoyman 2012-01-01 18:11:22 +02:00
parent 144b215a38
commit 6d6c4817b2
2 changed files with 32 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
yesod-routes/Yesod/Routes/Dispatch.lhs
View File

@ -41,12 +41,12 @@ will want to match integers, or slugs, or some other limited format. This
brings us nicely to the dispatch function. Each route provides a function of brings us nicely to the dispatch function. Each route provides a function of
type: type:
> type Dispatch req res = [Text] -> req -> Maybe res > type Dispatch res = [Text] -> Maybe res
The req and res arguments are application-specific. For example, in a simple The res argument is application-specific. For example, in a simple
WAI application, they could be the Request and Respone datatypes. The important WAI application, it could be the Application datatype. The important
thing to point out about Dispatch is that is takes a list of 'Text's and thing to point out about Dispatch is that is takes a list of 'Text's and
returns its response in a Maybe. This gives you a chance to having returns its response in a Maybe. This gives you a chance to have
finer-grained control over how individual components are parsed. If you don't finer-grained control over how individual components are parsed. If you don't
want to deal with it, you return 'Nothing' and routing continues. want to deal with it, you return 'Nothing' and routing continues.
@ -55,16 +55,16 @@ module handles that for you automatically.
So each route is specified by: So each route is specified by:
> data Route req res = Route > data Route res = Route
> { rhPieces :: [Piece] > { rhPieces :: [Piece]
> , rhHasMulti :: Bool > , rhHasMulti :: Bool
> , rhDispatch :: Dispatch req res > , rhDispatch :: Dispatch res
> } > }
Your application needs to provide this moudle with a list of routes, and then Your application needs to provide this moudle with a list of routes, and then
this module will give you back a new dispatch function. In other words: this module will give you back a new dispatch function. In other words:
> toDispatch :: [Route req res] -> Dispatch req res > toDispatch :: [Route res] -> Dispatch res
> toDispatch rhs = > toDispatch rhs =
> bcToDispatch bc > bcToDispatch bc
> where > where
@ -98,9 +98,9 @@ application), 1 - *max(n)* groups, and a final extra group containing all
routes that can match more than *max(n)* components. This group will consist of routes that can match more than *max(n)* components. This group will consist of
all the routes with rhHasMulti, and only those routes. all the routes with rhHasMulti, and only those routes.
> data ByCount req res = ByCount > data ByCount res = ByCount
> { bcVector :: !(V.Vector (PieceMap req res)) > { bcVector :: !(V.Vector (PieceMap res))
> , bcRest :: !(PieceMap req res) > , bcRest :: !(PieceMap res)
> } > }
We haven't covered PieceMap yet; it is used for the second optimization. We'll We haven't covered PieceMap yet; it is used for the second optimization. We'll
@ -109,7 +109,7 @@ discuss it below.
The following function breaks up a list of routes into groups. Again, please The following function breaks up a list of routes into groups. Again, please
ignore the PieceMap references for the moment. ignore the PieceMap references for the moment.
> toBC :: [Route req res] -> ByCount req res > toBC :: [Route res] -> ByCount res
> toBC rhs = > toBC rhs =
> ByCount > ByCount
> { bcVector = groups > { bcVector = groups
@ -135,7 +135,7 @@ have rhHasMulti set to True.
> groups = V.map group $ V.enumFromN 0 (maxLen + 1) > groups = V.map group $ V.enumFromN 0 (maxLen + 1)
> group i = toPieceMap i $ filter (canHaveLength i) rhs > group i = toPieceMap i $ filter (canHaveLength i) rhs
> >
> canHaveLength :: Int -> Route req res -> Bool > canHaveLength :: Int -> Route res -> Bool
> canHaveLength i rh = > canHaveLength i rh =
> len == i || (len < i && rhHasMulti rh) > len == i || (len < i && rhHasMulti rh)
> where > where
@ -190,10 +190,10 @@ What we need is then two extra features on our datatype:
What we end up with is: What we end up with is:
> data PieceMap req res = PieceMap > data PieceMap res = PieceMap
> { pmDynamic :: PieceMap req res > { pmDynamic :: PieceMap res
> , pmStatic :: Map.Map Text (PieceMap req res) > , pmStatic :: Map.Map Text (PieceMap res)
> } | PieceMapEnd [(Int, Dispatch req res)] > } | PieceMapEnd [(Int, Dispatch res)]
Note that the PieceMapEnd is a list of pairs, including an Int. Since the map Note that the PieceMapEnd is a list of pairs, including an Int. Since the map
process will confuse the original order of our routes, we need some way to get process will confuse the original order of our routes, we need some way to get
@ -203,12 +203,12 @@ We'll need two pieces of information to make a PieceMap: the depth to drill
down to, and the routes in the current group. We'll immediately zip up those down to, and the routes in the current group. We'll immediately zip up those
routes with an Int to indicate route priority. routes with an Int to indicate route priority.
> toPieceMap :: Int -> [Route req res] -> PieceMap req res > toPieceMap :: Int -> [Route res] -> PieceMap res
> toPieceMap depth = toPieceMap' depth . zip [1..] > toPieceMap depth = toPieceMap' depth . zip [1..]
> >
> toPieceMap' :: Int > toPieceMap' :: Int
> -> [(Int, Route req res)] > -> [(Int, Route res)]
> -> PieceMap req res > -> PieceMap res
The stopping case: we've exhausted the full depth, so let's put together a The stopping case: we've exhausted the full depth, so let's put together a
PieceMapEnd. Technically speaking, the sort here is unnecessary, since we'll PieceMapEnd. Technically speaking, the sort here is unnecessary, since we'll
@ -260,8 +260,8 @@ appropriate here, since it would only keep one route per Text.
The time has come to actually dispatch. The time has come to actually dispatch.
> bcToDispatch :: ByCount req res -> Dispatch req res > bcToDispatch :: ByCount res -> Dispatch res
> bcToDispatch (ByCount vec rest) ts0 req = > bcToDispatch (ByCount vec rest) ts0 =
> bcToDispatch' ts0 pm0 > bcToDispatch' ts0 pm0
> where > where
@ -274,7 +274,7 @@ Stopping case: we've found our list of routes. Sort them, then starting
applying their dispatch functions. If the first one returns Nothing, go to the applying their dispatch functions. If the first one returns Nothing, go to the
next, and so on. next, and so on.
> bcToDispatch' _ (PieceMapEnd r) = firstJust (\f -> f ts0 req) $ map snd r > bcToDispatch' _ (PieceMapEnd r) = firstJust (\f -> f ts0) $ map snd r
For each component, get the static PieceMap and the dynamic one, combine them For each component, get the static PieceMap and the dynamic one, combine them
together, and then continue dispatching. together, and then continue dispatching.
@ -296,7 +296,7 @@ Helper function: get the first Just response.
Combine two PieceMaps together. Combine two PieceMaps together.
> append :: PieceMap a b -> PieceMap a b -> PieceMap a b > append :: PieceMap res -> PieceMap res -> PieceMap res
At the end, just combine the list of routes. But we combine them in such a way At the end, just combine the list of routes. But we combine them in such a way
so as to preserve their order. Since a and b come presorted (as mentioned so as to preserve their order. Since a and b come presorted (as mentioned

18
yesod-routes/test/main.hs
View File

@ -14,27 +14,27 @@ import Yesod.Routes.TH hiding (Dispatch)
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import qualified Data.Map as Map import qualified Data.Map as Map
result :: ([Text] -> Maybe Int) -> Dispatch () Int result :: ([Text] -> Maybe Int) -> Dispatch Int
result f ts () = f ts result f ts = f ts
justRoot :: Dispatch () Int justRoot :: Dispatch Int
justRoot = toDispatch justRoot = toDispatch
[ Route [] False $ result $ const $ Just 1 [ Route [] False $ result $ const $ Just 1
] ]
twoStatics :: Dispatch () Int twoStatics :: Dispatch Int
twoStatics = toDispatch twoStatics = toDispatch
[ Route [D.Static "foo"] False $ result $ const $ Just 2 [ Route [D.Static "foo"] False $ result $ const $ Just 2
, Route [D.Static "bar"] False $ result $ const $ Just 3 , Route [D.Static "bar"] False $ result $ const $ Just 3
] ]
multi :: Dispatch () Int multi :: Dispatch Int
multi = toDispatch multi = toDispatch
[ Route [D.Static "foo"] False $ result $ const $ Just 4 [ Route [D.Static "foo"] False $ result $ const $ Just 4
, Route [D.Static "bar"] True $ result $ const $ Just 5 , Route [D.Static "bar"] True $ result $ const $ Just 5
] ]
dynamic :: Dispatch () Int dynamic :: Dispatch Int
dynamic = toDispatch dynamic = toDispatch
[ Route [D.Static "foo"] False $ result $ const $ Just 6 [ Route [D.Static "foo"] False $ result $ const $ Just 6
, Route [D.Dynamic] False $ result $ \ts -> , Route [D.Dynamic] False $ result $ \ts ->
@ -46,15 +46,15 @@ dynamic = toDispatch
_ -> error $ "Called dynamic with: " ++ show ts _ -> error $ "Called dynamic with: " ++ show ts
] ]
overlap :: Dispatch () Int overlap :: Dispatch Int
overlap = toDispatch overlap = toDispatch
[ Route [D.Static "foo"] False $ result $ const $ Just 20 [ Route [D.Static "foo"] False $ result $ const $ Just 20
, Route [D.Static "foo"] True $ result $ const $ Just 21 , Route [D.Static "foo"] True $ result $ const $ Just 21
, Route [] True $ result $ const $ Just 22 , Route [] True $ result $ const $ Just 22
] ]
test :: Dispatch () Int -> [Text] -> Maybe Int test :: Dispatch Int -> [Text] -> Maybe Int
test dispatch ts = dispatch ts () test dispatch ts = dispatch ts
data MyApp = MyApp data MyApp = MyApp