Removed utf8-string dep

This commit is contained in:
Michael Snoyman 2010-10-19 13:39:27 +02:00
parent c29f5af95c
commit 0b4de794e8
10 changed files with 52 additions and 29 deletions

View File

@ -5,14 +5,16 @@ module CodeGen (codegen) where
import Language.Haskell.TH.Syntax
import Text.ParserCombinators.Parsec
import qualified System.IO.UTF8 as U
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
data Token = VarToken String | LitToken String | EmptyToken
codegen :: FilePath -> Q Exp
codegen fp = do
s' <- qRunIO $ U.readFile $ "scaffold/" ++ fp ++ ".cg"
let s = init s'
s' <- qRunIO $ L.readFile $ "scaffold/" ++ fp ++ ".cg"
let s = init $ LT.unpack $ LT.decodeUtf8 s'
case parse (many parseToken) s s of
Left e -> error $ show e
Right tokens' -> do

View File

@ -63,7 +63,6 @@ import System.Locale
import qualified Data.Text.Encoding
import qualified Data.Text.Lazy.Encoding
import qualified Data.ByteString.Lazy.UTF8
#if TEST
import Test.Framework (testGroup, Test)
@ -94,7 +93,7 @@ instance ToContent T.Text where
instance ToContent Text where
toContent = W.ResponseLBS . Data.Text.Lazy.Encoding.encodeUtf8
instance ToContent String where
toContent = W.ResponseLBS . Data.ByteString.Lazy.UTF8.fromString
toContent = toContent . T.pack
-- | A function which gives targetted representations of content based on the
-- content-types the user accepts.

View File

@ -52,8 +52,6 @@ import System.Environment (getEnvironment)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.UTF8 as S
import Control.Concurrent.MVar
import Control.Arrow ((***))
@ -268,10 +266,10 @@ toWaiApp' y segments env = do
(s, hs, ct, c, sessionFinal) <- unYesodApp ya eh rr types
let sessionVal = encodeSession key' exp' host sessionFinal
let hs' = AddCookie (clientSessionDuration y) sessionName
(S.toString sessionVal)
(bsToChars sessionVal)
: hs
hs'' = map (headerToPair getExpires) hs'
hs''' = ("Content-Type", S.fromString ct) : hs''
hs''' = ("Content-Type", charsToBs ct) : hs''
return $ W.Response s hs''' c
httpAccept :: W.Request -> [ContentType]
@ -313,13 +311,13 @@ parseWaiRequest :: W.Request
-> [(String, String)] -- ^ session
-> IO Request
parseWaiRequest env session' = do
let gets' = map (S.toString *** S.toString)
let gets' = map (bsToChars *** bsToChars)
$ parseQueryString $ W.queryString env
let reqCookie = fromMaybe B.empty $ lookup "Cookie"
$ W.requestHeaders env
cookies' = map (S.toString *** S.toString) $ parseCookies reqCookie
cookies' = map (bsToChars *** bsToChars) $ parseCookies reqCookie
acceptLang = lookup "Accept-Language" $ W.requestHeaders env
langs = map S.toString $ maybe [] parseHttpAccept acceptLang
langs = map bsToChars $ maybe [] parseHttpAccept acceptLang
langs' = case lookup langKey session' of
Nothing -> langs
Just x -> x : langs
@ -334,9 +332,9 @@ parseWaiRequest env session' = do
rbHelper :: W.Request -> IO RequestBodyContents
rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
fix1 = map (S.toString *** S.toString)
fix1 = map (bsToChars *** bsToChars)
fix2 (x, NWP.FileInfo a b c) =
(S.toString x, FileInfo (S.toString a) (S.toString b) c)
(bsToChars x, FileInfo (bsToChars a) (bsToChars b) c)
-- | Produces a \"compute on demand\" value. The computation will be run once
-- it is requested, and then the result will be stored. This will happen only
@ -357,14 +355,14 @@ headerToPair :: (Int -> UTCTime) -- ^ minutes -> expiration time
-> (W.ResponseHeader, B.ByteString)
headerToPair getExpires (AddCookie minutes key value) =
let expires = getExpires minutes
in ("Set-Cookie", S.fromString
in ("Set-Cookie", charsToBs
$ key ++ "=" ++ value ++"; path=/; expires="
++ formatW3 expires)
headerToPair _ (DeleteCookie key) =
("Set-Cookie", S.fromString $
("Set-Cookie", charsToBs $
key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
headerToPair _ (Header key value) =
(fromString key, S.fromString value)
(fromString key, charsToBs value)
encodeSession :: CS.Key
-> UTCTime -- ^ expire time

View File

@ -9,9 +9,10 @@ import Yesod.Handler
import Yesod.Form.Core
import Yesod.Hamlet
import Yesod.Widget
import qualified Data.ByteString.Lazy.UTF8 as U
import Text.HTML.SanitizeXSS (sanitizeXSS)
import Yesod.Internal (lbsToChars)
class YesodNic a where
-- | NIC Editor.
urlNicEdit :: a -> Either (Route a) String
@ -26,7 +27,7 @@ maybeNicHtmlField = optionalFieldHelper nicHtmlFieldProfile
nicHtmlFieldProfile :: YesodNic y => FieldProfile sub y Html
nicHtmlFieldProfile = FieldProfile
{ fpParse = Right . preEscapedString . sanitizeXSS
, fpRender = U.toString . renderHtml
, fpRender = lbsToChars . renderHtml
, fpWidget = \theId name val _isReq -> do
addBody [$hamlet|%textarea.html#$theId$!name=$name$ $val$|]
addScript' urlNicEdit

View File

@ -21,7 +21,6 @@ import Yesod.Form.Core
import Yesod.Widget
import Text.Hamlet
import Data.Time (Day, TimeOfDay(..))
import qualified Data.ByteString.Lazy.UTF8 as U
import qualified Text.Email.Validate as Email
import Network.URI (parseURI)
import Database.Persist (PersistField)
@ -30,6 +29,8 @@ import Text.HTML.SanitizeXSS (sanitizeXSS)
import Text.Blaze.Builder.Utf8 (writeChar)
import Text.Blaze.Builder.Core (writeList, writeByteString)
import Yesod.Internal (lbsToChars)
intFieldProfile :: Integral i => FieldProfile sub y i
intFieldProfile = FieldProfile
{ fpParse = maybe (Left "Invalid integer") Right . readMayI
@ -74,7 +75,7 @@ timeFieldProfile = FieldProfile
htmlFieldProfile :: FieldProfile sub y Html
htmlFieldProfile = FieldProfile
{ fpParse = Right . preEscapedString . sanitizeXSS
, fpRender = U.toString . renderHtml
, fpRender = lbsToChars . renderHtml
, fpWidget = \theId name val _isReq -> addBody [$hamlet|
%textarea.html#$theId$!name=$name$ $val$
|]

View File

@ -98,8 +98,6 @@ import Control.Monad.Trans.Reader
import System.IO
import qualified Network.Wai as W
import Control.Failure (Failure (failure))
import Data.ByteString.UTF8 (toString)
import qualified Data.ByteString.Lazy.UTF8 as L
import Text.Hamlet
@ -362,7 +360,7 @@ msgKey = "_MSG"
--
-- See 'getMessage'.
setMessage :: Html -> GHandler sub master ()
setMessage = setSession msgKey . L.toString . renderHtml
setMessage = setSession msgKey . lbsToChars . renderHtml
-- | Gets the message in the user's session, if available, and then clears the
-- variable.
@ -392,7 +390,7 @@ notFound = failure NotFound
badMethod :: (RequestReader m, Failure ErrorResponse m) => m a
badMethod = do
w <- waiRequest
failure $ BadMethod $ toString $ W.requestMethod w
failure $ BadMethod $ bsToChars $ W.requestMethod w
-- | Return a 403 permission denied page.
permissionDenied :: Failure ErrorResponse m => String -> m a

View File

@ -19,12 +19,26 @@ module Yesod.Internal
, locationToHamlet
, runUniqueList
, toUnique
-- * UTF8 helpers
, bsToChars
, lbsToChars
, charsToBs
) where
import Text.Hamlet (Hamlet, hamlet, Html)
import Data.Monoid (Monoid (..))
import Data.List (nub)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
-- | Responses to indicate some form of an error occurred. These are different
-- from 'SpecialResponse' in that they allow for custom error pages.
data ErrorResponse =
@ -71,3 +85,12 @@ newtype Head url = Head (Hamlet url)
deriving Monoid
newtype Body url = Body (Hamlet url)
deriving Monoid
lbsToChars :: L.ByteString -> String
lbsToChars = LT.unpack . LT.decodeUtf8With T.lenientDecode
bsToChars :: S.ByteString -> String
bsToChars = T.unpack . T.decodeUtf8With T.lenientDecode
charsToBs :: String -> S.ByteString
charsToBs = T.encodeUtf8 . T.pack

View File

@ -49,7 +49,6 @@ import qualified Network.Wai as W
import Yesod.Internal
import Web.ClientSession (getKey, defaultKeyFile)
import qualified Web.ClientSession as CS
import qualified Data.ByteString.UTF8 as BSU
import Database.Persist
import Control.Monad.Trans.Class (MonadTrans (..))
import Control.Failure (Failure)
@ -262,7 +261,7 @@ applyLayout' title body = fmap chooseRep $ defaultLayout $ do
defaultErrorHandler :: Yesod y => ErrorResponse -> GHandler sub y ChooseRep
defaultErrorHandler NotFound = do
r <- waiRequest
let path' = BSU.toString $ pathInfo r
let path' = bsToChars $ pathInfo r
applyLayout' "Not Found" $ [$hamlet|
%h1 Not Found
%p $path'$

View File

@ -6,6 +6,9 @@ import qualified Data.ByteString.Char8 as S
import Language.Haskell.TH.Syntax
import Data.Time (getCurrentTime, utctDay, toGregorian)
import Control.Applicative ((<$>))
import qualified Data.ByteString.Lazy as L
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Encoding as LT
main :: IO ()
main = do
@ -44,7 +47,7 @@ main = do
let writeFile' fp s = do
putStrLn $ "Generating " ++ fp
writeFile (dir ++ '/' : fp) s
L.writeFile (dir ++ '/' : fp) $ LT.encodeUtf8 $ LT.pack s
mkDir fp = createDirectoryIfMissing True $ dir ++ '/' : fp
mkDir "Handler"

View File

@ -28,7 +28,6 @@ library
, bytestring >= 0.9.1.4 && < 0.10
, directory >= 1 && < 1.2
, text >= 0.5 && < 0.10
, utf8-string >= 0.3.4 && < 0.4
, template-haskell >= 2.4 && < 2.6
, web-routes-quasi >= 0.6 && < 0.7
, hamlet >= 0.5.1 && < 0.6