Method "#{A.toText m}" not supported +
Method "#{S8.unpack m}" not supported |] -- | Return the same URL if the user is authorized to see it. @@ -411,7 +413,8 @@ widgetToPageContent (GWidget w) = do jelper :: Julius url -> Hamlet url jelper = fmap jsToHtml - render <- getUrlRenderParams + renderFIXME <- getUrlRenderParams + let render a b = renderFIXME a $ map (TS.pack *** TS.pack) b let renderLoc x = case x of Nothing -> Nothing @@ -462,13 +465,13 @@ yesodVersion = showVersion Paths_yesod_core.version yesodRender :: Yesod y => y -> Route y - -> [(String, String)] - -> String + -> [(Text, Text)] + -> String -- FIXME yesodRender y u qs = - A.toString $ A.fromAsciiBuilder $ + S8.unpack $ toByteString $ fromMaybe - ( joinPath y (A.toAsciiBuilder $ approot y) (map TS.pack ps) - $ map (TS.pack *** TS.pack) $ qs ++ qs') + (joinPath y (fromByteString $ approot y) ps + $ qs ++ qs') (urlRenderOverride y u) where (ps, qs') = renderRoute u diff --git a/Yesod/Dispatch.hs b/Yesod/Dispatch.hs index 1f328a14..d868498d 100644 --- a/Yesod/Dispatch.hs +++ b/Yesod/Dispatch.hs @@ -39,7 +39,6 @@ import Data.ByteString.Lazy.Char8 () import Web.ClientSession import Data.Char (isUpper) -import qualified Data.Text as TS -- | Generates URL datatype and site function for the given 'Resource's. This -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. @@ -175,8 +174,7 @@ toWaiApp' :: (Yesod y, YesodDispatch y y) => y -> Maybe Key -> W.Application -toWaiApp' y key' env = do - let segments = map TS.unpack $ W.pathInfo env - case yesodDispatch y key' segments y id of +toWaiApp' y key' env = + case yesodDispatch y key' (W.pathInfo env) y id of Just app -> app env Nothing -> yesodRunner y y id key' Nothing notFound env diff --git a/Yesod/Handler.hs b/Yesod/Handler.hs index 5da98291..ab576cf6 100644 --- a/Yesod/Handler.hs +++ b/Yesod/Handler.hs @@ -125,7 +125,7 @@ import Control.Failure (Failure (failure)) import Text.Hamlet -import Control.Monad.IO.Peel (MonadPeelIO) +import Control.Monad.IO.Peel (MonadPeelIO) -- FIXME monad-control import Control.Monad.Trans.Peel (MonadTransPeel (peel), liftPeel) import qualified Data.Map as Map import qualified Data.ByteString as S @@ -139,8 +139,12 @@ import Web.Cookie (SetCookie (..), renderSetCookie) import Data.Enumerator (run_, ($$)) import Control.Arrow (second, (***)) import qualified Network.Wai.Parse as NWP -import qualified Data.Ascii as A import Data.Monoid (mappend, mempty) +import qualified Data.ByteString.Char8 as S8 +import Data.CaseInsensitive (CI) +import Blaze.ByteString.Builder (toByteString) +import Data.Text (Text) +import qualified Data.Text as TS -- | The type-safe URLs associated with a site argument. type family Route a @@ -153,7 +157,7 @@ data HandlerData sub master = HandlerData , handlerSub :: sub , handlerMaster :: master , handlerRoute :: Maybe (Route sub) - , handlerRender :: (Route master -> [(String, String)] -> String) -- FIXME replace output String with Ascii + , handlerRender :: (Route master -> [(Text, Text)] -> String) -- FIXME replace output String with Ascii , handlerToMaster :: Route sub -> Route master } @@ -271,8 +275,8 @@ data HandlerContents = HCContent H.Status ChooseRep | HCError ErrorResponse | HCSendFile ContentType FilePath - | HCRedirect RedirectType A.Ascii - | HCCreated A.Ascii + | HCRedirect RedirectType H.Ascii + | HCCreated H.Ascii | HCWai W.Response instance Error HandlerContents where @@ -318,7 +322,7 @@ getUrlRender = do -- | The URL rendering function with query-string parameters. getUrlRenderParams :: Monad m - => GGHandler sub master m (Route master -> [(String, String)] -> String) + => GGHandler sub master m (Route master -> [(Text, Text)] -> String) getUrlRenderParams = handlerRender `liftM` GHandler ask -- | Get the route requested by the user. If this is a 404 response- where the @@ -335,7 +339,7 @@ getRouteToMaster = handlerToMaster `liftM` GHandler ask -- 'GHandler' into an 'W.Application'. Should not be needed by users. runHandler :: HasReps c => GHandler sub master c - -> (Route master -> [(String, String)] -> String) + -> (Route master -> [(Text, Text)] -> String) -> Maybe (Route sub) -> (Route sub -> Route master) -> master @@ -419,14 +423,14 @@ redirect rt url = redirectParams rt url [] -- | Redirects to the given route with the associated query-string parameters. redirectParams :: Monad mo - => RedirectType -> Route master -> [(String, String)] + => RedirectType -> Route master -> [(Text, Text)] -> GGHandler sub master mo a redirectParams rt url params = do r <- getUrlRenderParams - redirectString rt $ A.unsafeFromString $ r url params + redirectString rt $ S8.pack $ r url params -- | Redirect to the given URL. -redirectString :: Monad mo => RedirectType -> A.Ascii -> GGHandler sub master mo a +redirectString :: Monad mo => RedirectType -> H.Ascii -> GGHandler sub master mo a redirectString rt = GHandler . lift . throwError . HCRedirect rt ultDestKey :: String @@ -458,7 +462,8 @@ setUltDest' = do tm <- getRouteToMaster gets' <- reqGetParams `liftM` handlerRequest `liftM` GHandler ask render <- getUrlRenderParams - setUltDestString $ render (tm r) gets' + let renderFIXME a b = render a $ map (TS.pack *** TS.pack) b + setUltDestString $ renderFIXME (tm r) gets' -- | Redirect to the ultimate destination in the user's session. Clear the -- value from the session. @@ -471,7 +476,7 @@ redirectUltDest :: Monad mo redirectUltDest rt def = do mdest <- lookupSession ultDestKey deleteSession ultDestKey - maybe (redirect rt def) (redirectString rt . A.unsafeFromString) mdest + maybe (redirect rt def) (redirectString rt . S8.pack) mdest msgKey :: String msgKey = "_MSG" @@ -516,7 +521,7 @@ sendResponseStatus s = GHandler . lift . throwError . HCContent s sendResponseCreated :: Monad mo => Route m -> GGHandler s m mo a sendResponseCreated url = do r <- getUrlRender - GHandler $ lift $ throwError $ HCCreated $ A.unsafeFromString $ r url + GHandler $ lift $ throwError $ HCCreated $ S8.pack $ r url -- | Send a 'W.Response'. Please note: this function is rarely -- necessary, and will /disregard/ any changes to response headers and session @@ -548,29 +553,29 @@ invalidArgs = failure . InvalidArgs -- | Set the cookie on the client. setCookie :: Monad mo => Int -- ^ minutes to timeout - -> A.Ascii -- ^ key - -> A.Ascii -- ^ value + -> H.Ascii -- ^ key + -> H.Ascii -- ^ value -> GGHandler sub master mo () setCookie a b = addHeader . AddCookie a b -- | Unset the cookie on the client. -deleteCookie :: Monad mo => A.Ascii -> GGHandler sub master mo () +deleteCookie :: Monad mo => H.Ascii -> GGHandler sub master mo () deleteCookie = addHeader . DeleteCookie -- | Set the language in the user session. Will show up in 'languages' on the -- next request. setLanguage :: Monad mo => String -> GGHandler sub master mo () -setLanguage = setSession (A.toString langKey) +setLanguage = setSession $ S8.unpack langKey -- | Set an arbitrary response header. setHeader :: Monad mo - => A.CIAscii -> A.Ascii -> GGHandler sub master mo () + => CI H.Ascii -> H.Ascii -> GGHandler sub master mo () setHeader a = addHeader . Header a -- | Set the Cache-Control header to indicate this response should be cached -- for the given number of seconds. cacheSeconds :: Monad mo => Int -> GGHandler s m mo () -cacheSeconds i = setHeader "Cache-Control" $ A.unsafeFromString $ concat +cacheSeconds i = setHeader "Cache-Control" $ S8.pack $ concat [ "max-age=" , show i , ", public" @@ -588,7 +593,7 @@ alreadyExpired = setHeader "Expires" "Thu, 01 Jan 1970 05:05:05 GMT" -- | Set an Expires header to the given date. expiresAt :: Monad mo => UTCTime -> GGHandler s m mo () -expiresAt = setHeader "Expires" . A.unsafeFromString . formatRFC1123 +expiresAt = setHeader "Expires" . S8.pack . formatRFC1123 -- | Set a variable in the user's session. -- @@ -648,7 +653,7 @@ handlerToYAR :: (HasReps a, HasReps b) => m -- ^ master site foundation -> s -- ^ sub site foundation -> (Route s -> Route m) - -> (Route m -> [(String, String)] -> String) -- ^ url render + -> (Route m -> [(Text, Text)] -> String) -- ^ url render FIXME -> (ErrorResponse -> GHandler s m a) -> Request -> Maybe (Route s) @@ -666,7 +671,7 @@ handlerToYAR y s toMasterRoute render errorHandler rr murl sessionMap h = type HeaderRenderer = [Header] -> ContentType -> SessionMap - -> [(A.CIAscii, A.Ascii)] + -> [(CI H.Ascii, H.Ascii)] yarToResponse :: HeaderRenderer -> YesodAppResult -> W.Response yarToResponse _ (YARWai a) = a @@ -675,12 +680,12 @@ yarToResponse renderHeaders (YARPlain s hs ct c sessionFinal) = ContentBuilder b mlen -> let hs' = maybe finalHeaders finalHeaders' mlen in W.ResponseBuilder s hs' b - ContentFile fp -> W.ResponseFile s finalHeaders fp + ContentFile fp -> W.ResponseFile s finalHeaders fp Nothing -- FIXME handle partial files ContentEnum e -> W.ResponseEnumerator $ \iter -> run_ $ e $$ iter s finalHeaders where finalHeaders = renderHeaders hs ct sessionFinal - finalHeaders' len = ("Content-Length", A.unsafeFromString $ show len) + finalHeaders' len = ("Content-Length", S8.pack $ show len) : finalHeaders {- getExpires m = fromIntegral (m * 60) `addUTCTime` now @@ -711,9 +716,9 @@ httpAccept = parseHttpAccept -- | Convert Header to a key/value pair. headerToPair :: (Int -> UTCTime) -- ^ minutes -> expiration time -> Header - -> (A.CIAscii, A.Ascii) + -> (CI H.Ascii, H.Ascii) headerToPair getExpires (AddCookie minutes key value) = - ("Set-Cookie", A.fromAsciiBuilder $ renderSetCookie $ SetCookie + ("Set-Cookie", toByteString $ renderSetCookie $ SetCookie { setCookieName = key , setCookieValue = value , setCookiePath = Just "/" -- FIXME make a config option, or use approot? @@ -777,7 +782,8 @@ hamletToContent :: Monad mo => Hamlet (Route master) -> GGHandler sub master mo Content hamletToContent h = do render <- getUrlRenderParams - return $ toContent $ h render + let renderFIXME a b = render a $ map (TS.pack *** TS.pack) b + return $ toContent $ h renderFIXME -- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'. hamletToRepHtml :: Monad mo diff --git a/Yesod/Internal.hs b/Yesod/Internal.hs index b9a3e64d..c58855c4 100644 --- a/Yesod/Internal.hs +++ b/Yesod/Internal.hs @@ -51,8 +51,9 @@ import qualified Data.Text.Lazy.Encoding as LT import Data.Typeable (Typeable) import Control.Exception (Exception) -import qualified Data.Ascii as A import qualified Network.HTTP.Types as H +import qualified Network.HTTP.Types as A +import Data.CaseInsensitive (CI) #if GHC7 #define HAMLET hamlet @@ -76,7 +77,7 @@ instance Exception ErrorResponse data Header = AddCookie Int A.Ascii A.Ascii | DeleteCookie A.Ascii - | Header A.CIAscii A.Ascii + | Header (CI A.Ascii) A.Ascii deriving (Eq, Show) langKey :: A.Ascii diff --git a/Yesod/Internal/Dispatch.hs b/Yesod/Internal/Dispatch.hs index 2da55d1b..4c581ccb 100644 --- a/Yesod/Internal/Dispatch.hs +++ b/Yesod/Internal/Dispatch.hs @@ -20,11 +20,11 @@ import Data.Char (toLower) import qualified Data.ByteString as S import Yesod.Core (Yesod (joinPath, approot, cleanPath)) import Network.HTTP.Types (status301) -import qualified Data.Ascii as A import Data.Text (Text) import Data.Monoid (mappend) import qualified Blaze.ByteString.Builder import qualified Blaze.ByteString.Builder.Char8 +import qualified Data.ByteString.Char8 as S8 {-| @@ -83,15 +83,14 @@ sendRedirect :: Yesod master => master -> [Text] -> W.Application sendRedirect y segments' env = return $ W.responseLBS status301 [ ("Content-Type", "text/plain") - , ("Location", A.fromAsciiBuilder dest') + , ("Location", Blaze.ByteString.Builder.toByteString dest') ] "Redirecting" where - dest = joinPath y (A.toAsciiBuilder $ approot y) segments' [] + dest = joinPath y (Blaze.ByteString.Builder.fromByteString $ approot y) segments' [] dest' = if S.null (W.rawQueryString env) then dest - else A.unsafeFromBuilder - (A.toBuilder dest `mappend` + else (dest `mappend` Blaze.ByteString.Builder.Char8.fromChar '?' `mappend` Blaze.ByteString.Builder.fromByteString (W.rawQueryString env)) @@ -154,7 +153,7 @@ mkSimpleExp segments [] frontVars (master, sub, toMasterRoute, mkey, constr, met onSuccess <- newName "onSuccess" req <- newName "req" badMethod' <- [|badMethod|] - rm <- [|A.toString . W.requestMethod|] + rm <- [|S8.unpack . W.requestMethod|] let caseExp = rm `AppE` VarE req yr <- [|yesodRunner|] cr <- [|fmap chooseRep|] @@ -205,11 +204,11 @@ mkSimpleExp segments (SinglePiece _:pieces) frontVars x = do fsp <- [|fromSinglePiece|] let exp' = CaseE (fsp `AppE` VarE next) [ Match - (ConP (mkName "Left") [WildP]) + (ConP (mkName "Nothing") []) (NormalB nothing) [] , Match - (ConP (mkName "Right") [VarP next']) + (ConP (mkName "Just") [VarP next']) (NormalB innerExp) [] ] diff --git a/Yesod/Internal/Request.hs b/Yesod/Internal/Request.hs index d4f1045e..62a14490 100644 --- a/Yesod/Internal/Request.hs +++ b/Yesod/Internal/Request.hs @@ -10,8 +10,8 @@ import Yesod.Internal import qualified Network.Wai as W import System.Random (randomR, newStdGen) import Web.Cookie (parseCookies) -import qualified Data.Ascii as A import Data.Monoid (mempty) +import qualified Data.ByteString.Char8 as S8 parseWaiRequest :: W.Request -> [(String, String)] -- ^ session @@ -24,14 +24,14 @@ parseWaiRequest env session' key' = do $ W.requestHeaders env cookies' = parseCookies reqCookie acceptLang = lookup "Accept-Language" $ W.requestHeaders env - langs = map A.toString $ maybe [] NWP.parseHttpAccept acceptLang - langs' = case lookup (A.toString langKey) session' of + langs = map S8.unpack $ maybe [] NWP.parseHttpAccept acceptLang + langs' = case lookup (S8.unpack langKey) session' of Nothing -> langs Just x -> x : langs langs'' = case lookup langKey cookies' of Nothing -> langs' - Just x -> A.toString x : langs' - langs''' = case lookup (A.toString langKey) gets' of + Just x -> S8.unpack x : langs' + langs''' = case lookup (S8.unpack langKey) gets' of Nothing -> langs'' Just x -> x : langs'' nonce <- case (key', lookup nonceKey session') of diff --git a/Yesod/Internal/Session.hs b/Yesod/Internal/Session.hs index e97e55a5..cb87d96c 100644 --- a/Yesod/Internal/Session.hs +++ b/Yesod/Internal/Session.hs @@ -8,20 +8,19 @@ import Data.Serialize import Data.Time import Data.ByteString (ByteString) import Control.Monad (guard) -import qualified Data.Ascii as A encodeSession :: CS.Key -> UTCTime -- ^ expire time -> ByteString -- ^ remote host -> [(String, String)] -- ^ session - -> A.Ascii -- ^ cookie value + -> ByteString -- ^ cookie value encodeSession key expire rhost session' = CS.encrypt key $ encode $ SessionCookie expire rhost session' decodeSession :: CS.Key -> UTCTime -- ^ current time -> ByteString -- ^ remote host field - -> A.Ascii -- ^ cookie value + -> ByteString -- ^ cookie value -> Maybe [(String, String)] decodeSession key now rhost encrypted = do decrypted <- CS.decrypt key encrypted diff --git a/Yesod/Request.hs b/Yesod/Request.hs index 22efe036..33b4c768 100644 --- a/Yesod/Request.hs +++ b/Yesod/Request.hs @@ -43,7 +43,7 @@ import Control.Monad.IO.Class import Control.Monad (liftM) import Control.Monad.Instances () -- I'm missing the instance Monad ((->) r import Data.Maybe (listToMaybe) -import qualified Data.Ascii as A +import qualified Network.HTTP.Types as A type ParamName = String type ParamValue = String diff --git a/yesod-core.cabal b/yesod-core.cabal index ab052ce8..e5b15f8e 100644 --- a/yesod-core.cabal +++ b/yesod-core.cabal @@ -33,22 +33,22 @@ library , bytestring >= 0.9.1.4 && < 0.10 , text >= 0.5 && < 0.12 , template-haskell - , web-routes-quasi >= 0.6.3.1 && < 0.7 - , hamlet >= 0.7 && < 0.8 - , blaze-builder >= 0.2.1 && < 0.3 + , web-routes-quasi >= 0.7 && < 0.8 + , hamlet >= 0.7.3 && < 0.8 + , blaze-builder >= 0.2.1 && < 0.4 , transformers >= 0.2 && < 0.3 - , clientsession >= 0.5 && < 0.6 + , clientsession >= 0.6 && < 0.7 , random >= 1.0.0.2 && < 1.1 , cereal >= 0.2 && < 0.4 , old-locale >= 1.0.0.2 && < 1.1 , failure >= 0.1 && < 0.2 , containers >= 0.2 && < 0.5 , monad-peel >= 0.1 && < 0.2 - , enumerator >= 0.4 && < 0.5 - , cookie >= 0.1 && < 0.2 + , enumerator >= 0.4.7 && < 0.5 + , cookie >= 0.2 && < 0.3 , blaze-html >= 0.4 && < 0.5 - , ascii >= 0.0.2 && < 0.1 - , http-types >= 0.5 && < 0.6 + , http-types >= 0.6 && < 0.7 + , case-insensitive >= 0.2 && < 0.3 exposed-modules: Yesod.Content Yesod.Core Yesod.Dispatch