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 (..)
, RepPlain (..)
, RepXml (..)
-- * Utilities
, formatW3
#if TEST
, testSuite
#endif
@ -46,6 +48,8 @@ import qualified Network.Wai as W
import qualified Network.Wai.Enumerator as WE
import Data.Function (on)
import Data.Time
import System.Locale
#if TEST
import Test.Framework (testGroup, Test)
@ -245,3 +249,7 @@ caseTypeByExt = do
TypeJavascript @=? typeByExt (ext "foo.js")
TypeHtml @=? typeByExt (ext "foo.html")
#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 qualified Data.ByteString.Char8 as B
import Web.Encodings
import Web.Routes (encodePathInfo)
import Control.Concurrent.MVar
@ -53,6 +52,7 @@ import Data.Maybe
import Web.ClientSession
import Data.Serialize
import Network.Wai.Parse
#if TEST
import Test.Framework (testGroup, Test)
@ -247,7 +247,7 @@ parseWaiRequest :: W.Request
-> [(String, String)] -- ^ session
-> IO Request
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
cookies' = map (cs *** cs) $ parseCookies reqCookie
acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env

View File

@ -69,8 +69,8 @@ import Yesod.Request
import Yesod.Content
import Yesod.Internal
import Web.Routes.Quasi (Routes)
import Data.List (foldl')
import Web.Encodings (encodeUrlPairs, encodeHtml)
import Data.List (foldl', intercalate)
import Text.Hamlet.Monad (htmlContentToText)
import Control.Exception hiding (Handler, catch)
import qualified Control.Exception as E
@ -92,7 +92,8 @@ import Control.Monad.Attempt
import Data.Convertible.Text (cs)
import Text.Hamlet
import Data.Text (Text)
import Numeric (showIntAtBase)
import Data.Char (ord, chr)
data HandlerData sub master = HandlerData
{ handlerRequest :: Request
@ -260,6 +261,26 @@ redirectParams :: RedirectType -> Routes master -> [(String, String)]
redirectParams rt url params = do
r <- getUrlRender
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.
redirectString :: RedirectType -> String -> GHandler sub master a
@ -321,11 +342,6 @@ getMessage = do
clearSession 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.
--
-- 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 Data.Time.Clock (UTCTime)
import Web.Encodings (formatW3)
import Text.Hamlet.Monad
import Text.Hamlet.Quasi

View File

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

View File

@ -21,11 +21,13 @@ module Yesod.Json
import Text.Hamlet.Monad
import Control.Applicative
import Data.Text (pack)
import Web.Encodings
import qualified Data.Text as T
import Data.Char (isControl)
import Yesod.Hamlet
import Control.Monad (when)
import Yesod.Handler
import Web.Routes.Quasi (Routes)
import Numeric (showHex)
#if TEST
import Test.Framework (testGroup, Test)
@ -69,6 +71,23 @@ jsonScalar s = Json $ do
outputString "\""
output $ encodeJson $ htmlContentToText s
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\"].
jsonList :: [Json url ()] -> Json url ()

View File

@ -20,6 +20,7 @@ module Yesod.Request
RequestBodyContents
, Request (..)
, RequestReader (..)
, FileInfo (..)
-- * Convenience functions
, waiRequest
, languages
@ -40,7 +41,6 @@ module Yesod.Request
) where
import qualified Network.Wai as W
import Web.Encodings
import qualified Data.ByteString.Lazy as BL
#if MIN_VERSION_transformers(0,2,0)
import "transformers" Control.Monad.IO.Class
@ -48,6 +48,7 @@ import "transformers" Control.Monad.IO.Class
import "transformers" Control.Monad.Trans
#endif
import Control.Monad (liftM)
import Network.Wai.Parse
type ParamName = String
type ParamValue = String
@ -58,6 +59,9 @@ class Monad m => RequestReader m where
getRequest :: m Request
instance RequestReader ((->) Request) where
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.
--
@ -82,7 +86,7 @@ waiRequest = reqWaiRequest `liftM` getRequest
-- | A tuple containing both the POST parameters and submitted files.
type RequestBodyContents =
( [(ParamName, ParamValue)]
, [(ParamName, FileInfo String BL.ByteString)]
, [(ParamName, FileInfo BL.ByteString)]
)
-- | The parsed request information.

View File

@ -36,7 +36,6 @@ library
wai-extra >= 0.1.1 && < 0.2,
authenticate >= 0.6.2 && < 0.7,
bytestring >= 0.9.1.4 && < 0.10,
web-encodings >= 0.2.6 && < 0.3,
directory >= 1 && < 1.1,
text >= 0.5 && < 0.8,
convertible-text >= 0.3.0 && < 0.4,
@ -50,7 +49,8 @@ library
pureMD5 >= 1.1.0.0 && < 1.2,
random >= 1.0.0.2 && < 1.1,
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
Yesod.Content
Yesod.Dispatch