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

Catch up with Data.Conduit.Combinators

Browse Source
This commit is contained in:
Michael Snoyman 2018-01-10 12:16:31 -08:00
parent a16e75249a
commit 103c098cf8
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
21 changed files with 110 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
yesod-auth/yesod-auth.cabal
View File

@ -58,7 +58,7 @@ library
, binary
, http-client
, blaze-builder
, conduit
, conduit >= 1.3
, conduit-extra
, nonce >= 1.0.2 && < 1.1

11
yesod-bin/Devel.hs
View File

@ -17,9 +17,7 @@ import Control.Monad (forever, unless, void,
when)
import Data.ByteString (ByteString, isInfixOf)
import qualified Data.ByteString.Lazy as LB
import Data.Conduit (($$), (=$))
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Conduit
import Data.Default.Class (def)
import Data.FileEmbed (embedFile)
import qualified Data.Map as Map
@ -368,9 +366,10 @@ devel opts passThroughArgs = do
-- process is piped to the actual stdout and stderr handles.
withProcess_ procConfig $ \p -> do
let helper getter h =
getter p
$$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
=$ CB.sinkHandle h
runConduit
$ getter p
.| iterMC (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
.| sinkHandle h
race_ (helper getStdout stdout) (helper getStderr stderr)
-- Run the inner action with a TVar which will be set to True

16
yesod-bin/HsFile.hs
View File

@ -2,20 +2,18 @@
{-# LANGUAGE OverloadedStrings #-}
module HsFile (mkHsFile) where
import Text.ProjectTemplate (createTemplate)
import Data.Conduit
( ($$), (=$), awaitForever)
import Data.Conduit.Filesystem (sourceDirectory)
import Conduit
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.Conduit.List as CL
import qualified Data.ByteString as BS
import Control.Monad.IO.Class (liftIO)
import Data.String (fromString)
mkHsFile :: IO ()
mkHsFile = runResourceT $ sourceDirectory "."
$$ readIt
=$ createTemplate
=$ awaitForever (liftIO . BS.putStr)
mkHsFile = runConduitRes
$ sourceDirectory "."
.| readIt
.| createTemplate
.| mapM_C (liftIO . BS.putStr)
where
-- Reads a filepath from upstream and dumps a pair of (filepath, filecontents)
readIt = CL.map $ \i -> (fromString i, liftIO $ BS.readFile i)
readIt = mapC $ \i -> (fromString i, liftIO $ BS.readFile i)

18
yesod-core/Yesod/Core/Class/Yesod.hs
View File

@ -10,9 +10,8 @@ import Yesod.Core.Handler
import Yesod.Routes.Class
import Blaze.ByteString.Builder (Builder, toByteString)
import Blaze.ByteString.Builder.ByteString (copyByteString)
import Blaze.ByteString.Builder.Char.Utf8 (fromText, fromChar)
import Data.ByteString.Builder (Builder, toLazyByteString)
import Data.Text.Encoding (encodeUtf8Builder)
import Control.Arrow ((***), second)
import Control.Exception (bracket)
#if __GLASGOW_HASKELL__ < 710
@ -25,6 +24,7 @@ import Control.Monad.Logger (LogLevel (LevelInfo, LevelO
import Control.Monad.Trans.Resource (InternalState, createInternalState, closeInternalState)
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Aeson (object, (.=))
import Data.List (foldl', nub)
import qualified Data.Map as Map
@ -113,10 +113,10 @@ class RenderRoute site => Yesod site where
-- | Override the rendering function for a particular URL and query string
-- parameters. One use case for this is to offload static hosting to a
-- different domain name to avoid sending cookies.
--
--
-- For backward compatibility default implementation is in terms of
-- 'urlRenderOverride', probably ineffective
--
--
-- Since 1.4.23
urlParamRenderOverride :: site
-> Route site
@ -126,11 +126,11 @@ class RenderRoute site => Yesod site where
where
addParams [] routeBldr = routeBldr
addParams nonEmptyParams routeBldr =
let routeBS = toByteString routeBldr
qsSeparator = fromChar $ if S8.elem '?' routeBS then '&' else '?'
let routeBS = toLazyByteString routeBldr
qsSeparator = if BL8.elem '?' routeBS then "&" else "?"
valueToMaybe t = if t == "" then Nothing else Just t
queryText = map (id *** valueToMaybe) nonEmptyParams
in copyByteString routeBS `mappend` qsSeparator `mappend` renderQueryText False queryText
in routeBldr `mappend` qsSeparator `mappend` renderQueryText False queryText
-- | Determine if a request is authorized or not.
--
@ -192,7 +192,7 @@ class RenderRoute site => Yesod site where
-> [(T.Text, T.Text)] -- ^ query string
-> Builder
joinPath _ ar pieces' qs' =
fromText ar `mappend` encodePath pieces qs
encodeUtf8Builder ar `mappend` encodePath pieces qs
where
pieces = if null pieces' then [""] else map addDash pieces'
qs = map (TE.encodeUtf8 *** go) qs'

41
yesod-core/Yesod/Core/Content.hs
View File

@ -53,20 +53,21 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Text.Lazy (Text, pack)
import qualified Data.Text as T
import Blaze.ByteString.Builder (Builder, fromByteString, fromLazyByteString)
import Data.Text.Encoding (encodeUtf8Builder)
import qualified Data.Text.Lazy as TL
import Data.ByteString.Builder (Builder, byteString, lazyByteString, stringUtf8)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mempty)
#endif
import Text.Hamlet (Html)
import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
import Data.Conduit (Source, Flush (Chunk), ResumableSource, mapOutput)
import Data.Conduit (Flush (Chunk), ResumableSource, mapOutput)
import Control.Monad (liftM)
import Control.Monad.Trans.Resource (ResourceT)
import Data.Conduit.Internal (ResumableSource (ResumableSource))
import qualified Data.Conduit.Internal as CI
import qualified Data.Aeson as J
import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
import Data.Text.Lazy.Builder (toLazyText)
import Yesod.Core.Types
import Text.Lucius (Css, renderCss)
@ -93,15 +94,15 @@ instance ToContent Content where
instance ToContent Builder where
toContent = flip ContentBuilder Nothing
instance ToContent B.ByteString where
toContent bs = ContentBuilder (fromByteString bs) $ Just $ B.length bs
toContent bs = ContentBuilder (byteString bs) $ Just $ B.length bs
instance ToContent L.ByteString where
toContent = flip ContentBuilder Nothing . fromLazyByteString
toContent = flip ContentBuilder Nothing . lazyByteString
instance ToContent T.Text where
toContent = toContent . Blaze.fromText
toContent = toContent . encodeUtf8Builder
instance ToContent Text where
toContent = toContent . Blaze.fromLazyText
toContent = toContent . foldMap encodeUtf8Builder . TL.toChunks
instance ToContent String where
toContent = toContent . Blaze.fromString
toContent = toContent . stringUtf8
instance ToContent Html where
toContent bs = ContentBuilder (renderHtmlBuilder bs) Nothing
instance ToContent () where
@ -119,10 +120,10 @@ instance ToContent Javascript where
instance ToFlushBuilder builder => ToContent (CI.Pipe () () builder () (ResourceT IO) ()) where
toContent src = ContentSource $ CI.ConduitT (CI.mapOutput toFlushBuilder src >>=)
instance ToFlushBuilder builder => ToContent (Source (ResourceT IO) builder) where
instance ToFlushBuilder builder => ToContent (CI.ConduitT () builder (ResourceT IO) ()) where
toContent src = ContentSource $ mapOutput toFlushBuilder src
instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) builder) where
toContent (ResumableSource src _) = toContent src
toContent (ResumableSource src) = toContent src
-- | A class for all data which can be sent in a streaming response. Note that
-- for textual data, instances must use UTF-8 encoding.
@ -131,16 +132,16 @@ instance ToFlushBuilder builder => ToContent (ResumableSource (ResourceT IO) bui
class ToFlushBuilder a where toFlushBuilder :: a -> Flush Builder
instance ToFlushBuilder (Flush Builder) where toFlushBuilder = id
instance ToFlushBuilder Builder where toFlushBuilder = Chunk
instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap fromByteString
instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . fromByteString
instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder = fmap fromLazyByteString
instance ToFlushBuilder L.ByteString where toFlushBuilder = Chunk . fromLazyByteString
instance ToFlushBuilder (Flush Text) where toFlushBuilder = fmap Blaze.fromLazyText
instance ToFlushBuilder Text where toFlushBuilder = Chunk . Blaze.fromLazyText
instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap Blaze.fromText
instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . Blaze.fromText
instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap Blaze.fromString
instance ToFlushBuilder String where toFlushBuilder = Chunk . Blaze.fromString
instance ToFlushBuilder (Flush B.ByteString) where toFlushBuilder = fmap byteString
instance ToFlushBuilder B.ByteString where toFlushBuilder = Chunk . byteString
instance ToFlushBuilder (Flush L.ByteString) where toFlushBuilder = fmap lazyByteString
instance ToFlushBuilder L.ByteString where toFlushBuilder = Chunk . lazyByteString
instance ToFlushBuilder (Flush Text) where toFlushBuilder = fmap (foldMap encodeUtf8Builder . TL.toChunks)
instance ToFlushBuilder Text where toFlushBuilder = Chunk . foldMap encodeUtf8Builder . TL.toChunks
instance ToFlushBuilder (Flush T.Text) where toFlushBuilder = fmap encodeUtf8Builder
instance ToFlushBuilder T.Text where toFlushBuilder = Chunk . encodeUtf8Builder
instance ToFlushBuilder (Flush String) where toFlushBuilder = fmap stringUtf8
instance ToFlushBuilder String where toFlushBuilder = Chunk . stringUtf8
instance ToFlushBuilder (Flush Html) where toFlushBuilder = fmap renderHtmlBuilder
instance ToFlushBuilder Html where toFlushBuilder = Chunk . renderHtmlBuilder

7
yesod-core/Yesod/Core/Dispatch.hs
View File

@ -53,8 +53,9 @@ import Data.Text (Text)
import Data.Monoid (mappend)
#endif
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as S8
import qualified Blaze.ByteString.Builder
import Data.ByteString.Builder (byteString, toLazyByteString)
import Network.HTTP.Types (status301, status307)
import Yesod.Routes.Parse
import Yesod.Core.Types
@ -115,7 +116,7 @@ toWaiAppYre yre req =
sendRedirect y segments' env sendResponse =
sendResponse $ W.responseLBS status
[ ("Content-Type", "text/plain")
, ("Location", Blaze.ByteString.Builder.toByteString dest')
, ("Location", BL.toStrict $ toLazyByteString dest')
] "Redirecting"
where
-- Ensure that non-GET requests get redirected correctly. See:
@ -129,7 +130,7 @@ toWaiAppYre yre req =
if S.null (W.rawQueryString env)
then dest
else dest `mappend`
Blaze.ByteString.Builder.fromByteString (W.rawQueryString env)
byteString (W.rawQueryString env)
-- | Same as 'toWaiAppPlain', but provides a default set of middlewares. This
-- set may change with future releases, but currently covers:

31
yesod-core/Yesod/Core/Handler.hs
View File

@ -240,13 +240,13 @@ import Web.PathPieces (PathPiece(..))
import Yesod.Core.Class.Handler
import Yesod.Core.Types
import Yesod.Routes.Class (Route)
import Blaze.ByteString.Builder (Builder)
import Data.ByteString.Builder (Builder)
import Safe (headMay)
import Data.CaseInsensitive (CI, original)
import qualified Data.Conduit.List as CL
import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO)
import qualified System.PosixCompat.Files as PC
import Data.Conduit (Source, transPipe, Flush (Flush), yield, Producer, Sink)
import Data.Conduit (ConduitT, transPipe, Flush (Flush), yield, Void)
import qualified Yesod.Core.TypeCache as Cache
import qualified Data.Word8 as W8
import qualified Data.Foldable as Fold
@ -679,9 +679,10 @@ sendRawResponseNoConduit raw = withRunInIO $ \runInIO ->
-- Warp).
--
-- @since 1.2.7
sendRawResponse :: (MonadHandler m, MonadUnliftIO m)
=> (Source IO S8.ByteString -> Sink S8.ByteString IO () -> m ())
-> m a
sendRawResponse
:: (MonadHandler m, MonadUnliftIO m)
=> (ConduitT () S8.ByteString IO () -> ConduitT S8.ByteString Void IO () -> m ())
-> m a
sendRawResponse raw = withRunInIO $ \runInIO ->
liftIO $ throwIO $ HCWai $ flip W.responseRaw fallback
$ \src sink -> void $ runInIO $ raw (src' src) (CL.mapM_ sink)
@ -1337,7 +1338,7 @@ provideRepType ct handler =
-- | Stream in the raw request body without any parsing.
--
-- @since 1.2.0
rawRequestBody :: MonadHandler m => Source m S.ByteString
rawRequestBody :: MonadHandler m => ConduitT i S.ByteString m ()
rawRequestBody = do
req <- lift waiRequest
let loop = do
@ -1349,7 +1350,7 @@ rawRequestBody = do
-- | Stream the data from the file. Since Yesod 1.2, this has been generalized
-- to work in any @MonadResource@.
fileSource :: MonadResource m => FileInfo -> Source m S.ByteString
fileSource :: MonadResource m => FileInfo -> ConduitT () S.ByteString m ()
fileSource = transPipe liftResourceT . fileSourceRaw
-- | Provide a pure value for the response body.
@ -1370,7 +1371,7 @@ respond ct = return . TypedContent ct . toContent
--
-- @since 1.2.0
respondSource :: ContentType
-> Source (HandlerT site IO) (Flush Builder)
-> ConduitT () (Flush Builder) (HandlerT site IO) ()
-> HandlerT site IO TypedContent
respondSource ctype src = HandlerT $ \hd ->
-- Note that this implementation relies on the fact that the ResourceT
@ -1383,44 +1384,44 @@ respondSource ctype src = HandlerT $ \hd ->
-- on most datatypes, such as @ByteString@ and @Html@.
--
-- @since 1.2.0
sendChunk :: Monad m => ToFlushBuilder a => a -> Producer m (Flush Builder)
sendChunk :: Monad m => ToFlushBuilder a => a -> ConduitT i (Flush Builder) m ()
sendChunk = yield . toFlushBuilder
-- | In a streaming response, send a flush command, causing all buffered data
-- to be immediately sent to the client.
--
-- @since 1.2.0
sendFlush :: Monad m => Producer m (Flush Builder)
sendFlush :: Monad m => ConduitT i (Flush Builder) m ()
sendFlush = yield Flush
-- | Type-specialized version of 'sendChunk' for strict @ByteString@s.
--
-- @since 1.2.0
sendChunkBS :: Monad m => S.ByteString -> Producer m (Flush Builder)
sendChunkBS :: Monad m => S.ByteString -> ConduitT i (Flush Builder) m ()
sendChunkBS = sendChunk
-- | Type-specialized version of 'sendChunk' for lazy @ByteString@s.
--
-- @since 1.2.0
sendChunkLBS :: Monad m => L.ByteString -> Producer m (Flush Builder)
sendChunkLBS :: Monad m => L.ByteString -> ConduitT i (Flush Builder) m ()
sendChunkLBS = sendChunk
-- | Type-specialized version of 'sendChunk' for strict @Text@s.
--
-- @since 1.2.0
sendChunkText :: Monad m => T.Text -> Producer m (Flush Builder)
sendChunkText :: Monad m => T.Text -> ConduitT i (Flush Builder) m ()
sendChunkText = sendChunk
-- | Type-specialized version of 'sendChunk' for lazy @Text@s.
--
-- @since 1.2.0
sendChunkLazyText :: Monad m => TL.Text -> Producer m (Flush Builder)
sendChunkLazyText :: Monad m => TL.Text -> ConduitT i (Flush Builder) m ()
sendChunkLazyText = sendChunk
-- | Type-specialized version of 'sendChunk' for @Html@s.
--
-- @since 1.2.0
sendChunkHtml :: Monad m => Html -> Producer m (Flush Builder)
sendChunkHtml :: Monad m => Html -> ConduitT i (Flush Builder) m ()
sendChunkHtml = sendChunk
-- | Converts a child handler to a parent handler

6
yesod-core/Yesod/Core/Internal/Request.hs
View File

@ -33,9 +33,7 @@ import qualified Data.Set as Set
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With, decodeUtf8)
import Data.Text.Encoding.Error (lenientDecode)
import Data.Conduit
import Data.Conduit.List (sourceList)
import Data.Conduit.Binary (sourceFile, sinkFile)
import Conduit
import Data.Word (Word8, Word64)
import Control.Monad.Trans.Resource (runResourceT, ResourceT)
import Control.Exception (throwIO)
@ -176,7 +174,7 @@ fromByteVector v =
mkFileInfoLBS :: Text -> Text -> L.ByteString -> FileInfo
mkFileInfoLBS name ct lbs =
FileInfo name ct (sourceList $ L.toChunks lbs) (`L.writeFile` lbs)
FileInfo name ct (sourceLazy lbs) (`L.writeFile` lbs)
mkFileInfoFile :: Text -> Text -> FilePath -> FileInfo
mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runResourceT $ sourceFile fp $$ sinkFile dst)

8
yesod-core/Yesod/Core/Internal/Response.hs
View File

@ -6,6 +6,7 @@ module Yesod.Core.Internal.Response where
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as S8
import qualified Data.ByteString.Lazy as BL
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Network.Wai
@ -18,8 +19,7 @@ import Yesod.Core.Types
import qualified Network.HTTP.Types as H
import qualified Data.Text as T
import Control.Exception (SomeException, handle)
import Blaze.ByteString.Builder (fromLazyByteString,
toLazyByteString, toByteString)
import Data.ByteString.Builder (lazyByteString, toLazyByteString)
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as Map
import Yesod.Core.Internal.Request (tokenKey)
@ -83,7 +83,7 @@ defaultStatus = H.mkStatus (-1) "INVALID DEFAULT STATUS"
headerToPair :: Header
-> (CI ByteString, ByteString)
headerToPair (AddCookie sc) =
("Set-Cookie", toByteString $ renderSetCookie sc)
("Set-Cookie", BL.toStrict $ toLazyByteString $ renderSetCookie sc)
headerToPair (DeleteCookie key path) =
( "Set-Cookie"
, S.concat
@ -100,7 +100,7 @@ evaluateContent (ContentBuilder b mlen) = handle f $ do
let lbs = toLazyByteString b
len = L.length lbs
mlen' = mlen `mplus` Just (fromIntegral len)
len `seq` return (Right $ ContentBuilder (fromLazyByteString lbs) mlen')
len `seq` return (Right $ ContentBuilder (lazyByteString lbs) mlen')
where
f :: SomeException -> IO (Either ErrorResponse Content)
f = return . Left . InternalError . T.pack . show

5
yesod-core/Yesod/Core/Internal/Run.hs
View File

@ -14,7 +14,8 @@ import Data.Monoid (Monoid, mempty)
import Control.Applicative ((<$>))
#endif
import Yesod.Core.Internal.Response
import Blaze.ByteString.Builder (toByteString)
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Lazy as BL
import Control.Exception (fromException, evaluate)
import qualified Control.Exception as E
import Control.Monad.IO.Class (MonadIO, liftIO)
@ -372,7 +373,7 @@ yesodRender :: Yesod y
-> [(Text, Text)] -- ^ url query string
-> Text
yesodRender y ar url params =
decodeUtf8With lenientDecode $ toByteString $
decodeUtf8With lenientDecode $ BL.toStrict $ toLazyByteString $
fromMaybe
(joinPath y ar ps
$ params ++ params')

21
yesod-core/Yesod/Core/Types.hs
View File

@ -9,8 +9,7 @@
{-# LANGUAGE UndecidableInstances #-}
module Yesod.Core.Types where
import qualified Blaze.ByteString.Builder as BBuilder
import qualified Blaze.ByteString.Builder.Char.Utf8
import qualified Data.ByteString.Builder as BB
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative (Applicative (..))
import Control.Applicative ((<$>))
@ -25,7 +24,7 @@ import Control.Monad.Logger (LogLevel, LogSource,
import Control.Monad.Trans.Resource (MonadResource (..), InternalState, runInternalState, MonadThrow (..), throwM, ResourceT)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as L
import Data.Conduit (Flush, Source)
import Data.Conduit (Flush, ConduitT)
import Data.IORef (IORef, modifyIORef')
import Data.Map (Map, unionWith)
import qualified Data.Map as Map
@ -59,7 +58,6 @@ import Control.Monad.Reader (MonadReader (..))
import Data.Monoid ((<>))
import Control.DeepSeq (NFData (rnf))
import Control.DeepSeq.Generics (genericRnf)
import Data.Conduit.Lazy (MonadActive, monadActive)
import Yesod.Core.TypeCache (TypeMap, KeyedTypeMap)
import Control.Monad.Logger (MonadLoggerIO (..))
import Data.Semigroup (Semigroup)
@ -134,13 +132,13 @@ type RequestBodyContents =
data FileInfo = FileInfo
{ fileName :: !Text
, fileContentType :: !Text
, fileSourceRaw :: !(Source (ResourceT IO) ByteString)
, fileSourceRaw :: !(ConduitT () ByteString (ResourceT IO) ())
, fileMove :: !(FilePath -> IO ())
}
data FileUpload = FileUploadMemory !(NWP.BackEnd L.ByteString)
| FileUploadDisk !(InternalState -> NWP.BackEnd FilePath)
| FileUploadSource !(NWP.BackEnd (Source (ResourceT IO) ByteString))
| FileUploadSource !(NWP.BackEnd (ConduitT () ByteString (ResourceT IO) ()))
-- | How to determine the root of the application for constructing URLs.
--
@ -288,8 +286,8 @@ data PageContent url = PageContent
, pageBody :: HtmlUrl url
}
data Content = ContentBuilder !BBuilder.Builder !(Maybe Int) -- ^ The content and optional content length.
| ContentSource !(Source (ResourceT IO) (Flush BBuilder.Builder))
data Content = ContentBuilder !BB.Builder !(Maybe Int) -- ^ The content and optional content length.
| ContentSource !(ConduitT () (Flush BB.Builder) (ResourceT IO) ())
| ContentFile !FilePath !(Maybe FilePart)
| ContentDontEvaluate !Content
@ -444,11 +442,6 @@ instance MonadIO m => MonadLogger (WidgetT site m) where
instance MonadIO m => MonadLoggerIO (WidgetT site m) where
askLoggerIO = WidgetT $ \_ hd -> return $ rheLog $ handlerEnv hd
instance MonadActive m => MonadActive (WidgetT site m) where
monadActive = lift monadActive
instance MonadActive m => MonadActive (HandlerT site m) where
monadActive = lift monadActive
instance MonadTrans (HandlerT site) where
lift = HandlerT . const
@ -496,7 +489,7 @@ instance Monoid (UniqueList x) where
instance Semigroup (UniqueList x)
instance IsString Content where
fromString = flip ContentBuilder Nothing . Blaze.ByteString.Builder.Char.Utf8.fromString
fromString = flip ContentBuilder Nothing . BB.stringUtf8
instance RenderRoute WaiSubsite where
data Route WaiSubsite = WaiSubsiteRoute [Text] [(Text, Text)]

4
yesod-core/test/YesodCoreTest/CleanPath.hs
View File

@ -22,7 +22,7 @@ import qualified Data.Text.Encoding as TE
import Control.Arrow ((***))
import Network.HTTP.Types (encodePath)
import Data.Monoid (mappend)
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
import Data.Text.Encoding (encodeUtf8Builder)
data Subsite = Subsite
@ -64,7 +64,7 @@ instance Yesod Y where
corrected = filter (not . TS.null) s
joinPath Y ar pieces' qs' =
fromText ar `Data.Monoid.mappend` encodePath pieces qs
encodeUtf8Builder ar `Data.Monoid.mappend` encodePath pieces qs
where
pieces = if null pieces' then [""] else pieces'
qs = map (TE.encodeUtf8 *** go) qs'

4
yesod-core/test/YesodCoreTest/ErrorHandling.hs
View File

@ -14,7 +14,7 @@ import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as S8
import Control.Exception (SomeException, try)
import Network.HTTP.Types (Status, mkStatus)
import Blaze.ByteString.Builder (Builder, fromByteString, toLazyByteString)
import Data.ByteString.Builder (Builder, toLazyByteString)
import Data.Monoid (mconcat)
import Data.Text (Text, pack)
import Control.Monad (forM_)
@ -101,7 +101,7 @@ getFileBadNameR :: Handler TypedContent
getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing
goodBuilderContent :: Builder
goodBuilderContent = Data.Monoid.mconcat $ replicate 100 $ fromByteString "This is a test\n"
goodBuilderContent = Data.Monoid.mconcat $ replicate 100 $ "This is a test\n"
getGoodBuilderR :: Handler TypedContent
getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent

4
yesod-core/test/YesodCoreTest/Links.hs
View File

@ -13,7 +13,7 @@ import Yesod.Core
import Network.Wai
import Network.Wai.Test
import Data.Text (Text)
import Blaze.ByteString.Builder (toByteString)
import Data.ByteString.Builder (toLazyByteString)
data Y = Y
mkYesod "Y" [parseRoutes|
@ -86,7 +86,7 @@ case_blanks = runner $ do
liftIO $ do
let go r =
let (ps, qs) = renderRoute r
in toByteString $ joinPath Y "" ps qs
in toLazyByteString $ joinPath Y "" ps qs
(go $ TextR "-") `shouldBe` "/single/--"
(go $ TextR "") `shouldBe` "/single/-"
(go $ TextsR ["", "-", "foo", "", "bar"]) `shouldBe` "/multi/-/--/foo/-/bar"

9
yesod-core/test/YesodCoreTest/RawResponse.hs
View File

@ -22,7 +22,6 @@ import Control.Monad.Trans.Resource (register)
import Data.IORef
import Data.Streaming.Network (bindPortTCP)
import Network.HTTP.Types (status200)
import Blaze.ByteString.Builder (fromByteString)
mkYesod "App" [parseRoutes|
/ HomeR GET
@ -46,16 +45,16 @@ getHomeR = do
getWaiStreamR :: Handler ()
getWaiStreamR = sendWaiResponse $ responseStream status200 [] $ \send flush -> do
flush
send $ fromByteString "hello"
send "hello"
flush
send $ fromByteString " world"
send " world"
getWaiAppStreamR :: Handler ()
getWaiAppStreamR = sendWaiApplication $ \_ f -> f $ responseStream status200 [] $ \send flush -> do
flush
send $ fromByteString "hello"
send "hello"
flush
send $ fromByteString " world"
send " world"
getFreePort :: IO Int
getFreePort = do

5
yesod-core/yesod-core.cabal
View File

@ -25,12 +25,11 @@ library
, time >= 1.5
, wai >= 3.0
, wai-extra >= 3.0.7
, bytestring >= 0.10
, bytestring >= 0.10.2
, text >= 0.7
, template-haskell
, path-pieces >= 0.1.2 && < 0.3
, shakespeare >= 2.0
, blaze-builder >= 0.2.1.4 && < 0.5
, transformers >= 0.4
, mtl
, clientsession >= 0.9.1 && < 0.10
@ -61,6 +60,7 @@ library
, conduit-extra
, deepseq >= 1.3
, deepseq-generics
-- FIXME remove
, mwc-random
, primitive
, word8
@ -187,7 +187,6 @@ test-suite tests
,text
,http-types
, random
, blaze-builder
,HUnit
,QuickCheck >= 2 && < 3
,transformers

12
yesod-static/Yesod/EmbeddedStatic/Generators.hs
View File

@ -24,9 +24,9 @@ module Yesod.EmbeddedStatic.Generators (
-- * Util
, pathToName
-- * Custom Generators
-- $example
) where
@ -34,7 +34,6 @@ import Control.Applicative as A ((<$>), (<*>))
import Control.Exception (try, SomeException)
import Control.Monad (forM, when)
import Data.Char (isDigit, isLower)
import Data.Conduit (($$))
import Data.Default (def)
import Data.Maybe (isNothing)
import Language.Haskell.TH
@ -44,8 +43,7 @@ import System.FilePath ((</>))
import Text.Jasmine (minifym)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Conduit.List as C
import Data.Conduit.Binary (sourceHandle)
import Conduit
import qualified Data.Text as T
import qualified System.Process as Proc
import System.Exit (ExitCode (ExitSuccess))
@ -208,13 +206,13 @@ compressTool f opts ct = do
}
(Just hin, Just hout, _, ph) <- Proc.createProcess p
(compressed, (), code) <- runConcurrently $ (,,)
A.<$> Concurrently (sourceHandle hout $$ C.consume)
A.<$> Concurrently (runConduit $ sourceHandle hout .| sinkLazy)
A.<*> Concurrently (BL.hPut hin ct >> hClose hin)
A.<*> Concurrently (Proc.waitForProcess ph)
if code == ExitSuccess
then do
putStrLn $ "Compressed successfully with " ++ f
return $ BL.fromChunks compressed
return compressed
else error $ "compressTool: compression failed with " ++ f

18
yesod-static/Yesod/Static.hs
View File

@ -94,10 +94,7 @@ import Data.List (foldl')
import qualified Data.ByteString as S
import System.PosixCompat.Files (getFileStatus, modificationTime)
import System.Posix.Types (EpochTime)
import Data.Conduit
import Data.Conduit.List (sourceList, consume)
import Data.Conduit.Binary (sourceFile)
import qualified Data.Conduit.Text as CT
import Conduit
import Data.Functor.Identity (runIdentity)
import System.FilePath ((</>), (<.>), takeDirectory)
import qualified System.FilePath as F
@ -425,8 +422,8 @@ base64md5File = fmap (base64 . encode) . hashFile
base64md5 :: L.ByteString -> String
base64md5 lbs =
base64 $ encode
$ runIdentity
$ sourceList (L.toChunks lbs) $$ sinkHash
$ runConduitPure
$ Conduit.sourceLazy lbs .| sinkHash
where
encode d = ByteArray.convert (d :: Digest MD5)
@ -461,8 +458,11 @@ combineStatics' :: CombineType
-> [Route Static] -- ^ files to combine
-> Q Exp
combineStatics' combineType CombineSettings {..} routes = do
texts <- qRunIO $ runResourceT $ mapM_ yield fps $$ awaitForever readUTFFile =$ consume
ltext <- qRunIO $ preProcess $ TL.fromChunks texts
texts <- qRunIO $ runConduitRes
$ yieldMany fps
.| awaitForever readUTFFile
.| sinkLazy
ltext <- qRunIO $ preProcess texts
bs <- qRunIO $ postProcess fps $ TLE.encodeUtf8 ltext
let hash' = base64md5 bs
suffix = csCombinedFolder </> hash' <.> extension
@ -476,7 +476,7 @@ combineStatics' combineType CombineSettings {..} routes = do
fps :: [FilePath]
fps = map toFP routes
toFP (StaticRoute pieces _) = csStaticDir </> F.joinPath (map T.unpack pieces)
readUTFFile fp = sourceFile fp =$= CT.decode CT.utf8
readUTFFile fp = sourceFile fp .| decodeUtf8C
postProcess =
case combineType of
JS -> csJsPostProcess

4
yesod-static/yesod-static.cabal
View File

@ -42,8 +42,7 @@ library
, file-embed >= 0.0.4.1 && < 0.5
, http-types >= 0.7
, unix-compat >= 0.2
, conduit >= 0.5
, conduit-extra
, conduit >= 1.3
, cryptonite-conduit >= 0.1
, cryptonite >= 0.11
, memory
@ -124,7 +123,6 @@ test-suite tests
, unordered-containers
, async
, process
, conduit-extra
, exceptions
ghc-options: -Wall -threaded

8
yesod/Yesod/Default/Util.hs
View File

@ -18,9 +18,7 @@ import qualified Data.ByteString.Lazy as L
import Data.Text (Text, pack, unpack)
import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
import Control.Monad (when, unless)
import Control.Monad.Trans.Resource (runResourceT)
import Data.Conduit (($$))
import Data.Conduit.Binary (sourceLbs, sinkFileCautious)
import Conduit
import System.Directory (doesFileExist, createDirectoryIfMissing)
import Language.Haskell.TH.Syntax
import Text.Lucius (luciusFile, luciusFileReload)
@ -46,8 +44,8 @@ addStaticContentExternal
addStaticContentExternal minify hash staticDir toRoute ext' _ content = do
liftIO $ createDirectoryIfMissing True statictmp
exists <- liftIO $ doesFileExist fn'
unless exists $
liftIO $ runResourceT $ sourceLbs content' $$ sinkFileCautious fn'
unless exists $ withSinkFileCautious fn' $ \sink ->
runConduit $ sourceLazy content' .| sink
return $ Just $ Right (toRoute ["tmp", pack fn], [])
where
fn, statictmp, fn' :: FilePath

3
yesod/yesod.cabal
View File

@ -38,8 +38,7 @@ library
, bytestring
, monad-logger
, fast-logger
, conduit
, conduit-extra >= 1.1.14
, conduit >= 1.3
, resourcet
, shakespeare
, streaming-commons