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

Cleanup warnings

Browse Source
This commit is contained in:
Michael Snoyman 2018-01-15 15:09:07 +02:00
parent 1f7a2a287b
commit 60f65ed267
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
15 changed files with 57 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
yesod-auth/Yesod/Auth.hs
View File

@ -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

6
yesod-auth/Yesod/Auth/GoogleEmail2.hs
View File

@ -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

9
yesod-bin/AddHandler.hs
View File

@ -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

1
yesod-bin/HsFile.hs
View File

@ -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)

2
yesod-core/Yesod/Core/Class/Handler.hs
View File

@ -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

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

@ -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"

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

@ -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)

2
yesod-core/bench/widget.hs
View File

@ -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 ()

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

@ -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

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

@ -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 ""

23
yesod-eventsource/Yesod/EventSource.hs
View File

@ -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@

6
yesod-persistent/Yesod/Persist/Core.hs
View File

@ -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

2
yesod-persistent/test/Yesod/PersistSpec.hs
View File

@ -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

6
yesod-sitemap/Yesod/Sitemap.hs
View File

@ -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

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

@ -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