haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Removed convertible-text

Browse Source
This commit is contained in:
Michael Snoyman 2010-06-09 09:48:21 +03:00
parent 7568bec3c4
commit d57dc78983
15 changed files with 83 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Yesod.hs
View File

@ -11,7 +11,6 @@ module Yesod
, module Yesod.Hamlet
, module Yesod.Json
, Application
, cs
, liftIO
, Routes
) where
@ -32,6 +31,5 @@ import Yesod.Yesod
import Yesod.Handler hiding (runHandler)
import Network.Wai (Application)
import Yesod.Hamlet
import Data.Convertible.Text (cs)
import "transformers" Control.Monad.IO.Class (liftIO)
import Web.Routes.Quasi (Routes)

15
Yesod/Content.hs
View File

@ -54,7 +54,6 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Text.Lazy (Text)
import qualified Data.Text as T
import Data.Convertible.Text
import qualified Network.Wai as W
import qualified Network.Wai.Enumerator as WE
@ -63,6 +62,10 @@ import Data.Function (on)
import Data.Time
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)
import Test.Framework.Providers.HUnit
@ -94,13 +97,11 @@ instance ToContent B.ByteString where
instance ToContent L.ByteString where
toContent = swapEnum . WE.fromLBS
instance ToContent T.Text where
toContent t = toContent (cs t :: B.ByteString)
toContent = toContent . Data.Text.Encoding.encodeUtf8
instance ToContent Text where
toContent lt = toContent (cs lt :: L.ByteString)
toContent = toContent . Data.Text.Lazy.Encoding.encodeUtf8
instance ToContent String where
toContent s = toContent (cs s :: L.ByteString)
instance ToContent (IO Text) where
toContent = swapEnum . WE.fromLBS' . fmap cs
toContent = toContent . Data.ByteString.Lazy.UTF8.fromString
-- | A function which gives targetted representations of content based on the
-- content-types the user accepts.
@ -251,7 +252,7 @@ propExt s =
caseTypeByExt :: Assertion
caseTypeByExt = do
TypeJavascript @=? typeByExt (ext "foo.js")
typeJavascript @=? typeByExt (ext "foo.js")
typeHtml @=? typeByExt (ext "foo.html")
#endif

6
Yesod/Contrib/Crud.hs
View File

@ -51,7 +51,7 @@ getCrudListR = do
$forall items item
%li
%a!href=@toMaster.CrudEditR.toSinglePiece.fst.item@
$cs.itemTitle.snd.item$
$string.itemTitle.snd.item$
%p
%a!href=@toMaster.CrudAddR@ Add new item
|]
@ -102,7 +102,7 @@ getCrudDeleteR s = do
applyLayout "Confirm delete" mempty [$hamlet|
%form!method=post!action=@toMaster.CrudDeleteR.s@
%h1 Really delete?
%p Do you really want to delete $cs.itemTitle.item$?
%p Do you really want to delete $string.itemTitle.item$?
%p
%input!type=submit!value=Yes
\
@ -142,7 +142,7 @@ crudHelper title me isPost = do
applyLayout title mempty [$hamlet|
%p
%a!href=@toMaster.CrudListR@ Return to list
%h1 $cs.title$
%h1 $string.title$
%form!method=post
%table
^form^

6
Yesod/Contrib/Formable.hs
View File

@ -14,11 +14,11 @@ import Data.Char (isAlphaNum)
import Language.Haskell.TH.Syntax
import Database.Persist (Table (..))
import Database.Persist.Helper (upperFirst)
import Data.Convertible.Text (cs)
import Control.Monad (liftM)
import Control.Arrow (first)
import Data.Maybe (fromMaybe)
import Data.Monoid (mempty, mappend)
import qualified Data.ByteString.Lazy.UTF8
type Env = [(String, String)]
@ -124,7 +124,9 @@ instance Fieldable [Char] where
|]
instance Fieldable Html where
fieldable = fmap preEscapedString . input' go . fmap (cs . renderHtml)
fieldable = fmap preEscapedString
. input' go
. fmap (Data.ByteString.Lazy.UTF8.toString . renderHtml)
where
go name val = [$hamlet|%textarea!name=$string.name$ $string.val$|]

31
Yesod/Dispatch.hs
View File

@ -46,9 +46,11 @@ import System.Environment (getEnvironment)
import qualified Data.ByteString.Char8 as B
import Web.Routes (encodePathInfo)
import qualified Data.ByteString.UTF8 as S
import qualified Data.ByteString.Lazy.UTF8 as L
import Control.Concurrent.MVar
import Control.Arrow ((***), first)
import Data.Convertible.Text (cs)
import Data.Time
@ -230,10 +232,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
(cs sessionVal)
(S.toString sessionVal)
: hs
hs'' = map (headerToPair getExpires) hs'
hs''' = (W.ContentType, cs ct) : hs''
hs''' = (W.ContentType, S.fromString ct) : hs''
return $ W.Response s hs''' $ case c of
ContentFile fp -> Left fp
ContentEnum e -> Right $ W.buffer
@ -286,11 +288,13 @@ parseWaiRequest :: W.Request
-> [(String, String)] -- ^ session
-> IO Request
parseWaiRequest env session' = do
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
let gets' = map (S.toString *** S.toString)
$ parseQueryString $ W.queryString env
let reqCookie = fromMaybe B.empty $ lookup W.Cookie
$ W.requestHeaders env
cookies' = map (S.toString *** S.toString) $ parseCookies reqCookie
acceptLang = lookup W.AcceptLanguage $ W.requestHeaders env
langs = map cs $ maybe [] parseHttpAccept acceptLang
langs = map S.toString $ maybe [] parseHttpAccept acceptLang
langs' = case lookup langKey cookies' of
Nothing -> langs
Just x -> x : langs
@ -302,8 +306,9 @@ parseWaiRequest env session' = do
rbHelper :: W.Request -> IO RequestBodyContents
rbHelper = fmap (fix1 *** map fix2) . parseRequestBody lbsSink where
fix1 = map (cs *** cs)
fix2 (x, FileInfo a b c) = (cs x, FileInfo (cs a) (cs b) c)
fix1 = map (S.toString *** S.toString)
fix2 (x, FileInfo a b c) =
(S.toString x, FileInfo a 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
@ -324,12 +329,14 @@ headerToPair :: (Int -> UTCTime) -- ^ minutes -> expiration time
-> (W.ResponseHeader, B.ByteString)
headerToPair getExpires (AddCookie minutes key value) =
let expires = getExpires minutes
in (W.SetCookie, cs $ key ++ "=" ++ value ++"; path=/; expires="
in (W.SetCookie, S.fromString
$ key ++ "=" ++ value ++"; path=/; expires="
++ formatW3 expires)
headerToPair _ (DeleteCookie key) =
(W.SetCookie, cs $
(W.SetCookie, S.fromString $
key ++ "=; path=/; expires=Thu, 01-Jan-1970 00:00:00 GMT")
headerToPair _ (Header key value) = (W.responseHeaderFromBS $ cs key, cs value)
headerToPair _ (Header key value) =
(W.responseHeaderFromBS $ S.fromString key, S.fromString value)
encodeSession :: Key
-> UTCTime -- ^ expire time

7
Yesod/Form.hs
View File

@ -24,7 +24,6 @@ import Yesod.Request
import Yesod.Handler
import Control.Applicative hiding (optional)
import Data.Time (Day)
import Data.Convertible.Text
import Data.Maybe (fromMaybe)
import "transformers" Control.Monad.IO.Class
import Yesod.Internal
@ -107,7 +106,11 @@ notEmpty = applyForm $ \pv ->
else Right pv
checkDay :: Form ParamValue -> Form Day
checkDay = applyForm $ attempt (const (Left "Invalid day")) Right . ca
checkDay = applyForm $ maybe (Left "Invalid day") Right . readMay
where
readMay s = case reads s of
(x, _):_ -> Just x
[] -> Nothing
checkBool :: Form [ParamValue] -> Form Bool
checkBool = applyForm $ \pv -> Right $ case pv of

6
Yesod/Hamlet.hs
View File

@ -17,7 +17,6 @@ module Yesod.Hamlet
import Text.Hamlet
import Yesod.Content
import Yesod.Handler
import Data.Convertible.Text
import Web.Routes.Quasi (Routes)
-- | Content for a web page. By providing this datatype, we can easily create
@ -40,8 +39,3 @@ hamletToContent h = do
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
hamletToRepHtml :: Hamlet (Routes master) -> GHandler sub master RepHtml
hamletToRepHtml = fmap RepHtml . hamletToContent
instance ConvertSuccess String (Hamlet url) where
convertSuccess = const . string
instance ConvertSuccess String Html where
convertSuccess = string

9
Yesod/Handler.hs
View File

@ -84,8 +84,9 @@ import System.IO
import qualified Data.ByteString.Lazy as BL
import qualified Network.Wai as W
import Control.Monad.Attempt
import Data.ByteString.UTF8 (toString)
import qualified Data.ByteString.Lazy.UTF8 as L
import Data.Convertible.Text (cs)
import Text.Hamlet
import Numeric (showIntAtBase)
import Data.Char (ord, chr)
@ -326,7 +327,7 @@ msgKey = "_MSG"
--
-- See 'getMessage'.
setMessage :: Html -> GHandler sub master ()
setMessage = setSession msgKey . cs . renderHtml
setMessage = setSession msgKey . L.toString . renderHtml
-- | Gets the message in the user's session, if available, and then clears the
-- variable.
@ -335,7 +336,7 @@ setMessage = setSession msgKey . cs . renderHtml
getMessage :: GHandler sub master (Maybe Html)
getMessage = do
clearSession msgKey
fmap (fmap $ preEscapedString . cs) $ lookupSession msgKey
fmap (fmap preEscapedString) $ lookupSession msgKey
-- | Bypass remaining handler code and output the given file.
--
@ -352,7 +353,7 @@ notFound = failure NotFound
badMethod :: (RequestReader m, Failure ErrorResponse m) => m a
badMethod = do
w <- waiRequest
failure $ BadMethod $ cs $ W.methodToBS $ W.requestMethod w
failure $ BadMethod $ toString $ W.methodToBS $ W.requestMethod w
-- | Return a 403 permission denied page.
permissionDenied :: Failure ErrorResponse m => m a

10
Yesod/Helpers/AtomFeed.hs
View File

@ -48,16 +48,16 @@ data AtomFeedEntry url = AtomFeedEntry
}
xmlns :: AtomFeed url -> Html
xmlns _ = cs "http://www.w3.org/2005/Atom"
xmlns _ = preEscapedString "http://www.w3.org/2005/Atom"
template :: AtomFeed url -> Hamlet url
template arg = [$xhamlet|
<?xml version="1.0" encoding="utf-8"?>
%feed!xmlns=$xmlns.arg$
%title $cs.atomTitle.arg$
%title $string.atomTitle.arg$
%link!rel=self!href=@atomLinkSelf.arg@
%link!href=@atomLinkHome.arg@
%updated $cs.formatW3.atomUpdated.arg$
%updated $string.formatW3.atomUpdated.arg$
%id @atomLinkHome.arg@
$forall atomEntries.arg entry
^entryTemplate.entry^
@ -68,7 +68,7 @@ entryTemplate arg = [$xhamlet|
%entry
%id @atomEntryLink.arg@
%link!href=@atomEntryLink.arg@
%updated $cs.formatW3.atomEntryUpdated.arg$
%title $cs.atomEntryTitle.arg$
%updated $string.formatW3.atomEntryUpdated.arg$
%title $string.atomEntryTitle.arg$
%content!type=html $cdata.atomEntryContent.arg$
|]

29
Yesod/Helpers/Auth.hs
View File

@ -50,6 +50,7 @@ import Control.Concurrent.MVar
import System.IO
import Control.Monad.Attempt
import Data.Monoid (mempty)
import Data.ByteString.Lazy.UTF8 (fromString)
class Yesod master => YesodAuth master where
-- | Default destination on successful login or logout, if no other
@ -131,8 +132,8 @@ setCreds creds extra = do
-- | Retrieves user credentials, if user is authenticated.
maybeCreds :: RequestReader r => r (Maybe Creds)
maybeCreds = do
mcs <- lookupSession credsKey
return $ mcs >>= readMay
mstring <- lookupSession credsKey
return $ mstring >>= readMay
where
readMay x = case reads x of
(y, _):_ -> Just y
@ -188,7 +189,7 @@ getOpenIdForward = do
res <- runAttemptT $ OpenId.getForwardUrl oid complete
attempt
(\err -> do
setMessage $ cs $ show err
setMessage $ string $ show err
redirect RedirectTemporary $ toMaster OpenIdR)
(redirectString RedirectTemporary)
res
@ -201,7 +202,7 @@ getOpenIdComplete = do
res <- runAttemptT $ OpenId.authenticate gets'
toMaster <- getRouteToMaster
let onFailure err = do
setMessage $ cs $ show err
setMessage $ string $ show err
redirect RedirectTemporary $ toMaster OpenIdR
let onSuccess (OpenId.Identifier ident) = do
y <- getYesod
@ -255,12 +256,12 @@ getCheck = do
$if isNothing.creds
%p Not logged in
$maybe creds c
%p Logged in as $cs.credsIdent.c$
%p Logged in as $string.credsIdent.c$
|]
json creds =
jsonMap
[ ("ident", jsonScalar $ maybe (cs "") (cs . credsIdent) creds)
, ("displayName", jsonScalar $ cs $ fromMaybe ""
[ ("ident", jsonScalar $ maybe (string "") (string . credsIdent) creds)
, ("displayName", jsonScalar $ string $ fromMaybe ""
$ creds >>= credsDisplayName)
]
@ -315,7 +316,7 @@ postEmailRegisterR = do
let verUrl = render $ tm $ EmailVerifyR lid verKey
liftIO $ sendVerifyEmail ae email verKey verUrl
applyLayout "Confirmation e-mail sent" mempty [$hamlet|
%p A confirmation e-mail has been sent to $cs.email$.
%p A confirmation e-mail has been sent to $string.email$.
|]
checkEmail :: Form ParamValue -> Form ParamValue
@ -381,7 +382,7 @@ postEmailLoginR = do
setCreds (Creds email AuthEmail (Just email) Nothing (Just lid)) []
redirectUltDest RedirectTemporary $ defaultDest y
Nothing -> do
setMessage $ cs "Invalid email/password combination"
setMessage $ string "Invalid email/password combination"
toMaster <- getRouteToMaster
redirect RedirectTemporary $ toMaster EmailLoginR
@ -393,7 +394,7 @@ getEmailPasswordR = do
case mcreds of
Just (Creds _ AuthEmail _ _ (Just _)) -> return ()
_ -> do
setMessage $ cs "You must be logged in to set a password"
setMessage $ string "You must be logged in to set a password"
redirect RedirectTemporary $ toMaster EmailLoginR
msg <- getMessage
applyLayout "Set password" mempty [$hamlet|
@ -423,17 +424,17 @@ postEmailPasswordR = do
<*> notEmpty (required $ input "confirm")
toMaster <- getRouteToMaster
when (new /= confirm) $ do
setMessage $ cs "Passwords did not match, please try again"
setMessage $ string "Passwords did not match, please try again"
redirect RedirectTemporary $ toMaster EmailPasswordR
mcreds <- maybeCreds
lid <- case mcreds of
Just (Creds _ AuthEmail _ _ (Just lid)) -> return lid
_ -> do
setMessage $ cs "You must be logged in to set a password"
setMessage $ string "You must be logged in to set a password"
redirect RedirectTemporary $ toMaster EmailLoginR
salted <- liftIO $ saltPass new
liftIO $ setPassword ae lid salted
setMessage $ cs "Password updated"
setMessage $ string "Password updated"
redirect RedirectTemporary $ toMaster EmailLoginR
saltLength :: Int
@ -453,7 +454,7 @@ saltPass pass = do
return $ saltPass' salt pass
saltPass' :: String -> String -> String
saltPass' salt pass = salt ++ show (md5 $ cs $ salt ++ pass)
saltPass' salt pass = salt ++ show (md5 $ fromString $ salt ++ pass)
inMemoryEmailSettings :: IO AuthEmailSettings
inMemoryEmailSettings = do

8
Yesod/Helpers/Sitemap.hs
View File

@ -51,7 +51,7 @@ data SitemapUrl url = SitemapUrl
}
sitemapNS :: Html
sitemapNS = cs "http://www.sitemaps.org/schemas/sitemap/0.9"
sitemapNS = string "http://www.sitemaps.org/schemas/sitemap/0.9"
template :: [SitemapUrl url] -> Hamlet url
template urls = [$hamlet|
@ -59,9 +59,9 @@ template urls = [$hamlet|
$forall urls url
%url
%loc @sitemapLoc.url@
%lastmod $cs.formatW3.sitemapLastMod.url$
%changefreq $cs.showFreq.sitemapChangeFreq.url$
%priority $cs.show.priority.url$
%lastmod $string.formatW3.sitemapLastMod.url$
%changefreq $string.showFreq.sitemapChangeFreq.url$
%priority $string.show.priority.url$
|]
sitemap :: [SitemapUrl (Routes master)] -> GHandler sub master RepXml

2
Yesod/Helpers/Static.hs
View File

@ -80,7 +80,7 @@ getStaticRoute fp' = do
case content of
Nothing -> notFound
Just (Left fp'') -> sendFile (typeByExt $ ext fp'') fp''
Just (Right bs) -> return [(typeByExt $ ext fp, cs bs)]
Just (Right bs) -> return [(typeByExt $ ext fp, bs)]
where
isUnsafe [] = True
isUnsafe ('.':_) = True

8
Yesod/Json.hs
View File

@ -16,14 +16,14 @@ module Yesod.Json
)
where
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char (isControl)
import Yesod.Hamlet
import Yesod.Handler
import Web.Routes.Quasi (Routes)
import Numeric (showHex)
import Data.Monoid (Monoid (..))
import Data.Convertible.Text (cs)
import Text.Hamlet
#if TEST
@ -66,11 +66,11 @@ jsonToRepJson = fmap RepJson . jsonToContent
jsonScalar :: Html -> Json
jsonScalar s = Json $ mconcat
[ preEscapedString "\""
, preEscapedString $ encodeJson $ cs $ renderHtml s
, unsafeBytestring $ S.concat $ L.toChunks $ encodeJson $ renderHtml s
, preEscapedString "\""
]
where
encodeJson = concatMap encodeJsonChar
encodeJson = L.concatMap (L.pack . encodeJsonChar)
encodeJsonChar '\b' = "\\b"
encodeJsonChar '\f' = "\\f"

18
Yesod/Yesod.hs
View File

@ -16,12 +16,12 @@ import Yesod.Content
import Yesod.Request
import Yesod.Hamlet
import Yesod.Handler
import Data.Convertible.Text
import qualified Network.Wai as W
import Yesod.Json
import Yesod.Internal
import Web.ClientSession (getKey, defaultKeyFile, Key)
import Data.Monoid (mempty)
import Data.ByteString.UTF8 (toString)
import Web.Routes.Quasi (QuasiSite (..), Routes)
@ -99,7 +99,7 @@ applyLayout :: Yesod master
-> GHandler sub master RepHtml
applyLayout t h b =
RepHtml `fmap` defaultLayout PageContent
{ pageTitle = cs t
{ pageTitle = string t
, pageHead = h
, pageBody = b
}
@ -114,7 +114,7 @@ applyLayoutJson :: Yesod master
-> GHandler sub master RepHtmlJson
applyLayoutJson t h html json = do
html' <- defaultLayout PageContent
{ pageTitle = cs t
{ pageTitle = string t
, pageHead = h
, pageBody = html
}
@ -135,30 +135,30 @@ defaultErrorHandler NotFound = do
r <- waiRequest
applyLayout' "Not Found" $ [$hamlet|
%h1 Not Found
%p $string.cs.pathInfo.r$
%p $string.toString.pathInfo.r$
|]
where
pathInfo = W.pathInfo
defaultErrorHandler (PermissionDenied msg) =
applyLayout' "Permission Denied" $ [$hamlet|
%h1 Permission denied
%p $cs.msg$
%p $string.msg$
|]
defaultErrorHandler (InvalidArgs ia) =
applyLayout' "Invalid Arguments" $ [$hamlet|
%h1 Invalid Arguments
%dl
$forall ia pair
%dt $cs.fst.pair$
%dd $cs.snd.pair$
%dt $string.fst.pair$
%dd $string.snd.pair$
|]
defaultErrorHandler (InternalError e) =
applyLayout' "Internal Server Error" $ [$hamlet|
%h1 Internal Server Error
%p $cs.e$
%p $string.e$
|]
defaultErrorHandler (BadMethod m) =
applyLayout' "Bad Method" $ [$hamlet|
%h1 Method Not Supported
%p Method "$cs.m$" not supported
%p Method "$string.m$" not supported
|]

2
yesod.cabal
View File

@ -38,7 +38,7 @@ library
bytestring >= 0.9.1.4 && < 0.10,
directory >= 1 && < 1.1,
text >= 0.5 && < 0.8,
convertible-text >= 0.3.0 && < 0.4,
utf8-string >= 0.3.4 && < 0.4,
template-haskell >= 2.4 && < 2.5,
web-routes >= 0.22 && < 0.23,
web-routes-quasi >= 0.4 && < 0.5,