Yesod.Internal.Dispatch
This commit is contained in:
Michael Snoyman
parent
24b519ffa4
commit
b9b94bbf8e
@ -28,6 +28,7 @@ module Yesod.Dispatch
|
||||
import Prelude hiding (exp)
|
||||
import Yesod.Core
|
||||
import Yesod.Handler
|
||||
import Yesod.Internal.Dispatch
|
||||
|
||||
import Web.Routes.Quasi
|
||||
import Web.Routes.Quasi.Parse
|
||||
@ -42,14 +43,12 @@ import qualified Data.ByteString.Char8 as B
|
||||
import qualified Data.ByteString as S
|
||||
import Data.ByteString.Lazy.Char8 ()
|
||||
|
||||
import Control.Monad
|
||||
import Web.ClientSession
|
||||
import Data.Char (isUpper, toLower)
|
||||
import Data.Char (isUpper)
|
||||
|
||||
import Web.Routes (decodePathInfo)
|
||||
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Data.List (foldl')
|
||||
|
||||
#if TEST
|
||||
import Test.Framework (testGroup, Test)
|
||||
@ -58,8 +57,6 @@ import Test.QuickCheck
|
||||
import System.IO.Unsafe
|
||||
#endif
|
||||
|
||||
import Yesod.Content
|
||||
|
||||
-- | Generates URL datatype and site function for the given 'Resource's. This
|
||||
-- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
|
||||
-- Use 'parseRoutes' to create the 'Resource's.
|
||||
@ -133,8 +130,7 @@ mkYesodGeneral name args clazzes isSub res = do
|
||||
[ FunD (mkName "renderRoute") render
|
||||
]
|
||||
|
||||
let sortedRes = filter (not . isSubSite) th' ++ filter isSubSite th'
|
||||
yd <- mkYesodDispatch' sortedRes
|
||||
yd <- mkYesodDispatch' th'
|
||||
let master = mkName "master"
|
||||
let ctx = if isSub
|
||||
then ClassP (mkName "Yesod") [VarT master] : clazzes
|
||||
@ -145,195 +141,6 @@ mkYesodGeneral name args clazzes isSub res = do
|
||||
let y = InstanceD ctx ytyp [FunD (mkName "yesodDispatch") [yd]]
|
||||
return ([w, x, x'], [y])
|
||||
|
||||
isSubSite :: ((String, Pieces), a) -> Bool
|
||||
isSubSite ((_, SubSite{}), _) = True
|
||||
isSubSite _ = False
|
||||
|
||||
mkYesodDispatch' :: [((String, Pieces), Maybe String)] -> Q Clause
|
||||
mkYesodDispatch' sortedRes = do
|
||||
sub <- newName "sub"
|
||||
master <- newName "master"
|
||||
mkey <- newName "mkey"
|
||||
segments <- newName "segments"
|
||||
toMasterRoute <- newName "toMasterRoute"
|
||||
nothing <- [|Nothing|]
|
||||
body <- foldM (go master (VarE sub) (VarE toMasterRoute) mkey segments) nothing sortedRes
|
||||
return $ Clause
|
||||
[VarP sub, VarP mkey, VarP segments, VarP master, VarP toMasterRoute]
|
||||
(NormalB body)
|
||||
[]
|
||||
where
|
||||
go master sub toMasterRoute mkey segments onFail ((constr, SubSite { ssPieces = pieces }), Just toSub) = do
|
||||
test <- mkSubsiteExp segments pieces id (master, sub, toMasterRoute, mkey, constr, VarE $ mkName toSub)
|
||||
app <- newName "app"
|
||||
return $ CaseE test
|
||||
[ Match (ConP (mkName "Nothing") []) (NormalB onFail) []
|
||||
, Match (ConP (mkName "Just") [VarP app]) (NormalB $ VarE app) []
|
||||
]
|
||||
go master sub toMasterRoute mkey segments onFail ((constr, Simple pieces methods), Nothing) = do
|
||||
test <- mkSimpleExp (VarE segments) pieces id (master, sub, toMasterRoute, mkey, constr, methods)
|
||||
just <- [|Just|]
|
||||
app <- newName "app"
|
||||
return $ CaseE test
|
||||
[ Match (ConP (mkName "Nothing") []) (NormalB onFail) []
|
||||
, Match (ConP (mkName "Just") [VarP app]) (NormalB $ just `AppE` VarE app) []
|
||||
]
|
||||
go _ _ _ _ _ _ _ = error "Invalid combination"
|
||||
|
||||
mkSimpleExp :: Exp -- ^ segments
|
||||
-> [Piece]
|
||||
-> ([Exp] -> [Exp]) -- ^ variables already parsed
|
||||
-> (Name, Exp, Exp, Name, String, [String]) -- ^ master, sub, toMasterRoute, mkey, constructor, methods
|
||||
-> Q Exp
|
||||
mkSimpleExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, methods) = do
|
||||
just <- [|Just|]
|
||||
nothing <- [|Nothing|]
|
||||
onSuccess <- newName "onSuccess"
|
||||
req <- newName "req"
|
||||
badMethod' <- [|badMethod|]
|
||||
rm <- [|W.requestMethod|]
|
||||
let caseExp = rm `AppE` VarE req
|
||||
yr <- [|yesodRunner|]
|
||||
cr <- [|fmap chooseRep|]
|
||||
let url = foldl' AppE (ConE $ mkName constr) $ frontVars []
|
||||
let runHandlerVars h = runHandler' $ cr `AppE` foldl' AppE (VarE $ mkName h) (frontVars [])
|
||||
runHandler' h = NormalB $ yr `AppE` sub
|
||||
`AppE` VarE master
|
||||
`AppE` toMasterRoute
|
||||
`AppE` VarE mkey
|
||||
`AppE` (just `AppE` url)
|
||||
`AppE` h
|
||||
`AppE` VarE req
|
||||
let match m = Match (LitP $ StringL m) (runHandlerVars $ map toLower m ++ constr) []
|
||||
let clauses =
|
||||
case methods of
|
||||
[] -> [Clause [VarP req] (runHandlerVars $ "handle" ++ constr) []]
|
||||
_ -> [Clause [VarP req] (NormalB $ CaseE caseExp $ map match methods ++
|
||||
[Match WildP (runHandler' badMethod') []]) []]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(ConP (mkName "[]") [])
|
||||
(NormalB $ just `AppE` VarE onSuccess)
|
||||
[FunD onSuccess clauses]
|
||||
, Match
|
||||
WildP
|
||||
(NormalB nothing)
|
||||
[]
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments (StaticPiece s:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
innerExp <- mkSimpleExp (VarE srest) pieces frontVars x
|
||||
nothing <- [|Nothing|]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments (SinglePiece _:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
next' <- newName "next'"
|
||||
innerExp <- mkSimpleExp (VarE srest) pieces (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
next <- newName "next"
|
||||
fsp <- [|fromSinglePiece|]
|
||||
let exp' = CaseE (fsp `AppE` VarE next)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(InfixP (VarP next) (mkName ":") (VarP srest))
|
||||
(NormalB exp')
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments [MultiPiece _] frontVars x = do
|
||||
next' <- newName "next'"
|
||||
srest <- [|[]|]
|
||||
innerExp <- mkSimpleExp srest [] (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
fmp <- [|fromMultiPiece|]
|
||||
let exp = CaseE (fmp `AppE` segments)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp _ (MultiPiece _:_) _ _ = error "MultiPiece must be last piece"
|
||||
|
||||
mkSubsiteExp :: Name -- ^ segments
|
||||
-> [Piece]
|
||||
-> ([Exp] -> [Exp]) -- ^ variables already parsed
|
||||
-> (Name, Exp, Exp, Name, String, Exp) -- ^ master, sub, toMasterRoute, mkey, constructor, toSub
|
||||
-> Q Exp
|
||||
mkSubsiteExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, toSub) = do
|
||||
yd <- [|yesodDispatch|]
|
||||
dot <- [|(.)|]
|
||||
let con = InfixE (Just toMasterRoute) dot $ Just $ foldl' AppE (ConE $ mkName constr) $ frontVars []
|
||||
-- proper handling for sub-subsites
|
||||
let sub' = foldl' AppE (toSub `AppE` sub) $ frontVars []
|
||||
let app = yd `AppE` sub'
|
||||
`AppE` VarE mkey
|
||||
`AppE` VarE segments
|
||||
`AppE` VarE master
|
||||
`AppE` con
|
||||
just <- [|Just|]
|
||||
return $ just `AppE` app
|
||||
mkSubsiteExp _ (MultiPiece _:_) _ _ = error "Subsites cannot have MultiPiece"
|
||||
mkSubsiteExp segments (StaticPiece s:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
innerExp <- mkSubsiteExp srest pieces frontVars x
|
||||
nothing <- [|Nothing|]
|
||||
let exp = CaseE (VarE segments)
|
||||
[ Match
|
||||
(InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSubsiteExp segments (SinglePiece _:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
next' <- newName "next'"
|
||||
innerExp <- mkSubsiteExp srest pieces (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
next <- newName "next"
|
||||
fsp <- [|fromSinglePiece|]
|
||||
let exp' = CaseE (fsp `AppE` VarE next)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
let exp = CaseE (VarE segments)
|
||||
[ Match
|
||||
(InfixP (VarP next) (mkName ":") (VarP srest))
|
||||
(NormalB exp')
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
|
||||
thResourceFromResource :: Resource -> Q (THResource, Maybe String)
|
||||
thResourceFromResource (Resource n ps atts)
|
||||
| all (all isUpper) atts = return ((n, Simple ps atts), Nothing)
|
||||
@ -406,22 +213,6 @@ toWaiApp' y key' env = do
|
||||
, ("Location", dest')
|
||||
] "Redirecting"
|
||||
|
||||
{-
|
||||
defaultDispatchSubsite
|
||||
:: (Yesod m, YesodDispatch m, YesodSubSite s m)
|
||||
=> m -> Maybe Key -> [String]
|
||||
-> (Route s -> Route m)
|
||||
-> s
|
||||
-> W.Application
|
||||
defaultDispatchSubsite y key' segments toMasterRoute s env = error "FIXME" {-
|
||||
case dispatchToSubSubsite y key' segments toMasterRoute s of
|
||||
Just app -> app env
|
||||
Nothing ->
|
||||
case dispatchSubLocal y key' segments toMasterRoute s of
|
||||
Just app -> app env
|
||||
Nothing -> yesodRunner y key' Nothing notFound env-}
|
||||
-}
|
||||
|
||||
#if TEST
|
||||
|
||||
dispatchTestSuite :: Test
|
||||
|
||||
250
Yesod/Internal/Dispatch.hs
Normal file
250
Yesod/Internal/Dispatch.hs
Normal file
@ -0,0 +1,250 @@
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
-- | A bunch of Template Haskell used in the Yesod.Dispatch module.
|
||||
module Yesod.Internal.Dispatch
|
||||
( mkYesodDispatch'
|
||||
) where
|
||||
|
||||
import Prelude hiding (exp)
|
||||
import Language.Haskell.TH.Syntax
|
||||
import Web.Routes.Quasi
|
||||
import Web.Routes.Quasi.Parse
|
||||
import Web.Routes.Quasi.TH
|
||||
import Control.Monad (foldM)
|
||||
import Yesod.Handler (badMethod)
|
||||
import Yesod.Content (chooseRep)
|
||||
import qualified Network.Wai as W
|
||||
import Yesod.Core (yesodRunner, yesodDispatch)
|
||||
import Data.List (foldl')
|
||||
import Data.Char (toLower)
|
||||
|
||||
{-|
|
||||
|
||||
Alright, let's explain how routing works. We want to take a [String] and found
|
||||
out which route it applies to. For static pieces, we need to ensure an exact
|
||||
match against the segment. For a single or multi piece, we need to check the
|
||||
result of fromSinglePiece/fromMultiPiece, respectively.
|
||||
|
||||
We want to create a tree of case statements basically resembling:
|
||||
|
||||
case testRoute1 of
|
||||
Just app -> Just app
|
||||
Nothing ->
|
||||
case testRoute2 of
|
||||
Just app -> Just app
|
||||
Nothing ->
|
||||
case testRoute3 of
|
||||
Just app -> Just app
|
||||
Nothing -> Nothing
|
||||
|
||||
Each testRoute* will look something like this (example of parsing a route /name/#String/age/#Int):
|
||||
|
||||
case segments of
|
||||
"name" : as ->
|
||||
case as of
|
||||
[] -> Nothing
|
||||
b:bs ->
|
||||
case fromSinglePiece b of
|
||||
Left _ -> Nothing
|
||||
Right name ->
|
||||
case bs of
|
||||
"age":cs ->
|
||||
case cs of
|
||||
[] -> Nothing
|
||||
d:ds ->
|
||||
case fromSinglePiece d of
|
||||
Left _ -> Nothing
|
||||
Right age ->
|
||||
case ds of
|
||||
[] -> Just $ yesodRunner (PersonR name age) (getPersonR name age)...
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
_ -> Nothing
|
||||
|
||||
Obviously we would never want to write code by hand like this, but generating it is not too bad.
|
||||
|
||||
This function generates a clause for the yesodDispatch function based on a set of routes.
|
||||
-}
|
||||
mkYesodDispatch' :: [((String, Pieces), Maybe String)] -> Q Clause
|
||||
mkYesodDispatch' res = do
|
||||
sub <- newName "sub"
|
||||
master <- newName "master"
|
||||
mkey <- newName "mkey"
|
||||
segments <- newName "segments"
|
||||
toMasterRoute <- newName "toMasterRoute"
|
||||
nothing <- [|Nothing|]
|
||||
body <- foldM (go master (VarE sub) (VarE toMasterRoute) mkey segments) nothing res
|
||||
return $ Clause
|
||||
[VarP sub, VarP mkey, VarP segments, VarP master, VarP toMasterRoute]
|
||||
(NormalB body)
|
||||
[]
|
||||
where
|
||||
go master sub toMasterRoute mkey segments onFail ((constr, SubSite { ssPieces = pieces }), Just toSub) = do
|
||||
test <- mkSubsiteExp segments pieces id (master, sub, toMasterRoute, mkey, constr, VarE $ mkName toSub)
|
||||
app <- newName "app"
|
||||
return $ CaseE test
|
||||
[ Match (ConP (mkName "Nothing") []) (NormalB onFail) []
|
||||
, Match (ConP (mkName "Just") [VarP app]) (NormalB $ VarE app) []
|
||||
]
|
||||
go master sub toMasterRoute mkey segments onFail ((constr, Simple pieces methods), Nothing) = do
|
||||
test <- mkSimpleExp (VarE segments) pieces id (master, sub, toMasterRoute, mkey, constr, methods)
|
||||
just <- [|Just|]
|
||||
app <- newName "app"
|
||||
return $ CaseE test
|
||||
[ Match (ConP (mkName "Nothing") []) (NormalB onFail) []
|
||||
, Match (ConP (mkName "Just") [VarP app]) (NormalB $ just `AppE` VarE app) []
|
||||
]
|
||||
go _ _ _ _ _ _ _ = error "Invalid combination"
|
||||
|
||||
mkSimpleExp :: Exp -- ^ segments
|
||||
-> [Piece]
|
||||
-> ([Exp] -> [Exp]) -- ^ variables already parsed
|
||||
-> (Name, Exp, Exp, Name, String, [String]) -- ^ master, sub, toMasterRoute, mkey, constructor, methods
|
||||
-> Q Exp
|
||||
mkSimpleExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, methods) = do
|
||||
just <- [|Just|]
|
||||
nothing <- [|Nothing|]
|
||||
onSuccess <- newName "onSuccess"
|
||||
req <- newName "req"
|
||||
badMethod' <- [|badMethod|]
|
||||
rm <- [|W.requestMethod|]
|
||||
let caseExp = rm `AppE` VarE req
|
||||
yr <- [|yesodRunner|]
|
||||
cr <- [|fmap chooseRep|]
|
||||
let url = foldl' AppE (ConE $ mkName constr) $ frontVars []
|
||||
let runHandlerVars h = runHandler' $ cr `AppE` foldl' AppE (VarE $ mkName h) (frontVars [])
|
||||
runHandler' h = NormalB $ yr `AppE` sub
|
||||
`AppE` VarE master
|
||||
`AppE` toMasterRoute
|
||||
`AppE` VarE mkey
|
||||
`AppE` (just `AppE` url)
|
||||
`AppE` h
|
||||
`AppE` VarE req
|
||||
let match m = Match (LitP $ StringL m) (runHandlerVars $ map toLower m ++ constr) []
|
||||
let clauses =
|
||||
case methods of
|
||||
[] -> [Clause [VarP req] (runHandlerVars $ "handle" ++ constr) []]
|
||||
_ -> [Clause [VarP req] (NormalB $ CaseE caseExp $ map match methods ++
|
||||
[Match WildP (runHandler' badMethod') []]) []]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(ConP (mkName "[]") [])
|
||||
(NormalB $ just `AppE` VarE onSuccess)
|
||||
[FunD onSuccess clauses]
|
||||
, Match
|
||||
WildP
|
||||
(NormalB nothing)
|
||||
[]
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments (StaticPiece s:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
innerExp <- mkSimpleExp (VarE srest) pieces frontVars x
|
||||
nothing <- [|Nothing|]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments (SinglePiece _:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
next' <- newName "next'"
|
||||
innerExp <- mkSimpleExp (VarE srest) pieces (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
next <- newName "next"
|
||||
fsp <- [|fromSinglePiece|]
|
||||
let exp' = CaseE (fsp `AppE` VarE next)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
let exp = CaseE segments
|
||||
[ Match
|
||||
(InfixP (VarP next) (mkName ":") (VarP srest))
|
||||
(NormalB exp')
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp segments [MultiPiece _] frontVars x = do
|
||||
next' <- newName "next'"
|
||||
srest <- [|[]|]
|
||||
innerExp <- mkSimpleExp srest [] (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
fmp <- [|fromMultiPiece|]
|
||||
let exp = CaseE (fmp `AppE` segments)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
return exp
|
||||
mkSimpleExp _ (MultiPiece _:_) _ _ = error "MultiPiece must be last piece"
|
||||
|
||||
mkSubsiteExp :: Name -- ^ segments
|
||||
-> [Piece]
|
||||
-> ([Exp] -> [Exp]) -- ^ variables already parsed
|
||||
-> (Name, Exp, Exp, Name, String, Exp) -- ^ master, sub, toMasterRoute, mkey, constructor, toSub
|
||||
-> Q Exp
|
||||
mkSubsiteExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, toSub) = do
|
||||
yd <- [|yesodDispatch|]
|
||||
dot <- [|(.)|]
|
||||
let con = InfixE (Just toMasterRoute) dot $ Just $ foldl' AppE (ConE $ mkName constr) $ frontVars []
|
||||
-- proper handling for sub-subsites
|
||||
let sub' = foldl' AppE (toSub `AppE` sub) $ frontVars []
|
||||
let app = yd `AppE` sub'
|
||||
`AppE` VarE mkey
|
||||
`AppE` VarE segments
|
||||
`AppE` VarE master
|
||||
`AppE` con
|
||||
just <- [|Just|]
|
||||
return $ just `AppE` app
|
||||
mkSubsiteExp _ (MultiPiece _:_) _ _ = error "Subsites cannot have MultiPiece"
|
||||
mkSubsiteExp segments (StaticPiece s:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
innerExp <- mkSubsiteExp srest pieces frontVars x
|
||||
nothing <- [|Nothing|]
|
||||
let exp = CaseE (VarE segments)
|
||||
[ Match
|
||||
(InfixP (LitP $ StringL s) (mkName ":") (VarP srest))
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
mkSubsiteExp segments (SinglePiece _:pieces) frontVars x = do
|
||||
srest <- newName "segments"
|
||||
next' <- newName "next'"
|
||||
innerExp <- mkSubsiteExp srest pieces (frontVars . (:) (VarE next')) x
|
||||
nothing <- [|Nothing|]
|
||||
next <- newName "next"
|
||||
fsp <- [|fromSinglePiece|]
|
||||
let exp' = CaseE (fsp `AppE` VarE next)
|
||||
[ Match
|
||||
(ConP (mkName "Left") [WildP])
|
||||
(NormalB nothing)
|
||||
[]
|
||||
, Match
|
||||
(ConP (mkName "Right") [VarP next'])
|
||||
(NormalB innerExp)
|
||||
[]
|
||||
]
|
||||
let exp = CaseE (VarE segments)
|
||||
[ Match
|
||||
(InfixP (VarP next) (mkName ":") (VarP srest))
|
||||
(NormalB exp')
|
||||
[]
|
||||
, Match WildP (NormalB nothing) []
|
||||
]
|
||||
return exp
|
||||
@ -57,6 +57,7 @@ library
|
||||
other-modules: Yesod.Internal
|
||||
Yesod.Internal.Session
|
||||
Yesod.Internal.Request
|
||||
Yesod.Internal.Dispatch
|
||||
Paths_yesod_core
|
||||
ghc-options: -Wall -Werror
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user