Skip to content

Commit

Permalink
Cleanup GHC 8 redundant constraints
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Feb 5, 2017
1 parent 3dc2d10 commit aefd074
Show file tree
Hide file tree
Showing 16 changed files with 49 additions and 57 deletions.
2 changes: 1 addition & 1 deletion yesod-auth-oauth/Yesod/Auth/OAuth.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion yesod-auth/Yesod/Auth.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
17 changes: 10 additions & 7 deletions yesod-auth/Yesod/Auth/Email.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion yesod-auth/Yesod/Auth/GoogleEmail.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
16 changes: 7 additions & 9 deletions yesod-core/Yesod/Core/Class/Yesod.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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="
Expand Down Expand Up @@ -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.
Expand All @@ -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'.
Expand All @@ -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'.
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions yesod-core/Yesod/Core/Handler.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion yesod-core/Yesod/Core/Json.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 5 additions & 0 deletions yesod-core/Yesod/Core/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
13 changes: 6 additions & 7 deletions yesod-form/Yesod/Form/Fields.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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|
Expand Down Expand Up @@ -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 $
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions yesod-form/Yesod/Form/Functions.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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
Expand Down
5 changes: 2 additions & 3 deletions yesod-form/Yesod/Form/MassInput.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 2 additions & 4 deletions yesod-static/Yesod/EmbeddedStatic.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 1 addition & 3 deletions yesod-static/Yesod/EmbeddedStatic/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ import Yesod.Core
( HandlerT
, ParseRoute(..)
, RenderRoute(..)
, Yesod(..)
, getYesod
, liftIO
)
Expand Down Expand Up @@ -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
Expand Down
10 changes: 3 additions & 7 deletions yesod-test/Yesod/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions yesod-websockets/Yesod/WebSockets.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
9 changes: 3 additions & 6 deletions yesod/Yesod/Default/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit aefd074

Please sign in to comment.