From aefd074efae6228c320a8458ee6956ec4b9229a9 Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Sun, 5 Feb 2017 13:35:12 +0200 Subject: [PATCH] Cleanup GHC 8 redundant constraints --- yesod-auth-oauth/Yesod/Auth/OAuth.hs | 2 +- yesod-auth/Yesod/Auth.hs | 2 +- yesod-auth/Yesod/Auth/Email.hs | 17 ++++++++++------- yesod-auth/Yesod/Auth/GoogleEmail.hs | 2 +- yesod-core/Yesod/Core/Class/Yesod.hs | 16 +++++++--------- yesod-core/Yesod/Core/Handler.hs | 4 ++-- yesod-core/Yesod/Core/Json.hs | 2 +- yesod-core/Yesod/Core/Types.hs | 5 +++++ yesod-form/Yesod/Form/Fields.hs | 13 ++++++------- yesod-form/Yesod/Form/Functions.hs | 5 ++--- yesod-form/Yesod/Form/MassInput.hs | 5 ++--- yesod-static/Yesod/EmbeddedStatic.hs | 6 ++---- yesod-static/Yesod/EmbeddedStatic/Internal.hs | 4 +--- yesod-test/Yesod/Test.hs | 10 +++------- yesod-websockets/Yesod/WebSockets.hs | 4 ++-- yesod/Yesod/Default/Main.hs | 9 +++------ 16 files changed, 49 insertions(+), 57 deletions(-) diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs index 74c5fb29..9a5d3a0e 100644 --- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs +++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs @@ -83,7 +83,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login let oaUrl = render $ tm $ oauthUrl name [whamlet| Login via #{name} |] -mkExtractCreds :: YesodAuth m => Text -> String -> Credential -> IO (Creds m) +mkExtractCreds :: Text -> String -> Credential -> IO (Creds m) mkExtractCreds name idName (Credential dic) = do let mcrId = decodeUtf8With lenientDecode <$> lookup (encodeUtf8 $ T.pack idName) dic case mcrId of diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index d9df75e2..c4cef202 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -167,7 +167,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- > lift $ redirect HomeR -- or any other Handler code you want -- > defaultLoginHandler -- - loginHandler :: AuthHandler master Html + loginHandler :: HandlerT Auth (HandlerT master IO) Html loginHandler = defaultLoginHandler -- | Used for i18n of messages provided by this package. diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index dafda846..0f4bd8fd 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -297,7 +297,7 @@ class ( YesodAuth site -- Default: 'defaultRegisterHandler'. -- -- @since: 1.2.6 - registerHandler :: AuthHandler site Html + registerHandler :: HandlerT Auth (HandlerT site IO) Html registerHandler = defaultRegisterHandler -- | Handler called to render the \"forgot password\" page. @@ -307,7 +307,7 @@ class ( YesodAuth site -- Default: 'defaultForgotPasswordHandler'. -- -- @since: 1.2.6 - forgotPasswordHandler :: AuthHandler site Html + forgotPasswordHandler :: HandlerT Auth (HandlerT site IO) Html forgotPasswordHandler = defaultForgotPasswordHandler -- | Handler called to render the \"set password\" page. The @@ -323,7 +323,7 @@ class ( YesodAuth site -- field for the old password should be presented. -- Otherwise, just two fields for the new password are -- needed. - -> AuthHandler site TypedContent + -> HandlerT Auth (HandlerT site IO) TypedContent setPasswordHandler = defaultSetPasswordHandler authEmail :: (YesodAuthEmail m) => AuthPlugin m @@ -405,7 +405,7 @@ emailLoginHandler toParent = do -- | Default implementation of 'registerHandler'. -- -- @since 1.2.6 -defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html +defaultRegisterHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html defaultRegisterHandler = do (widget, enctype) <- lift $ generateFormPost registrationForm toParentRoute <- getRouteToParent @@ -502,7 +502,7 @@ getForgotPasswordR = forgotPasswordHandler -- | Default implementation of 'forgotPasswordHandler'. -- -- @since 1.2.6 -defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html +defaultForgotPasswordHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html defaultForgotPasswordHandler = do (widget, enctype) <- lift $ generateFormPost forgotPasswordForm toParent <- getRouteToParent @@ -636,7 +636,7 @@ getPasswordR = do -- | Default implementation of 'setPasswordHandler'. -- -- @since 1.2.6 -defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent +defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> HandlerT Auth (HandlerT master IO) TypedContent defaultSetPasswordHandler needOld = do messageRender <- lift getMessageRender toParent <- getRouteToParent @@ -823,7 +823,10 @@ loginLinkKey = "_AUTH_EMAIL_LOGIN_LINK" -- | Set 'loginLinkKey' to the current time. -- -- @since 1.2.1 -setLoginLinkKey :: (YesodAuthEmail site, MonadHandler m, HandlerSite m ~ site) => AuthId site -> m () +--setLoginLinkKey :: (MonadHandler m) => AuthId site -> m () +setLoginLinkKey :: (MonadHandler m, YesodAuthEmail (HandlerSite m)) + => AuthId (HandlerSite m) + -> m () setLoginLinkKey aid = do now <- liftIO getCurrentTime setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now) diff --git a/yesod-auth/Yesod/Auth/GoogleEmail.hs b/yesod-auth/Yesod/Auth/GoogleEmail.hs index ea959df9..eb0b6cee 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail.hs @@ -71,7 +71,7 @@ authGoogleEmail = completeHelper posts dispatch _ _ = notFound -completeHelper :: YesodAuth master => [(Text, Text)] -> AuthHandler master TypedContent +completeHelper :: [(Text, Text)] -> AuthHandler master TypedContent completeHelper gets' = do master <- lift getYesod eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master) diff --git a/yesod-core/Yesod/Core/Class/Yesod.hs b/yesod-core/Yesod/Core/Class/Yesod.hs index 78e0413d..385ebe7a 100644 --- a/yesod-core/Yesod/Core/Class/Yesod.hs +++ b/yesod-core/Yesod/Core/Class/Yesod.hs @@ -442,10 +442,9 @@ sameSiteSession s = (fmap . fmap) secureSessionCookies -- headers are ignored over HTTP. -- -- Since 1.4.7 -sslOnlyMiddleware :: Yesod site - => Int -- ^ minutes - -> HandlerT site IO res - -> HandlerT site IO res +sslOnlyMiddleware :: Int -- ^ minutes + -> HandlerT site IO res + -> HandlerT site IO res sslOnlyMiddleware timeout handler = do addHeader "Strict-Transport-Security" $ T.pack $ concat [ "max-age=" @@ -496,8 +495,7 @@ defaultCsrfCheckMiddleware handler = -- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler". -- -- Since 1.4.14 -csrfCheckMiddleware :: Yesod site - => HandlerT site IO res +csrfCheckMiddleware :: HandlerT site IO res -> HandlerT site IO Bool -- ^ Whether or not to perform the CSRF check. -> CI S8.ByteString -- ^ The header name to lookup the CSRF token from. -> Text -- ^ The POST parameter name to lookup the CSRF token from. @@ -512,7 +510,7 @@ csrfCheckMiddleware handler shouldCheckFn headerName paramName = do -- The cookie's path is set to @/@, making it valid for your whole website. -- -- Since 1.4.14 -defaultCsrfSetCookieMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO res +defaultCsrfSetCookieMiddleware :: HandlerT site IO res -> HandlerT site IO res defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler -- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie. See 'setCsrfCookieWithCookie'. @@ -522,7 +520,7 @@ defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler -- Make sure to set the 'setCookiePath' to the root path of your application, otherwise you'll generate a new CSRF token for every path of your app. If your app is run from from e.g. www.example.com\/app1, use @app1@. The vast majority of sites will just use @/@. -- -- Since 1.4.14 -csrfSetCookieMiddleware :: Yesod site => HandlerT site IO res -> SetCookie -> HandlerT site IO res +csrfSetCookieMiddleware :: HandlerT site IO res -> SetCookie -> HandlerT site IO res csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handler -- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'. @@ -546,7 +544,7 @@ defaultCsrfMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware -- | Convert a widget to a 'PageContent'. -widgetToPageContent :: (Eq (Route site), Yesod site) +widgetToPageContent :: Yesod site => WidgetT site IO () -> HandlerT site IO (PageContent (Route site)) widgetToPageContent w = do diff --git a/yesod-core/Yesod/Core/Handler.hs b/yesod-core/Yesod/Core/Handler.hs index 087e3bf7..fc58f53f 100644 --- a/yesod-core/Yesod/Core/Handler.hs +++ b/yesod-core/Yesod/Core/Handler.hs @@ -1119,13 +1119,13 @@ lookupPostParam :: (MonadResource m, MonadHandler m) lookupPostParam = fmap listToMaybe . lookupPostParams -- | Lookup for POSTed files. -lookupFile :: (MonadHandler m, MonadResource m) +lookupFile :: MonadHandler m => Text -> m (Maybe FileInfo) lookupFile = fmap listToMaybe . lookupFiles -- | Lookup for POSTed files. -lookupFiles :: (MonadHandler m, MonadResource m) +lookupFiles :: MonadHandler m => Text -> m [FileInfo] lookupFiles pn = do diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs index de47e2c3..dc1116ba 100644 --- a/yesod-core/Yesod/Core/Json.hs +++ b/yesod-core/Yesod/Core/Json.hs @@ -189,7 +189,7 @@ jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a) jsonEncodingOrRedirect = jsonOrRedirect' J.toEncoding #endif -jsonOrRedirect' :: (MonadHandler m, J.ToJSON a) +jsonOrRedirect' :: MonadHandler m => (a -> b) -> Route (HandlerSite m) -- ^ Redirect target -> a -- ^ Data to send via JSON diff --git a/yesod-core/Yesod/Core/Types.hs b/yesod-core/Yesod/Core/Types.hs index 4128cc7b..fa86a6f5 100644 --- a/yesod-core/Yesod/Core/Types.hs +++ b/yesod-core/Yesod/Core/Types.hs @@ -462,7 +462,12 @@ instance MonadMask m => MonadMask (WidgetT site m) where WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e where q u (WidgetT b) = WidgetT (u . b) +-- CPP to avoid a redundant constraints warning +#if MIN_VERSION_base(4,9,0) +instance (MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where +#else instance (Applicative m, MonadIO m, MonadBase IO m, MonadThrow m) => MonadResource (WidgetT site m) where +#endif liftResourceT f = WidgetT $ \hd -> liftIO $ (, mempty) <$> runInternalState f (handlerResource hd) instance MonadIO m => MonadLogger (WidgetT site m) where diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index 71dbd6a0..7bdeb516 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -439,13 +439,13 @@ $newline never |]) -- inside -- | Creates a @\@ tag for selecting multiple options. -multiSelectField :: (Eq a, RenderMessage site FormMessage) +multiSelectField :: Eq a => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) [a] multiSelectField ioptlist = @@ -477,12 +477,12 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) radioFieldList = radioField . optionsPairs -- | Creates an input with @type="checkbox"@ for selecting multiple options. -checkboxesFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg) => [(msg, a)] +checkboxesFieldList :: (Eq a, RenderMessage site msg) => [(msg, a)] -> Field (HandlerT site IO) [a] checkboxesFieldList = checkboxesField . optionsPairs -- | Creates an input with @type="checkbox"@ for selecting multiple options. -checkboxesField :: (Eq a, RenderMessage site FormMessage) +checkboxesField :: Eq a => HandlerT site IO (OptionList a) -> Field (HandlerT site IO) [a] checkboxesField ioptlist = (multiSelectField ioptlist) @@ -569,7 +569,7 @@ $newline never -- -- Note that this makes the field always optional. -- -checkBoxField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Bool +checkBoxField :: Monad m => Field m Bool checkBoxField = Field { fieldParse = \e _ -> return $ checkBoxParser e , fieldView = \theId name attrs val _ -> [whamlet| @@ -757,7 +757,7 @@ selectFieldHelper outside onOpt inside opts' = Field Just y -> Right $ Just y -- | Creates an input with @type="file"@. -fileField :: (Monad m, RenderMessage (HandlerSite m) FormMessage) +fileField :: Monad m => Field m FileInfo fileField = Field { fieldParse = \_ files -> return $ @@ -803,7 +803,6 @@ $newline never return (res, (fv :), ints', Multipart) fileAFormOpt :: MonadHandler m - => RenderMessage (HandlerSite m) FormMessage => FieldSettings (HandlerSite m) -> AForm m (Maybe FileInfo) fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do diff --git a/yesod-form/Yesod/Form/Functions.hs b/yesod-form/Yesod/Form/Functions.hs index 7cea9099..66787523 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -243,8 +243,7 @@ generateFormPost -> m (xml, Enctype) generateFormPost form = first snd `liftM` postHelper form Nothing -postEnv :: (MonadHandler m, MonadResource m) - => m (Maybe (Env, FileEnv)) +postEnv :: MonadHandler m => m (Maybe (Env, FileEnv)) postEnv = do req <- getRequest if requestMethod (reqWaiRequest req) == "GET" @@ -279,7 +278,7 @@ runFormGet form = do -- -- Since 1.3.11 generateFormGet' - :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m) + :: MonadHandler m => (Html -> MForm m (FormResult a, xml)) -> m (xml, Enctype) generateFormGet' form = first snd `liftM` getHelper form Nothing diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index efab6fc9..a87b804c 100644 --- a/yesod-form/Yesod/Form/MassInput.hs +++ b/yesod-form/Yesod/Form/MassInput.hs @@ -44,7 +44,7 @@ up i = do -- | Generate a form that accepts 0 or more values from the user, allowing the -- user to specify that a new row is necessary. -inputList :: (m ~ HandlerT site IO, xml ~ WidgetT site IO (), RenderMessage site FormMessage) +inputList :: (xml ~ WidgetT site IO (), RenderMessage site FormMessage) => Html -- ^ label for the form -> ([[FieldView site]] -> xml) @@ -119,8 +119,7 @@ $newline never up 1 return res -fixme :: (xml ~ WidgetT site IO ()) - => [Either xml (FormResult a, [FieldView site])] +fixme :: [Either xml (FormResult a, [FieldView site])] -> (FormResult [a], [xml], [[FieldView site]]) fixme eithers = (res, xmls, map snd rest) diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs index fc982813..7663ad9f 100644 --- a/yesod-static/Yesod/EmbeddedStatic.hs +++ b/yesod-static/Yesod/EmbeddedStatic.hs @@ -59,7 +59,6 @@ import Network.Wai.Application.Static (staticApp) import System.IO.Unsafe (unsafePerformIO) import Yesod.Core ( HandlerT - , Yesod(..) , YesodSubDispatch(..) ) import Yesod.Core.Types @@ -82,7 +81,7 @@ import Yesod.EmbeddedStatic.Generators embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic embeddedResourceR = EmbeddedResourceR -instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) where +instance YesodSubDispatch EmbeddedStatic (HandlerT master IO) where yesodSubDispatch YesodSubRunnerEnv {..} req = resp where master = yreSite ysreParentEnv @@ -176,8 +175,7 @@ mkEmbeddedStatic dev esName gen = do -- > addStaticContent = embedStaticContent getStatic StaticR mini -- > where mini = if development then Right else minifym -- > ... -embedStaticContent :: Yesod site - => (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site +embedStaticContent :: (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site -> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route -> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier -> AddStaticContent site diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs index 96a0c720..9e778bea 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Internal.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -28,7 +28,6 @@ import Yesod.Core ( HandlerT , ParseRoute(..) , RenderRoute(..) - , Yesod(..) , getYesod , liftIO ) @@ -140,8 +139,7 @@ type AddStaticContent site = T.Text -> T.Text -> BL.ByteString -> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)]))) -- | Helper for embedStaticContent and embedLicensedStaticContent. -staticContentHelper :: Yesod site - => (site -> EmbeddedStatic) +staticContentHelper :: (site -> EmbeddedStatic) -> (Route EmbeddedStatic -> Route site) -> (BL.ByteString -> Either a BL.ByteString) -> AddStaticContent site diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 1e11fb83..93a05b99 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -760,8 +760,7 @@ followRedirect = do -- > (Right (ResourceR resourceId)) <- getLocation -- -- @since 1.5.4 -getLocation :: (Yesod site, ParseRoute site) - => YesodExample site (Either T.Text (Route site)) +getLocation :: ParseRoute site => YesodExample site (Either T.Text (Route site)) getLocation = do mr <- getResponse case mr of @@ -829,9 +828,7 @@ setUrl url' = do -- > import Data.Aeson -- > request $ do -- > setRequestBody $ encode $ object ["age" .= (1 :: Integer)] -setRequestBody :: (Yesod site) - => BSL8.ByteString - -> RequestBuilder site () +setRequestBody :: BSL8.ByteString -> RequestBuilder site () setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body } -- | Adds the given header to the request; see "Network.HTTP.Types.Header" for creating 'Header's. @@ -859,8 +856,7 @@ addRequestHeader header = ST.modify $ \rbd -> rbd -- > byLabel "First Name" "Felipe" -- > setMethod "PUT" -- > setUrl NameR -request :: Yesod site - => RequestBuilder site () +request :: RequestBuilder site () -> YesodExample site () request reqBuilder = do YesodExampleData app site oldCookies mRes <- ST.get diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs index d98c0cb8..243d854f 100644 --- a/yesod-websockets/Yesod/WebSockets.hs +++ b/yesod-websockets/Yesod/WebSockets.hs @@ -130,10 +130,10 @@ webSocketsOptionsWith wsConnOpts buildAr inner = do sink -- | Wrapper for capturing exceptions -wrapWSE :: (MonadIO m, WS.WebSocketsData a) => (WS.Connection -> a -> IO ())-> a -> WebSocketsT m (Either SomeException ()) +wrapWSE :: MonadIO m => (WS.Connection -> a -> IO ())-> a -> WebSocketsT m (Either SomeException ()) wrapWSE ws x = ReaderT $ liftIO . tryAny . flip ws x -wrapWS :: (MonadIO m, WS.WebSocketsData a) => (WS.Connection -> a -> IO ()) -> a -> WebSocketsT m () +wrapWS :: MonadIO m => (WS.Connection -> a -> IO ()) -> a -> WebSocketsT m () wrapWS ws x = ReaderT $ liftIO . flip ws x -- | Receive a piece of data from the client. diff --git a/yesod/Yesod/Default/Main.hs b/yesod/Yesod/Default/Main.hs index 3f316edf..a6282062 100644 --- a/yesod/Yesod/Default/Main.hs +++ b/yesod/Yesod/Default/Main.hs @@ -41,8 +41,7 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) -- > main :: IO () -- > main = defaultMain (fromArgs parseExtra) makeApplication -- -defaultMain :: (Show env, Read env) - => IO (AppConfig env extra) +defaultMain :: IO (AppConfig env extra) -> (AppConfig env extra -> IO Application) -> IO () defaultMain load getApp = do @@ -60,8 +59,7 @@ type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO () -- @Application@ to install Warp exception handlers. -- -- Since 1.2.5 -defaultMainLog :: (Show env, Read env) - => IO (AppConfig env extra) +defaultMainLog :: IO (AppConfig env extra) -> (AppConfig env extra -> IO (Application, LogFunc)) -> IO () defaultMainLog load getApp = do @@ -113,8 +111,7 @@ defaultRunner f app = do -- | Run your development app using a custom environment type and loader -- function defaultDevelApp - :: (Show env, Read env) - => IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ + :: IO (AppConfig env extra) -- ^ A means to load your development @'AppConfig'@ -> (AppConfig env extra -> IO Application) -- ^ Get your @Application@ -> IO (Int, Application) defaultDevelApp load getApp = do