diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index b382630a..6a42f3b4 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -72,7 +72,7 @@ import Yesod.Form (FormMessage) import Data.Typeable (Typeable) import Control.Exception (Exception) import Network.HTTP.Types (Status, internalServerError500, unauthorized401) -import Control.Monad.Trans.Resource (MonadResourceBase) +import Control.Monad.Trans.Resource (MonadUnliftIO) import qualified Control.Monad.Trans.Writer as Writer import Control.Monad (void) @@ -222,7 +222,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- | Called on login error for HTTP requests. By default, calls -- @addMessage@ with "error" as status and redirects to @dest@. - onErrorHtml :: (MonadResourceBase m) => Route master -> Text -> HandlerT master m Html + onErrorHtml :: (MonadUnliftIO m) => Route master -> Text -> HandlerT master m Html onErrorHtml dest msg = do addMessage "error" $ toHtml msg fmap asHtml $ redirect dest @@ -288,7 +288,7 @@ defaultLoginHandler = do mapM_ (flip apLogin tp) (authPlugins master) -loginErrorMessageI :: (MonadResourceBase m, YesodAuth master) +loginErrorMessageI :: (MonadUnliftIO m, YesodAuth master) => Route child -> AuthMessage -> HandlerT child (HandlerT master m) TypedContent @@ -297,7 +297,7 @@ loginErrorMessageI dest msg = do lift $ loginErrorMessageMasterI (toParent dest) msg -loginErrorMessageMasterI :: (YesodAuth master, MonadResourceBase m, RenderMessage master AuthMessage) +loginErrorMessageMasterI :: (YesodAuth master, MonadUnliftIO m, RenderMessage master AuthMessage) => Route master -> AuthMessage -> HandlerT master m TypedContent @@ -307,19 +307,19 @@ loginErrorMessageMasterI dest msg = do -- | For HTML, set the message and redirect to the route. -- For JSON, send the message and a 401 status -loginErrorMessage :: (YesodAuth master, MonadResourceBase m) +loginErrorMessage :: (YesodAuth master, MonadUnliftIO m) => Route master -> Text -> HandlerT master m TypedContent loginErrorMessage dest msg = messageJson401 msg (onErrorHtml dest msg) -messageJson401 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent +messageJson401 :: MonadUnliftIO m => Text -> HandlerT master m Html -> HandlerT master m TypedContent messageJson401 = messageJsonStatus unauthorized401 -messageJson500 :: MonadResourceBase m => Text -> HandlerT master m Html -> HandlerT master m TypedContent +messageJson500 :: MonadUnliftIO m => Text -> HandlerT master m Html -> HandlerT master m TypedContent messageJson500 = messageJsonStatus internalServerError500 -messageJsonStatus :: MonadResourceBase m +messageJsonStatus :: MonadUnliftIO m => Status -> Text -> HandlerT master m Html diff --git a/yesod-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index 5b291178..1cb9d571 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -82,7 +82,7 @@ import qualified Data.Aeson.Encode as A import Data.Aeson.Parser (json') import Data.Aeson.Types (FromJSON (parseJSON), parseEither, parseMaybe, withObject, withText) -import Data.Conduit (($$+-), ($$)) +import Data.Conduit import Data.Conduit.Attoparsec (sinkParser) import qualified Data.HashMap.Strict as M import Data.Maybe (fromMaybe) @@ -266,7 +266,7 @@ makeHttpRequest => Request -> HandlerT Auth (HandlerT site IO) A.Value makeHttpRequest req = lift $ - runHttpRequest req $ \res -> bodyReaderSource (responseBody res) $$ sinkParser json' + runHttpRequest req $ \res -> runConduit $ bodyReaderSource (responseBody res) .| sinkParser json' -- | Allows to fetch information about a user from Google's API. -- In case of parsing error returns 'Nothing'. @@ -277,7 +277,7 @@ getPerson :: Manager -> Token -> HandlerT site IO (Maybe Person) getPerson manager token = parseMaybe parseJSON <$> (do req <- personValueRequest token res <- http req manager - responseBody res $$ sinkParser json' + runConduit $ responseBody res .| sinkParser json' ) personValueRequest :: MonadIO m => Token -> m Request diff --git a/yesod-bin/AddHandler.hs b/yesod-bin/AddHandler.hs index e925661f..8995a0b1 100644 --- a/yesod-bin/AddHandler.hs +++ b/yesod-bin/AddHandler.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE PatternGuards #-} module AddHandler (addHandler) where @@ -8,7 +9,11 @@ import Data.List (isPrefixOf, isSuffixOf, stripPrefix) import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Text as T import qualified Data.Text.IO as TIO +#if MIN_VERSION_Cabal(2, 0, 0) +import Distribution.PackageDescription.Parse (readGenericPackageDescription) +#else import Distribution.PackageDescription.Parse (readPackageDescription) +#endif import Distribution.PackageDescription.Configuration (flattenPackageDescription) import Distribution.PackageDescription (allBuildInfo, hsSourceDirs) import Distribution.Verbosity (normal) @@ -224,7 +229,11 @@ uncapitalize "" = "" getSrcDir :: FilePath -> IO FilePath getSrcDir cabal = do +#if MIN_VERSION_Cabal(2, 0, 0) + pd <- flattenPackageDescription <$> readGenericPackageDescription normal cabal +#else pd <- flattenPackageDescription <$> readPackageDescription normal cabal +#endif let buildInfo = allBuildInfo pd srcDirs = concatMap hsSourceDirs buildInfo return $ fromMaybe "." $ listToMaybe srcDirs diff --git a/yesod-bin/HsFile.hs b/yesod-bin/HsFile.hs index 18868c24..6c73fecf 100644 --- a/yesod-bin/HsFile.hs +++ b/yesod-bin/HsFile.hs @@ -3,7 +3,6 @@ module HsFile (mkHsFile) where import Text.ProjectTemplate (createTemplate) import Conduit -import Control.Monad.Trans.Resource (runResourceT) import qualified Data.ByteString as BS import Control.Monad.IO.Class (liftIO) import Data.String (fromString) diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs index 6e979c2e..44357bfd 100644 --- a/yesod-core/Yesod/Core/Class/Handler.hs +++ b/yesod-core/Yesod/Core/Class/Handler.hs @@ -11,7 +11,7 @@ module Yesod.Core.Class.Handler ) where import Yesod.Core.Types -import Control.Monad.IO.Unlift (liftIO, MonadUnliftIO, MonadIO) +import Control.Monad.IO.Unlift (liftIO, MonadIO) import Control.Monad.Trans.Resource (MonadResource) import Control.Monad.Trans.Class (lift) #if __GLASGOW_HASKELL__ < 710 diff --git a/yesod-core/Yesod/Core/Internal/Request.hs b/yesod-core/Yesod/Core/Internal/Request.hs index 522138db..b30cf30c 100644 --- a/yesod-core/Yesod/Core/Internal/Request.hs +++ b/yesod-core/Yesod/Core/Internal/Request.hs @@ -35,13 +35,11 @@ import Data.Text.Encoding (decodeUtf8With, decodeUtf8) import Data.Text.Encoding.Error (lenientDecode) import Conduit import Data.Word (Word8, Word64) -import Control.Monad.Trans.Resource (runResourceT, ResourceT) import Control.Exception (throwIO) import Control.Monad ((<=<), liftM) import Yesod.Core.Types import qualified Data.Map as Map import Data.IORef -import Control.Monad.Primitive (PrimMonad, PrimState) import qualified Data.Vector.Storable as V import Data.ByteString.Internal (ByteString (PS)) import qualified Data.Word8 as Word8 @@ -181,10 +179,10 @@ mkFileInfoLBS name ct 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) +mkFileInfoFile name ct fp = FileInfo name ct (sourceFile fp) (\dst -> runConduitRes $ sourceFile fp .| sinkFile dst) -mkFileInfoSource :: Text -> Text -> Source (ResourceT IO) ByteString -> FileInfo -mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runResourceT $ src $$ sinkFile dst) +mkFileInfoSource :: Text -> Text -> ConduitT () ByteString (ResourceT IO) () -> FileInfo +mkFileInfoSource name ct src = FileInfo name ct src (\dst -> runConduitRes $ src .| sinkFile dst) tokenKey :: IsString a => a tokenKey = "_TOKEN" diff --git a/yesod-core/Yesod/Core/Internal/Response.hs b/yesod-core/Yesod/Core/Internal/Response.hs index a4be46bd..7e2be331 100644 --- a/yesod-core/Yesod/Core/Internal/Response.hs +++ b/yesod-core/Yesod/Core/Internal/Response.hs @@ -24,8 +24,7 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Map as Map import Yesod.Core.Internal.Request (tokenKey) import Data.Text.Encoding (encodeUtf8) -import Data.Conduit (Flush (..), ($$), transPipe) -import qualified Data.Conduit.List as CL +import Conduit yarToResponse :: YesodResponse -> (SessionMap -> IO [Header]) -- ^ save session @@ -53,9 +52,9 @@ yarToResponse (YRPlain s' hs ct c newSess) saveSession yreq _req is sendResponse sendResponse $ ResponseBuilder s hs' b go (ContentFile fp p) = sendResponse $ ResponseFile s finalHeaders fp p go (ContentSource body) = sendResponse $ responseStream s finalHeaders - $ \sendChunk flush -> + $ \sendChunk flush -> runConduit $ transPipe (`runInternalState` is) body - $$ CL.mapM_ (\mchunk -> + .| mapM_C (\mchunk -> case mchunk of Flush -> flush Chunk builder -> sendChunk builder) diff --git a/yesod-core/bench/widget.hs b/yesod-core/bench/widget.hs index 93129680..51d519e8 100644 --- a/yesod-core/bench/widget.hs +++ b/yesod-core/bench/widget.hs @@ -12,8 +12,6 @@ import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8 import Data.Monoid (mconcat) import Text.Blaze.Html5 (table, tr, td) import Text.Blaze.Html (toHtml) -import Yesod.Core.Widget -import Yesod.Core.Types import Data.Int main :: IO () diff --git a/yesod-core/test/YesodCoreTest/RawResponse.hs b/yesod-core/test/YesodCoreTest/RawResponse.hs index 79f69900..60b28807 100644 --- a/yesod-core/test/YesodCoreTest/RawResponse.hs +++ b/yesod-core/test/YesodCoreTest/RawResponse.hs @@ -39,8 +39,8 @@ getHomeR = do _ <- register $ writeIORef ref 1 sendRawResponse $ \src sink -> liftIO $ do val <- readIORef ref - yield (S8.pack $ show val) $$ sink - src $$ CL.map (S8.map toUpper) =$ sink + runConduit $ yield (S8.pack $ show val) .| sink + runConduit $ src .| CL.map (S8.map toUpper) .| sink getWaiStreamR :: Handler () getWaiStreamR = sendWaiResponse $ responseStream status200 [] $ \send flush -> do @@ -76,18 +76,18 @@ specs = do withAsync (warp port App) $ \_ -> do threadDelay 100000 runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do - yield "GET / HTTP/1.1\r\n\r\nhello" $$ appSink ad - (appSource ad $$ CB.take 6) >>= (`shouldBe` "0HELLO") - yield "WORLd" $$ appSink ad - (appSource ad $$ await) >>= (`shouldBe` Just "WORLD") + runConduit $ yield "GET / HTTP/1.1\r\n\r\nhello" .| appSink ad + runConduit (appSource ad .| CB.take 6) >>= (`shouldBe` "0HELLO") + runConduit $ yield "WORLd" .| appSink ad + runConduit (appSource ad .| await) >>= (`shouldBe` Just "WORLD") let body req = do port <- getFreePort withAsync (warp port App) $ \_ -> do threadDelay 100000 runTCPClient (clientSettings port "127.0.0.1") $ \ad -> do - yield req $$ appSink ad - appSource ad $$ CB.lines =$ do + runConduit $ yield req .| appSink ad + runConduit $ appSource ad .| CB.lines .| do let loop = do x <- await case x of diff --git a/yesod-core/test/YesodCoreTest/RequestBodySize.hs b/yesod-core/test/YesodCoreTest/RequestBodySize.hs index 9926b42e..ac7c696f 100644 --- a/yesod-core/test/YesodCoreTest/RequestBodySize.hs +++ b/yesod-core/test/YesodCoreTest/RequestBodySize.hs @@ -42,11 +42,11 @@ postPostR = do return $ RepPlain $ toContent $ T.concat val postConsumeR = do - body <- rawRequestBody $$ consume + body <- runConduit $ rawRequestBody .| consume return $ RepPlain $ toContent $ S.concat body postPartialConsumeR = do - body <- rawRequestBody $$ isolate 5 =$ consume + body <- runConduit $ rawRequestBody .| isolate 5 .| consume return $ RepPlain $ toContent $ S.concat body postUnusedR = return $ RepPlain "" diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs index f0918034..81c2b0dc 100644 --- a/yesod-eventsource/Yesod/EventSource.hs +++ b/yesod-eventsource/Yesod/EventSource.hs @@ -13,7 +13,7 @@ import Control.Monad (when) import Data.Functor ((<$>)) import Data.Monoid (Monoid (..)) import Yesod.Core -import qualified Data.Conduit as C +import Data.Conduit import qualified Network.Wai as W import qualified Network.Wai.EventSource as ES import qualified Network.Wai.EventSource.EventStream as ES @@ -32,17 +32,17 @@ prepareForEventSource = do -- | (Internal) Source with a event stream content-type. -respondEventStream :: C.Source (HandlerT site IO) (C.Flush Builder) +respondEventStream :: ConduitT () (Flush Builder) (HandlerT site IO) () -> HandlerT site IO TypedContent respondEventStream = respondSource "text/event-stream" --- | Returns a Server-Sent Event stream from a 'C.Source' of +-- | Returns a Server-Sent Event stream from a 'Source' of -- 'ES.ServerEvent'@s@. The HTTP socket is flushed after every --- event. The connection is closed either when the 'C.Source' +-- event. The connection is closed either when the 'Source' -- finishes outputting data or a 'ES.CloseEvent' is outputted, -- whichever comes first. -repEventSource :: (EventSourcePolyfill -> C.Source (HandlerT site IO) ES.ServerEvent) +repEventSource :: (EventSourcePolyfill -> ConduitT () ES.ServerEvent (HandlerT site IO) ()) -> HandlerT site IO TypedContent repEventSource src = prepareForEventSource >>= @@ -50,14 +50,17 @@ repEventSource src = -- | Convert a ServerEvent source into a Builder source of serialized -- events. -sourceToSource :: Monad m => C.Source m ES.ServerEvent -> C.Source m (C.Flush Builder) +sourceToSource + :: Monad m + => ConduitT () ES.ServerEvent m () + -> ConduitT () (Flush Builder) m () sourceToSource src = - src C.$= C.awaitForever eventToFlushBuilder + src .| awaitForever eventToFlushBuilder where eventToFlushBuilder event = case ES.eventToBuilder event of Nothing -> return () - Just x -> C.yield (C.Chunk x) >> C.yield C.Flush + Just x -> yield (Chunk x) >> yield Flush -- | Return a Server-Sent Event stream given a 'HandlerT' action @@ -79,8 +82,8 @@ pollingEventSource initial act = do [] -> getEvents s' _ -> do let (builder, continue) = joinEvents evs mempty - C.yield (C.Chunk builder) - C.yield C.Flush + yield (Chunk builder) + yield Flush when continue (getEvents s') -- Join all events in a single Builder. Returns @False@ diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index 3f99833f..e07cd7ea 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -118,8 +118,8 @@ defaultGetDBRunner getPool = do -- -- Since 1.2.0 runDBSource :: YesodPersistRunner site - => Source (YesodDB site) a - -> Source (HandlerT site IO) a + => ConduitT () a (YesodDB site) () + -> ConduitT () a (HandlerT site IO) () runDBSource src = do (dbrunner, cleanup) <- lift getDBRunner transPipe (runDBRunner dbrunner) src @@ -128,7 +128,7 @@ runDBSource src = do -- | Extends 'respondSource' to create a streaming database response body. respondSourceDB :: YesodPersistRunner site => ContentType - -> Source (YesodDB site) (Flush Builder) + -> ConduitT () (Flush Builder) (YesodDB site) () -> HandlerT site IO TypedContent respondSourceDB ctype = respondSource ctype . runDBSource diff --git a/yesod-persistent/test/Yesod/PersistSpec.hs b/yesod-persistent/test/Yesod/PersistSpec.hs index fa6a4986..13356553 100644 --- a/yesod-persistent/test/Yesod/PersistSpec.hs +++ b/yesod-persistent/test/Yesod/PersistSpec.hs @@ -45,7 +45,7 @@ getHomeR = do insert_ $ Person "Charlie" insert_ $ Person "Alice" insert_ $ Person "Bob" - respondSourceDB typePlain $ selectSource [] [Asc PersonName] $= awaitForever toBuilder + respondSourceDB typePlain $ selectSource [] [Asc PersonName] .| awaitForever toBuilder where toBuilder (Entity _ (Person name)) = do yield $ Chunk $ fromText name diff --git a/yesod-sitemap/Yesod/Sitemap.hs b/yesod-sitemap/Yesod/Sitemap.hs index 308164f8..9aaa068f 100644 --- a/yesod-sitemap/Yesod/Sitemap.hs +++ b/yesod-sitemap/Yesod/Sitemap.hs @@ -74,13 +74,13 @@ robots smurl = do -- | Serve a stream of @SitemapUrl@s as a sitemap. -- -- Since 1.2.0 -sitemap :: Source (HandlerT site IO) (SitemapUrl (Route site)) +sitemap :: ConduitT () (SitemapUrl (Route site)) (HandlerT site IO) () -> HandlerT site IO TypedContent sitemap urls = do render <- getUrlRender respondSource typeXml $ do yield Flush - urls $= sitemapConduit render $= renderBuilder def $= CL.map Chunk + urls .| sitemapConduit render .| renderBuilder def .| CL.map Chunk -- | Convenience wrapper for @sitemap@ for the case when the input is an -- in-memory list. @@ -97,7 +97,7 @@ sitemapList = sitemap . mapM_ yield -- Since 1.2.0 sitemapConduit :: Monad m => (a -> Text) - -> Conduit (SitemapUrl a) m Event + -> ConduitT (SitemapUrl a) Event m () sitemapConduit render = do yield EventBeginDocument element "urlset" [] $ awaitForever goUrl diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index fd5f8a70..fdff8838 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -68,7 +68,6 @@ import qualified System.FilePath as FP import Control.Monad import Data.FileEmbed (embedDir) -import Control.Monad.Trans.Resource (runResourceT) import Yesod.Core import Yesod.Core.Types @@ -95,7 +94,6 @@ import qualified Data.ByteString as S import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Posix.Types (EpochTime) import Conduit -import Data.Functor.Identity (runIdentity) import System.FilePath ((), (<.>), takeDirectory) import qualified System.FilePath as F import qualified Data.Text.Lazy as TL