Removed utf8-string dep
This commit is contained in:
parent
c29f5af95c
commit
0b4de794e8
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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$
|
||||
|]
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'$
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user