Some parsing fixes (not complete)

This commit is contained in:
Michael Snoyman 2013-03-17 13:35:30 +02:00
parent bca0d24533
commit 2a719941ca
7 changed files with 10 additions and 7 deletions

View File

@ -16,5 +16,4 @@ mkYesodSubData "Auth" [parseRoutes|
/check CheckR GET /check CheckR GET
/login LoginR GET /login LoginR GET
/logout LogoutR GET POST /logout LogoutR GET POST
/page/#Text/*Texts PluginR
|] |]

View File

@ -86,14 +86,13 @@ import Text.Blaze.Html (Html)
import Control.Monad.Logger import Control.Monad.Logger
import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Class (MonadTrans (..))
import Yesod.Core.Internal.Session import Yesod.Core.Internal.Session
import Yesod.Core.Internal.TH (ParseRoute (..))
import Yesod.Core.Class.Yesod import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Dispatch import Yesod.Core.Class.Dispatch
import Yesod.Core.Class.Breadcrumbs import Yesod.Core.Class.Breadcrumbs
import Yesod.Core.Internal.Run (yesodRender, runFakeHandler) import Yesod.Core.Internal.Run (yesodRender, runFakeHandler)
import qualified Paths_yesod_core import qualified Paths_yesod_core
import Data.Version (showVersion) import Data.Version (showVersion)
import Yesod.Routes.Class (RenderRoute (..)) import Yesod.Routes.Class
import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Base (MonadBase (..)) import Control.Monad.Base (MonadBase (..))
import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Control (MonadBaseControl (..))

View File

@ -26,9 +26,6 @@ import Yesod.Routes.Class
import Data.Text (Text) import Data.Text (Text)
import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Char8 as S8
class RenderRoute a => ParseRoute a where
parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route a)
-- | Generates URL datatype and site function for the given 'Resource's. This -- | Generates URL datatype and site function for the given 'Resource's. This
-- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter.
-- Use 'parseRoutes' to create the 'Resource's. -- Use 'parseRoutes' to create the 'Resource's.

View File

@ -53,7 +53,7 @@ import Text.Julius (JavascriptUrl)
import Web.Cookie (SetCookie) import Web.Cookie (SetCookie)
import Yesod.Core.Internal.Util (getTime, putTime) import Yesod.Core.Internal.Util (getTime, putTime)
import Control.Monad.Trans.Class (MonadTrans (..)) import Control.Monad.Trans.Class (MonadTrans (..))
import Yesod.Routes.Class (RenderRoute (..)) import Yesod.Routes.Class (RenderRoute (..), ParseRoute (..))
-- Sessions -- Sessions
type SessionMap = Map Text ByteString type SessionMap = Map Text ByteString
@ -434,3 +434,5 @@ instance RenderRoute WaiSubsite where
data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)] data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]
deriving (Show, Eq, Read, Ord) deriving (Show, Eq, Read, Ord)
renderRoute (WaiSubsiteRoute ps qs) = (ps, qs) renderRoute (WaiSubsiteRoute ps qs) = (ps, qs)
instance ParseRoute WaiSubsite where
parseRoute (x, y) = Just $ WaiSubsiteRoute x y

View File

@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
module Yesod.Routes.Class module Yesod.Routes.Class
( RenderRoute (..) ( RenderRoute (..)
, ParseRoute (..)
) where ) where
import Data.Text (Text) import Data.Text (Text)
@ -10,3 +11,6 @@ class Eq (Route a) => RenderRoute a where
-- | The type-safe URLs associated with a site argument. -- | The type-safe URLs associated with a site argument.
data Route a data Route a
renderRoute :: Route a -> ([Text], [(Text, Text)]) renderRoute :: Route a -> ([Text], [(Text, Text)])
class RenderRoute a => ParseRoute a where
parseRoute :: ([Text], [(Text, Text)]) -> Maybe (Route a)

View File

@ -89,6 +89,7 @@ do
, mdsSetPathInfo = [|\p (_, m) -> (p, m)|] , mdsSetPathInfo = [|\p (_, m) -> (p, m)|]
, mds404 = [|pack "404"|] , mds404 = [|pack "404"|]
, mds405 = [|pack "405"|] , mds405 = [|pack "405"|]
, mdsGetHandler = defaultGetHandler
} resources } resources
return return
$ InstanceD $ InstanceD

View File

@ -116,6 +116,7 @@ do
, mdsSetPathInfo = [|\p (_, m) -> (p, m)|] , mdsSetPathInfo = [|\p (_, m) -> (p, m)|]
, mds404 = [|pack "404"|] , mds404 = [|pack "404"|]
, mds405 = [|pack "405"|] , mds405 = [|pack "405"|]
, mdsGetHandler = defaultGetHandler
} ress } ress
return return
$ InstanceD $ InstanceD