Removed web-encodings dependency

This commit is contained in:
Michael Snoyman 2010-05-20 22:21:26 +03:00
parent aa770f7622
commit 712110a2ef
8 changed files with 62 additions and 17 deletions

View File

@ -30,6 +30,8 @@ module Yesod.Content
, RepHtmlJson (..) , RepHtmlJson (..)
, RepPlain (..) , RepPlain (..)
, RepXml (..) , RepXml (..)
-- * Utilities
, formatW3
#if TEST #if TEST
, testSuite , testSuite
#endif #endif
@ -46,6 +48,8 @@ import qualified Network.Wai as W
import qualified Network.Wai.Enumerator as WE import qualified Network.Wai.Enumerator as WE
import Data.Function (on) import Data.Function (on)
import Data.Time
import System.Locale
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
@ -245,3 +249,7 @@ caseTypeByExt = do
TypeJavascript @=? typeByExt (ext "foo.js") TypeJavascript @=? typeByExt (ext "foo.js")
TypeHtml @=? typeByExt (ext "foo.html") TypeHtml @=? typeByExt (ext "foo.html")
#endif #endif
-- | Format a 'UTCTime' in W3 format; useful for setting cookies.
formatW3 :: UTCTime -> String
formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"

View File

@ -39,7 +39,6 @@ import qualified Network.Wai.Handler.CGI as CGI
import System.Environment (getEnvironment) import System.Environment (getEnvironment)
import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Char8 as B
import Web.Encodings
import Web.Routes (encodePathInfo) import Web.Routes (encodePathInfo)
import Control.Concurrent.MVar import Control.Concurrent.MVar
@ -53,6 +52,7 @@ import Data.Maybe
import Web.ClientSession import Web.ClientSession
import Data.Serialize import Data.Serialize
import Network.Wai.Parse
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
@ -247,7 +247,7 @@ parseWaiRequest :: W.Request
-> [(String, String)] -- ^ session -> [(String, String)] -- ^ session
-> IO Request -> IO Request
parseWaiRequest env session' = do parseWaiRequest env session' = do
let gets' = map (cs *** cs) $ decodeUrlPairs $ W.queryString env let gets' = map (cs *** cs) $ parseQueryString $ W.queryString env
let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env let reqCookie = fromMaybe B.empty $ lookup W.Cookie $ W.requestHeaders env
cookies' = map (cs *** cs) $ parseCookies reqCookie cookies' = map (cs *** cs) $ parseCookies reqCookie
acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env

View File

@ -69,8 +69,8 @@ import Yesod.Request
import Yesod.Content import Yesod.Content
import Yesod.Internal import Yesod.Internal
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Data.List (foldl') import Data.List (foldl', intercalate)
import Web.Encodings (encodeUrlPairs, encodeHtml) import Text.Hamlet.Monad (htmlContentToText)
import Control.Exception hiding (Handler, catch) import Control.Exception hiding (Handler, catch)
import qualified Control.Exception as E import qualified Control.Exception as E
@ -92,7 +92,8 @@ import Control.Monad.Attempt
import Data.Convertible.Text (cs) import Data.Convertible.Text (cs)
import Text.Hamlet import Text.Hamlet
import Data.Text (Text) import Numeric (showIntAtBase)
import Data.Char (ord, chr)
data HandlerData sub master = HandlerData data HandlerData sub master = HandlerData
{ handlerRequest :: Request { handlerRequest :: Request
@ -260,6 +261,26 @@ redirectParams :: RedirectType -> Routes master -> [(String, String)]
redirectParams rt url params = do redirectParams rt url params = do
r <- getUrlRender r <- getUrlRender
redirectString rt $ r url ++ '?' : encodeUrlPairs params redirectString rt $ r url ++ '?' : encodeUrlPairs params
where
encodeUrlPairs = intercalate "&" . map encodeUrlPair
encodeUrlPair (x, []) = escape x
encodeUrlPair (x, y) = escape x ++ '=' : escape y
escape = concatMap escape'
escape' c
| 'A' < c && c < 'Z' = [c]
| 'a' < c && c < 'a' = [c]
| '0' < c && c < '9' = [c]
| c `elem` ".-~_" = [c]
| c == ' ' = "+"
| otherwise = '%' : myShowHex (ord c) ""
myShowHex :: Int -> ShowS
myShowHex n r = case showIntAtBase 16 (toChrHex) n r of
[] -> "00"
[c] -> ['0',c]
s -> s
toChrHex d
| d < 10 = chr (ord '0' + fromIntegral d)
| otherwise = chr (ord 'A' + fromIntegral (d - 10))
-- | Redirect to the given URL. -- | Redirect to the given URL.
redirectString :: RedirectType -> String -> GHandler sub master a redirectString :: RedirectType -> String -> GHandler sub master a
@ -321,11 +342,6 @@ getMessage = do
clearSession msgKey clearSession msgKey
fmap (fmap $ Encoded . cs) $ lookupSession msgKey fmap (fmap $ Encoded . cs) $ lookupSession msgKey
-- | FIXME move this definition into hamlet
htmlContentToText :: HtmlContent -> Text
htmlContentToText (Encoded t) = t
htmlContentToText (Unencoded t) = encodeHtml t
-- | Bypass remaining handler code and output the given file. -- | Bypass remaining handler code and output the given file.
-- --
-- For some backends, this is more efficient than reading in the file to -- For some backends, this is more efficient than reading in the file to

View File

@ -24,7 +24,6 @@ module Yesod.Helpers.AtomFeed
import Yesod import Yesod
import Data.Time.Clock (UTCTime) import Data.Time.Clock (UTCTime)
import Web.Encodings (formatW3)
import Text.Hamlet.Monad import Text.Hamlet.Monad
import Text.Hamlet.Quasi import Text.Hamlet.Quasi

View File

@ -24,7 +24,6 @@ module Yesod.Helpers.Sitemap
) where ) where
import Yesod import Yesod
import Web.Encodings (formatW3)
import Data.Time (UTCTime) import Data.Time (UTCTime)
data SitemapChangeFreq = Always data SitemapChangeFreq = Always

View File

@ -21,11 +21,13 @@ module Yesod.Json
import Text.Hamlet.Monad import Text.Hamlet.Monad
import Control.Applicative import Control.Applicative
import Data.Text (pack) import Data.Text (pack)
import Web.Encodings import qualified Data.Text as T
import Data.Char (isControl)
import Yesod.Hamlet import Yesod.Hamlet
import Control.Monad (when) import Control.Monad (when)
import Yesod.Handler import Yesod.Handler
import Web.Routes.Quasi (Routes) import Web.Routes.Quasi (Routes)
import Numeric (showHex)
#if TEST #if TEST
import Test.Framework (testGroup, Test) import Test.Framework (testGroup, Test)
@ -69,6 +71,23 @@ jsonScalar s = Json $ do
outputString "\"" outputString "\""
output $ encodeJson $ htmlContentToText s output $ encodeJson $ htmlContentToText s
outputString "\"" outputString "\""
where
encodeJson = T.concatMap (T.pack . encodeJsonChar)
encodeJsonChar '\b' = "\\b"
encodeJsonChar '\f' = "\\f"
encodeJsonChar '\n' = "\\n"
encodeJsonChar '\r' = "\\r"
encodeJsonChar '\t' = "\\t"
encodeJsonChar '"' = "\\\""
encodeJsonChar '\\' = "\\\\"
encodeJsonChar c
| not $ isControl c = [c]
| c < '\x10' = '\\' : 'u' : '0' : '0' : '0' : hexxs
| c < '\x100' = '\\' : 'u' : '0' : '0' : hexxs
| c < '\x1000' = '\\' : 'u' : '0' : hexxs
where hexxs = showHex (fromEnum c) "" -- FIXME
encodeJsonChar c = [c]
-- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"]. -- | Outputs a JSON list, eg [\"foo\",\"bar\",\"baz\"].
jsonList :: [Json url ()] -> Json url () jsonList :: [Json url ()] -> Json url ()

View File

@ -20,6 +20,7 @@ module Yesod.Request
RequestBodyContents RequestBodyContents
, Request (..) , Request (..)
, RequestReader (..) , RequestReader (..)
, FileInfo (..)
-- * Convenience functions -- * Convenience functions
, waiRequest , waiRequest
, languages , languages
@ -40,7 +41,6 @@ module Yesod.Request
) where ) where
import qualified Network.Wai as W import qualified Network.Wai as W
import Web.Encodings
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
#if MIN_VERSION_transformers(0,2,0) #if MIN_VERSION_transformers(0,2,0)
import "transformers" Control.Monad.IO.Class import "transformers" Control.Monad.IO.Class
@ -48,6 +48,7 @@ import "transformers" Control.Monad.IO.Class
import "transformers" Control.Monad.Trans import "transformers" Control.Monad.Trans
#endif #endif
import Control.Monad (liftM) import Control.Monad (liftM)
import Network.Wai.Parse
type ParamName = String type ParamName = String
type ParamValue = String type ParamValue = String
@ -58,6 +59,9 @@ class Monad m => RequestReader m where
getRequest :: m Request getRequest :: m Request
instance RequestReader ((->) Request) where instance RequestReader ((->) Request) where
getRequest = id getRequest = id
instance Monad ((->) Request) where -- FIXME what's happening here?
return = const
f >>= g = \r -> g (f r) r
-- | Get the list of supported languages supplied by the user. -- | Get the list of supported languages supplied by the user.
-- --
@ -82,7 +86,7 @@ waiRequest = reqWaiRequest `liftM` getRequest
-- | A tuple containing both the POST parameters and submitted files. -- | A tuple containing both the POST parameters and submitted files.
type RequestBodyContents = type RequestBodyContents =
( [(ParamName, ParamValue)] ( [(ParamName, ParamValue)]
, [(ParamName, FileInfo String BL.ByteString)] , [(ParamName, FileInfo BL.ByteString)]
) )
-- | The parsed request information. -- | The parsed request information.

View File

@ -36,7 +36,6 @@ library
wai-extra >= 0.1.1 && < 0.2, wai-extra >= 0.1.1 && < 0.2,
authenticate >= 0.6.2 && < 0.7, authenticate >= 0.6.2 && < 0.7,
bytestring >= 0.9.1.4 && < 0.10, bytestring >= 0.9.1.4 && < 0.10,
web-encodings >= 0.2.6 && < 0.3,
directory >= 1 && < 1.1, directory >= 1 && < 1.1,
text >= 0.5 && < 0.8, text >= 0.5 && < 0.8,
convertible-text >= 0.3.0 && < 0.4, convertible-text >= 0.3.0 && < 0.4,
@ -50,7 +49,8 @@ library
pureMD5 >= 1.1.0.0 && < 1.2, pureMD5 >= 1.1.0.0 && < 1.2,
random >= 1.0.0.2 && < 1.1, random >= 1.0.0.2 && < 1.1,
control-monad-attempt >= 0.3 && < 0.4, control-monad-attempt >= 0.3 && < 0.4,
cereal >= 0.2 && < 0.3 cereal >= 0.2 && < 0.3,
old-locale >= 1.0.0.2 && < 1.1
exposed-modules: Yesod exposed-modules: Yesod
Yesod.Content Yesod.Content
Yesod.Dispatch Yesod.Dispatch