Removed web-encodings dependency
This commit is contained in:
parent
aa770f7622
commit
712110a2ef
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -24,7 +24,6 @@ module Yesod.Helpers.Sitemap
|
||||
) where
|
||||
|
||||
import Yesod
|
||||
import Web.Encodings (formatW3)
|
||||
import Data.Time (UTCTime)
|
||||
|
||||
data SitemapChangeFreq = Always
|
||||
|
||||
@ -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 ()
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user