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

Cleanup GHC 8 redundant constraints

Browse Source
This commit is contained in:
Michael Snoyman 2017-02-05 13:35:12 +02:00
parent 3dc2d10b30
commit aefd074efa
16 changed files with 49 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
yesod-auth-oauth/Yesod/Auth/OAuth.hs
View File

@ -83,7 +83,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
let oaUrl = render $ tm $ oauthUrl name
[whamlet| <a href=#{oaUrl}>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

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

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

17
yesod-auth/Yesod/Auth/Email.hs
View File

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

2
yesod-auth/Yesod/Auth/GoogleEmail.hs
View File

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

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

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

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

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

2
yesod-core/Yesod/Core/Json.hs
View File

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

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

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

13
yesod-form/Yesod/Form/Fields.hs
View File

@ -439,13 +439,13 @@ $newline never
|]) -- inside
-- | Creates a @\<select>@ tag for selecting multiple options.
multiSelectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
multiSelectFieldList :: (Eq a, RenderMessage site msg)
=> [(msg, a)]
-> Field (HandlerT site IO) [a]
multiSelectFieldList = multiSelectField . optionsPairs
-- | Creates a @\<select>@ 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

5
yesod-form/Yesod/Form/Functions.hs
View File

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

5
yesod-form/Yesod/Form/MassInput.hs
View File

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

6
yesod-static/Yesod/EmbeddedStatic.hs
View File

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

4
yesod-static/Yesod/EmbeddedStatic/Internal.hs
View File

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

10
yesod-test/Yesod/Test.hs
View File

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

4
yesod-websockets/Yesod/WebSockets.hs
View File

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

9
yesod/Yesod/Default/Main.hs
View File

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