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

Renamed Routes to Route

Browse Source
This commit is contained in:
Michael Snoyman 2010-07-06 20:17:00 +03:00
parent 32ef86c295
commit 5d8ee5e7fb
11 changed files with 72 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Yesod/Dispatch.hs
View File

@ -141,9 +141,9 @@ mkYesodGeneral name args clazzes isSub res = do
$ map (\x -> (x, [])) ("master" : args) ++ clazzes
th <- mapM (thResourceFromResource arg) res -- FIXME now we cannot have multi-nested subsites
w' <- createRoutes th
let routesName = mkName $ name ++ "Routes"
let routesName = mkName $ name ++ "Route"
let w = DataD [] routesName [] w' [''Show, ''Read, ''Eq]
let x = TySynInstD ''Routes [arg] $ ConT routesName
let x = TySynInstD ''Route [arg] $ ConT routesName
parse' <- createParse th
parse'' <- newName "parse"
@ -189,7 +189,7 @@ thResourceFromResource master (Resource n ps atts@[stype, toSubArg])
(ConT ''GHandler `AppT` stype' `AppT` master `AppT`
ConT ''ChooseRep)
let typ = ConT ''Site `AppT`
(ConT ''Routes `AppT` stype') `AppT`
(ConT ''Route `AppT` stype') `AppT`
(ArrowT `AppT` ConT ''String `AppT` inside)
let gss' = gss `SigE` typ
parse' <- [|parsePathSegments|]
@ -199,7 +199,7 @@ thResourceFromResource master (Resource n ps atts@[stype, toSubArg])
dispatch' <- [|flip handleSite (error "Cannot use subsite render function")|]
let dispatch = dispatch' `AppE` gss'
return (n, SubSite
{ ssType = ConT ''Routes `AppT` stype'
{ ssType = ConT ''Route `AppT` stype'
, ssParse = parse
, ssRender = render
, ssDispatch = dispatch

2
Yesod/Form.hs
View File

@ -224,7 +224,7 @@ optionalFieldHelper (FieldProfile parse render mkXml w) label tooltip orig' =
data FieldProfile sub y a = FieldProfile
{ fpParse :: String -> Either String a
, fpRender :: a -> String
, fpHamlet :: Html () -> Html () -> Bool -> Hamlet (Routes y)
, fpHamlet :: Html () -> Html () -> Bool -> Hamlet (Route y)
, fpWidget :: String -> GWidget sub y ()
}

4
Yesod/Hamlet.hs
View File

@ -30,11 +30,11 @@ data PageContent url = PageContent
-- | Converts the given Hamlet template into 'Content', which can be used in a
-- Yesod 'Response'.
hamletToContent :: Hamlet (Routes master) -> GHandler sub master Content
hamletToContent :: Hamlet (Route master) -> GHandler sub master Content
hamletToContent h = do
render <- getUrlRender
return $ toContent $ renderHamlet render h
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml
hamletToRepHtml :: Hamlet (Route master) -> GHandler sub master RepHtml
hamletToRepHtml = fmap RepHtml . hamletToContent

44
Yesod/Handler.hs
View File

@ -22,7 +22,7 @@
---------------------------------------------------------
module Yesod.Handler
( -- * Type families
Routes
Route
-- * Handler monad
, Handler
, GHandler
@ -30,7 +30,7 @@ module Yesod.Handler
, getYesod
, getYesodSub
, getUrlRender
, getRoute
, getCurrentRoute
, getRouteToMaster
-- * Special responses
-- ** Redirecting
@ -96,20 +96,20 @@ import Numeric (showIntAtBase)
import Data.Char (ord, chr)
-- | The type-safe URLs associated with a site argument.
type family Routes a
type family Route a
data HandlerData sub master = HandlerData
{ handlerRequest :: Request
, handlerSub :: sub
, handlerMaster :: master
, handlerRoute :: Maybe (Routes sub)
, handlerRender :: (Routes master -> String)
, handlerToMaster :: Routes sub -> Routes master
, handlerRoute :: Maybe (Route sub)
, handlerRender :: (Route master -> String)
, handlerToMaster :: Route sub -> Route master
}
handlerSubData :: (Routes sub -> Routes master)
handlerSubData :: (Route sub -> Route master)
-> (master -> sub)
-> Routes sub
-> Route sub
-> HandlerData oldSub master
-> HandlerData sub master
handlerSubData tm ts route hd = hd
@ -120,9 +120,9 @@ handlerSubData tm ts route hd = hd
-- | Used internally for promoting subsite handler functions to master site
-- handler functions. Should not be needed by users.
toMasterHandler :: (Routes sub -> Routes master)
toMasterHandler :: (Route sub -> Route master)
-> (master -> sub)
-> Routes sub
-> Route sub
-> GHandler sub master a
-> Handler master a
toMasterHandler tm ts route (GHandler h) =
@ -181,17 +181,17 @@ getYesod :: GHandler sub master master
getYesod = handlerMaster <$> GHandler ask
-- | Get the URL rendering function.
getUrlRender :: GHandler sub master (Routes master -> String)
getUrlRender :: GHandler sub master (Route master -> String)
getUrlRender = handlerRender <$> GHandler ask
-- | Get the route requested by the user. If this is a 404 response- where the
-- user requested an invalid route- this function will return 'Nothing'.
getRoute :: GHandler sub master (Maybe (Routes sub))
getRoute = handlerRoute <$> GHandler ask
getCurrentRoute :: GHandler sub master (Maybe (Route sub))
getCurrentRoute = handlerRoute <$> GHandler ask
-- | Get the function to promote a route for a subsite to a route for the
-- master site.
getRouteToMaster :: GHandler sub master (Routes sub -> Routes master)
getRouteToMaster :: GHandler sub master (Route sub -> Route master)
getRouteToMaster = handlerToMaster <$> GHandler ask
modifySession :: [(String, String)] -> (String, Maybe String)
@ -208,9 +208,9 @@ dropKeys k = filter $ \(x, _) -> x /= k
-- 'GHandler' into an 'W.Application'. Should not be needed by users.
runHandler :: HasReps c
=> GHandler sub master c
-> (Routes master -> String)
-> Maybe (Routes sub)
-> (Routes sub -> Routes master)
-> (Route master -> String)
-> Maybe (Route sub)
-> (Route sub -> Route master)
-> master
-> (master -> sub)
-> YesodApp
@ -260,11 +260,11 @@ safeEh er = YesodApp $ \_ _ _ -> do
return (W.Status500, [], typePlain, toContent "Internal Server Error", [])
-- | Redirect to the given route.
redirect :: RedirectType -> Routes master -> GHandler sub master a
redirect :: RedirectType -> Route master -> GHandler sub master a
redirect rt url = redirectParams rt url []
-- | Redirects to the given route with the associated query-string parameters.
redirectParams :: RedirectType -> Routes master -> [(String, String)]
redirectParams :: RedirectType -> Route master -> [(String, String)]
-> GHandler sub master a
redirectParams rt url params = do
r <- getUrlRender
@ -302,7 +302,7 @@ ultDestKey = "_ULT"
--
-- An ultimate destination is stored in the user session and can be loaded
-- later by 'redirectUltDest'.
setUltDest :: Routes master -> GHandler sub master ()
setUltDest :: Route master -> GHandler sub master ()
setUltDest dest = do
render <- getUrlRender
setUltDestString $ render dest
@ -317,7 +317,7 @@ setUltDestString = setSession ultDestKey
-- nothing.
setUltDest' :: GHandler sub master ()
setUltDest' = do
route <- getRoute
route <- getCurrentRoute
tm <- getRouteToMaster
maybe (return ()) setUltDest $ tm <$> route
@ -326,7 +326,7 @@ setUltDest' = do
--
-- The ultimate destination is set with 'setUltDest'.
redirectUltDest :: RedirectType
-> Routes master -- ^ default destination if nothing in session
-> Route master -- ^ default destination if nothing in session
-> GHandler sub master ()
redirectUltDest rt def = do
mdest <- lookupSession ultDestKey

2
Yesod/Helpers/AtomFeed.hs
View File

@ -29,7 +29,7 @@ newtype RepAtom = RepAtom Content
instance HasReps RepAtom where
chooseRep (RepAtom c) _ = return (typeAtom, c)
atomFeed :: AtomFeed (Routes master) -> GHandler sub master RepAtom
atomFeed :: AtomFeed (Route master) -> GHandler sub master RepAtom
atomFeed = fmap RepAtom . hamletToContent . template
data AtomFeed url = AtomFeed

6
Yesod/Helpers/Auth.hs
View File

@ -22,7 +22,7 @@
module Yesod.Helpers.Auth
( -- * Subsite
Auth (..)
, AuthRoutes (..)
, AuthRoute (..)
-- * Settings
, YesodAuth (..)
, Creds (..)
@ -55,10 +55,10 @@ import Data.Object
class Yesod master => YesodAuth master where
-- | Default destination on successful login or logout, if no other
-- destination exists.
defaultDest :: master -> Routes master
defaultDest :: master -> Route master
-- | Default page to redirect user to for logging in.
defaultLoginRoute :: master -> Routes master
defaultLoginRoute :: master -> Route master
-- | Callback for a successful login.
--

2
Yesod/Helpers/Crud.hs
View File

@ -6,7 +6,7 @@
module Yesod.Helpers.Crud
( Item (..)
, Crud (..)
, CrudRoutes (..)
, CrudRoute (..)
, defaultCrud
) where

4
Yesod/Helpers/Sitemap.hs
View File

@ -61,11 +61,11 @@ template urls = [$hamlet|
%priority $show.priority.url$
|]
sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml
sitemap :: [SitemapUrl (Route master)] -> GHandler sub master RepXml
sitemap = fmap RepXml . hamletToContent . template
-- | A basic robots file which just lists the "Sitemap: " line.
robots :: Routes sub -- ^ sitemap url
robots :: Route sub -- ^ sitemap url
-> GHandler sub master RepPlain
robots smurl = do
tm <- getRouteToMaster

4
Yesod/Helpers/Static.hs
View File

@ -27,7 +27,7 @@
module Yesod.Helpers.Static
( -- * Subsite
Static (..)
, StaticRoutes (..)
, StaticRoute (..)
-- * Lookup files in filesystem
, fileLookupDir
, staticFiles
@ -127,7 +127,7 @@ staticFiles fp = do
f' <- lift f
let sr = ConE $ mkName "StaticRoute"
return
[ SigD name $ ConT ''Routes `AppT` ConT ''Static
[ SigD name $ ConT ''Route `AppT` ConT ''Static
, FunD name
[ Clause [] (NormalB $ sr `AppE` f') []
]

32
Yesod/Widget.hs
View File

@ -30,7 +30,7 @@ import Data.Monoid
import Control.Monad.Trans.Writer
import Control.Monad.Trans.State
import Yesod.Hamlet (Hamlet, hamlet, PageContent (..), Html)
import Yesod.Handler (Routes, GHandler)
import Yesod.Handler (Route, GHandler)
import Yesod.Yesod (Yesod, defaultLayout)
import Yesod.Content (RepHtml (..))
import Control.Applicative (Applicative)
@ -66,12 +66,12 @@ newtype Body url = Body (Hamlet url)
deriving Monoid
newtype GWidget sub master a = GWidget (
WriterT (Body (Routes master)) (
WriterT (Body (Route master)) (
WriterT (Last Title) (
WriterT (UniqueList (Script (Routes master))) (
WriterT (UniqueList (Stylesheet (Routes master))) (
WriterT (Style (Routes master)) (
WriterT (Head (Routes master)) (
WriterT (UniqueList (Script (Route master))) (
WriterT (UniqueList (Stylesheet (Route master))) (
WriterT (Style (Route master)) (
WriterT (Head (Route master)) (
StateT Int (
GHandler sub master
))))))) a)
@ -84,10 +84,10 @@ type Widget y = GWidget y y
setTitle :: Html () -> GWidget sub master ()
setTitle = GWidget . lift . tell . Last . Just . Title
addHead :: Hamlet (Routes master) -> GWidget sub master ()
addHead :: Hamlet (Route master) -> GWidget sub master ()
addHead = GWidget . lift . lift . lift . lift . lift . tell . Head
addBody :: Hamlet (Routes master) -> GWidget sub master ()
addBody :: Hamlet (Route master) -> GWidget sub master ()
addBody = GWidget . tell . Body
newIdent :: GWidget sub master String
@ -97,30 +97,30 @@ newIdent = GWidget $ lift $ lift $ lift $ lift $ lift $ lift $ do
put i'
return $ "w" ++ show i'
addStyle :: Hamlet (Routes master) -> GWidget sub master ()
addStyle :: Hamlet (Route master) -> GWidget sub master ()
addStyle = GWidget . lift . lift . lift . lift . tell . Style
addStylesheet :: Routes master -> GWidget sub master ()
addStylesheet :: Route master -> GWidget sub master ()
addStylesheet = GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Local
addStylesheetRemote :: String -> GWidget sub master ()
addStylesheetRemote =
GWidget . lift . lift . lift . tell . toUnique . Stylesheet . Remote
addScript :: Routes master -> GWidget sub master ()
addScript :: Route master -> GWidget sub master ()
addScript = GWidget . lift . lift . tell . toUnique . Script . Local
addScriptRemote :: String -> GWidget sub master ()
addScriptRemote =
GWidget . lift . lift . tell . toUnique . Script . Remote
applyLayoutW :: (Eq (Routes m), Yesod m)
applyLayoutW :: (Eq (Route m), Yesod m)
=> GWidget sub m () -> GHandler sub m RepHtml
applyLayoutW w = widgetToPageContent w >>= fmap RepHtml . defaultLayout
widgetToPageContent :: Eq (Routes master)
widgetToPageContent :: Eq (Route master)
=> GWidget sub master ()
-> GHandler sub master (PageContent (Routes master))
-> GHandler sub master (PageContent (Route master))
widgetToPageContent (GWidget w) = do
w' <- flip evalStateT 0
$ runWriterT $ runWriterT $ runWriterT $ runWriterT
@ -148,14 +148,14 @@ $forall stylesheets s
return $ PageContent title head'' body
wrapWidget :: GWidget s m a
-> (Hamlet (Routes m) -> Hamlet (Routes m))
-> (Hamlet (Route m) -> Hamlet (Route m))
-> GWidget s m a
wrapWidget (GWidget w) wrap =
GWidget $ mapWriterT (fmap go) w
where
go (a, Body h) = (a, Body $ wrap h)
extractBody :: GWidget s m () -> GWidget s m (Hamlet (Routes m))
extractBody :: GWidget s m () -> GWidget s m (Hamlet (Route m))
extractBody (GWidget w) =
GWidget $ mapWriterT (fmap go) w
where

36
Yesod/Yesod.hs
View File

@ -41,18 +41,18 @@ import Web.Routes.Site (Site)
-- | This class is automatically instantiated when you use the template haskell
-- mkYesod function. You should never need to deal with it directly.
class Eq (Routes y) => YesodSite y where
getSite :: Site (Routes y) (Method -> Maybe (Handler y ChooseRep))
class Eq (Route y) => YesodSite y where
getSite :: Site (Route y) (Method -> Maybe (Handler y ChooseRep))
type Method = String
-- | Same as 'YesodSite', but for subsites. Once again, users should not need
-- to deal with it directly, as the mkYesodSub creates instances appropriately.
class Eq (Routes s) => YesodSubSite s y where
getSubSite :: Site (Routes s) (Method -> Maybe (GHandler s y ChooseRep))
class Eq (Route s) => YesodSubSite s y where
getSubSite :: Site (Route s) (Method -> Maybe (GHandler s y ChooseRep))
-- | Define settings for a Yesod applications. The only required setting is
-- 'approot'; other than that, there are intelligent defaults.
class Eq (Routes a) => Yesod a where
class Eq (Route a) => Yesod a where
-- | An absolute URL to the root of the application. Do not include
-- trailing slash.
--
@ -79,7 +79,7 @@ class Eq (Routes a) => Yesod a where
errorHandler = defaultErrorHandler
-- | Applies some form of layout to the contents of a page.
defaultLayout :: PageContent (Routes a) -> GHandler sub a Content
defaultLayout :: PageContent (Route a) -> GHandler sub a Content
defaultLayout p = hamletToContent [$hamlet|
!!!
%html
@ -97,7 +97,7 @@ class Eq (Routes a) => Yesod a where
-- | Override the rendering function for a particular URL. One use case for
-- this is to offload static hosting to a different domain name to avoid
-- sending cookies.
urlRenderOverride :: a -> Routes a -> Maybe String
urlRenderOverride :: a -> Route a -> Maybe String
urlRenderOverride _ _ = Nothing
-- | Determine if a request is authorized or not.
@ -105,14 +105,14 @@ class Eq (Routes a) => Yesod a where
-- Return 'Nothing' is the request is authorized, 'Just' a message if
-- unauthorized. If authentication is required, you should use a redirect;
-- the Auth helper provides this functionality automatically.
isAuthorized :: Routes a -> GHandler s a AuthResult
isAuthorized :: Route a -> GHandler s a AuthResult
isAuthorized _ = return Authorized
-- | The default route for authentication.
--
-- Used in particular by 'isAuthorized', but library users can do whatever
-- they want with it.
authRoute :: a -> Maybe (Routes a)
authRoute :: a -> Maybe (Route a)
authRoute _ = Nothing
data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
@ -124,13 +124,13 @@ data AuthResult = Authorized | AuthenticationRequired | Unauthorized String
class YesodBreadcrumbs y where
-- | Returns the title and the parent resource, if available. If you return
-- a 'Nothing', then this is considered a top-level page.
breadcrumb :: Routes y -> GHandler sub y (String, Maybe (Routes y))
breadcrumb :: Route y -> GHandler sub y (String, Maybe (Route y))
-- | Gets the title of the current page and the hierarchy of parent pages,
-- along with their respective titles.
breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (String, [(Routes y, String)])
breadcrumbs :: YesodBreadcrumbs y => GHandler sub y (String, [(Route y, String)])
breadcrumbs = do
x' <- getRoute
x' <- getCurrentRoute
tm <- getRouteToMaster
let x = fmap tm x'
case x of
@ -148,8 +148,8 @@ breadcrumbs = do
-- | Apply the default layout ('defaultLayout') to the given title and body.
applyLayout :: Yesod master
=> String -- ^ title
-> Hamlet (Routes master) -- ^ head
-> Hamlet (Routes master) -- ^ body
-> Hamlet (Route master) -- ^ head
-> Hamlet (Route master) -- ^ body
-> GHandler sub master RepHtml
applyLayout t h b =
RepHtml `fmap` defaultLayout PageContent
@ -162,8 +162,8 @@ applyLayout t h b =
-- the default layout for the HTML output ('defaultLayout').
applyLayoutJson :: Yesod master
=> String -- ^ title
-> Hamlet (Routes master) -- ^ head
-> Hamlet (Routes master) -- ^ body
-> Hamlet (Route master) -- ^ head
-> Hamlet (Route master) -- ^ body
-> Json
-> GHandler sub master RepHtmlJson
applyLayoutJson t h html json = do
@ -177,7 +177,7 @@ applyLayoutJson t h html json = do
applyLayout' :: Yesod master
=> String -- ^ title
-> Hamlet (Routes master) -- ^ body
-> Hamlet (Route master) -- ^ body
-> GHandler sub master ChooseRep
applyLayout' s = fmap chooseRep . applyLayout s mempty
@ -222,7 +222,7 @@ class YesodPersist y where
--
-- Built on top of 'isAuthorized'. This is useful for building page that only
-- contain links to pages the user is allowed to see.
maybeAuthorized :: Yesod a => Routes a -> GHandler s a (Maybe (Routes a))
maybeAuthorized :: Yesod a => Route a -> GHandler s a (Maybe (Route a))
maybeAuthorized r = do
x <- isAuthorized r
return $ if x == Authorized then Just r else Nothing