diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 21f78a81..194638f5 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -58,7 +58,7 @@ library , binary , http-client , blaze-builder - , conduit + , conduit >= 1.3 , conduit-extra , nonce >= 1.0.2 && < 1.1 diff --git a/yesod-bin/Devel.hs b/yesod-bin/Devel.hs index 4579064b..c60b17d6 100644 --- a/yesod-bin/Devel.hs +++ b/yesod-bin/Devel.hs @@ -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 diff --git a/yesod-bin/HsFile.hs b/yesod-bin/HsFile.hs index 38093a51..18868c24 100644 --- a/yesod-bin/HsFile.hs +++ b/yesod-bin/HsFile.hs @@ -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) diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 5e169d7e..2903654c 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -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' diff --git a/yesod-core/Yesod/Core/Content.hs b/yesod-core/Yesod/Core/Content.hs index d33d87ad..8a01309a 100644 --- a/yesod-core/Yesod/Core/Content.hs +++ b/yesod-core/Yesod/Core/Content.hs @@ -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 diff --git a/yesod-core/Yesod/Core/Dispatch.hs b/yesod-core/Yesod/Core/Dispatch.hs index d13a154d..e8895cee 100644 --- a/yesod-core/Yesod/Core/Dispatch.hs +++ b/yesod-core/Yesod/Core/Dispatch.hs @@ -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: diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 3395b3bd..93bee351 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -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 diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs index b7e4e3ca..65201b19 100644 --- a/yesod-core/Yesod/Core/Internal/Request.hs +++ b/yesod-core/Yesod/Core/Internal/Request.hs @@ -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) diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index a7263b61..a4be46bd 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -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 diff --git a/yesod-core/Yesod/Core/Internal/Run.hs b/yesod-core/Yesod/Core/Internal/Run.hs index 668e8604..0989b025 100644 --- a/yesod-core/Yesod/Core/Internal/Run.hs +++ b/yesod-core/Yesod/Core/Internal/Run.hs @@ -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') diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 680c13b8..2382f6a6 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -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)] diff --git a/yesod-core/test/YesodCoreTest/CleanPath.hs b/yesod-core/test/YesodCoreTest/CleanPath.hs index 8decc03a..b60a3156 100644 --- a/yesod-core/test/YesodCoreTest/CleanPath.hs +++ b/yesod-core/test/YesodCoreTest/CleanPath.hs @@ -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' diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index db8dfe1c..f6fb6bb4 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -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 diff --git a/yesod-core/test/YesodCoreTest/Links.hs b/yesod-core/test/YesodCoreTest/Links.hs index f195368d..d461704d 100644 --- a/yesod-core/test/YesodCoreTest/Links.hs +++ b/yesod-core/test/YesodCoreTest/Links.hs @@ -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" diff --git a/yesod-core/test/YesodCoreTest/RawResponse.hs b/yesod-core/test/YesodCoreTest/RawResponse.hs index b55688d5..79f69900 100644 --- a/yesod-core/test/YesodCoreTest/RawResponse.hs +++ b/yesod-core/test/YesodCoreTest/RawResponse.hs @@ -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 diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 44e35973..bf61c3d6 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -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 diff --git a/yesod-static/Yesod/EmbeddedStatic/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs index 2d8aeab1..b5c760e1 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Generators.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs @@ -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 diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index 883bf62e..fd5f8a70 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -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 diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 2a9c8506..8ddf0dbc 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -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 diff --git a/yesod/Yesod/Default/Util.hs b/yesod/Yesod/Default/Util.hs index 897031b0..4b12326c 100644 --- a/yesod/Yesod/Default/Util.hs +++ b/yesod/Yesod/Default/Util.hs @@ -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 diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index fdde1f0e..5eb0f06e 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -38,8 +38,7 @@ library , bytestring , monad-logger , fast-logger - , conduit - , conduit-extra >= 1.1.14 + , conduit >= 1.3 , resourcet , shakespeare , streaming-commons