Cleanup GHC 8 redundant constraints
This commit is contained in:
parent
3dc2d10b30
commit
aefd074efa
@ -83,7 +83,7 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login
|
|||||||
let oaUrl = render $ tm $ oauthUrl name
|
let oaUrl = render $ tm $ oauthUrl name
|
||||||
[whamlet| <a href=#{oaUrl}>Login via #{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
|
mkExtractCreds name idName (Credential dic) = do
|
||||||
let mcrId = decodeUtf8With lenientDecode <$> lookup (encodeUtf8 $ T.pack idName) dic
|
let mcrId = decodeUtf8With lenientDecode <$> lookup (encodeUtf8 $ T.pack idName) dic
|
||||||
case mcrId of
|
case mcrId of
|
||||||
|
|||||||
@ -167,7 +167,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage
|
|||||||
-- > lift $ redirect HomeR -- or any other Handler code you want
|
-- > lift $ redirect HomeR -- or any other Handler code you want
|
||||||
-- > defaultLoginHandler
|
-- > defaultLoginHandler
|
||||||
--
|
--
|
||||||
loginHandler :: AuthHandler master Html
|
loginHandler :: HandlerT Auth (HandlerT master IO) Html
|
||||||
loginHandler = defaultLoginHandler
|
loginHandler = defaultLoginHandler
|
||||||
|
|
||||||
-- | Used for i18n of messages provided by this package.
|
-- | Used for i18n of messages provided by this package.
|
||||||
|
|||||||
@ -297,7 +297,7 @@ class ( YesodAuth site
|
|||||||
-- Default: 'defaultRegisterHandler'.
|
-- Default: 'defaultRegisterHandler'.
|
||||||
--
|
--
|
||||||
-- @since: 1.2.6
|
-- @since: 1.2.6
|
||||||
registerHandler :: AuthHandler site Html
|
registerHandler :: HandlerT Auth (HandlerT site IO) Html
|
||||||
registerHandler = defaultRegisterHandler
|
registerHandler = defaultRegisterHandler
|
||||||
|
|
||||||
-- | Handler called to render the \"forgot password\" page.
|
-- | Handler called to render the \"forgot password\" page.
|
||||||
@ -307,7 +307,7 @@ class ( YesodAuth site
|
|||||||
-- Default: 'defaultForgotPasswordHandler'.
|
-- Default: 'defaultForgotPasswordHandler'.
|
||||||
--
|
--
|
||||||
-- @since: 1.2.6
|
-- @since: 1.2.6
|
||||||
forgotPasswordHandler :: AuthHandler site Html
|
forgotPasswordHandler :: HandlerT Auth (HandlerT site IO) Html
|
||||||
forgotPasswordHandler = defaultForgotPasswordHandler
|
forgotPasswordHandler = defaultForgotPasswordHandler
|
||||||
|
|
||||||
-- | Handler called to render the \"set password\" page. The
|
-- | Handler called to render the \"set password\" page. The
|
||||||
@ -323,7 +323,7 @@ class ( YesodAuth site
|
|||||||
-- field for the old password should be presented.
|
-- field for the old password should be presented.
|
||||||
-- Otherwise, just two fields for the new password are
|
-- Otherwise, just two fields for the new password are
|
||||||
-- needed.
|
-- needed.
|
||||||
-> AuthHandler site TypedContent
|
-> HandlerT Auth (HandlerT site IO) TypedContent
|
||||||
setPasswordHandler = defaultSetPasswordHandler
|
setPasswordHandler = defaultSetPasswordHandler
|
||||||
|
|
||||||
authEmail :: (YesodAuthEmail m) => AuthPlugin m
|
authEmail :: (YesodAuthEmail m) => AuthPlugin m
|
||||||
@ -405,7 +405,7 @@ emailLoginHandler toParent = do
|
|||||||
-- | Default implementation of 'registerHandler'.
|
-- | Default implementation of 'registerHandler'.
|
||||||
--
|
--
|
||||||
-- @since 1.2.6
|
-- @since 1.2.6
|
||||||
defaultRegisterHandler :: YesodAuthEmail master => AuthHandler master Html
|
defaultRegisterHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
|
||||||
defaultRegisterHandler = do
|
defaultRegisterHandler = do
|
||||||
(widget, enctype) <- lift $ generateFormPost registrationForm
|
(widget, enctype) <- lift $ generateFormPost registrationForm
|
||||||
toParentRoute <- getRouteToParent
|
toParentRoute <- getRouteToParent
|
||||||
@ -502,7 +502,7 @@ getForgotPasswordR = forgotPasswordHandler
|
|||||||
-- | Default implementation of 'forgotPasswordHandler'.
|
-- | Default implementation of 'forgotPasswordHandler'.
|
||||||
--
|
--
|
||||||
-- @since 1.2.6
|
-- @since 1.2.6
|
||||||
defaultForgotPasswordHandler :: YesodAuthEmail master => AuthHandler master Html
|
defaultForgotPasswordHandler :: YesodAuthEmail master => HandlerT Auth (HandlerT master IO) Html
|
||||||
defaultForgotPasswordHandler = do
|
defaultForgotPasswordHandler = do
|
||||||
(widget, enctype) <- lift $ generateFormPost forgotPasswordForm
|
(widget, enctype) <- lift $ generateFormPost forgotPasswordForm
|
||||||
toParent <- getRouteToParent
|
toParent <- getRouteToParent
|
||||||
@ -636,7 +636,7 @@ getPasswordR = do
|
|||||||
-- | Default implementation of 'setPasswordHandler'.
|
-- | Default implementation of 'setPasswordHandler'.
|
||||||
--
|
--
|
||||||
-- @since 1.2.6
|
-- @since 1.2.6
|
||||||
defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> AuthHandler master TypedContent
|
defaultSetPasswordHandler :: YesodAuthEmail master => Bool -> HandlerT Auth (HandlerT master IO) TypedContent
|
||||||
defaultSetPasswordHandler needOld = do
|
defaultSetPasswordHandler needOld = do
|
||||||
messageRender <- lift getMessageRender
|
messageRender <- lift getMessageRender
|
||||||
toParent <- getRouteToParent
|
toParent <- getRouteToParent
|
||||||
@ -823,7 +823,10 @@ loginLinkKey = "_AUTH_EMAIL_LOGIN_LINK"
|
|||||||
-- | Set 'loginLinkKey' to the current time.
|
-- | Set 'loginLinkKey' to the current time.
|
||||||
--
|
--
|
||||||
-- @since 1.2.1
|
-- @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
|
setLoginLinkKey aid = do
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
|
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
|
||||||
|
|||||||
@ -71,7 +71,7 @@ authGoogleEmail =
|
|||||||
completeHelper posts
|
completeHelper posts
|
||||||
dispatch _ _ = notFound
|
dispatch _ _ = notFound
|
||||||
|
|
||||||
completeHelper :: YesodAuth master => [(Text, Text)] -> AuthHandler master TypedContent
|
completeHelper :: [(Text, Text)] -> AuthHandler master TypedContent
|
||||||
completeHelper gets' = do
|
completeHelper gets' = do
|
||||||
master <- lift getYesod
|
master <- lift getYesod
|
||||||
eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
|
eres <- lift $ try $ OpenId.authenticateClaimed gets' (authHttpManager master)
|
||||||
|
|||||||
@ -442,10 +442,9 @@ sameSiteSession s = (fmap . fmap) secureSessionCookies
|
|||||||
-- headers are ignored over HTTP.
|
-- headers are ignored over HTTP.
|
||||||
--
|
--
|
||||||
-- Since 1.4.7
|
-- Since 1.4.7
|
||||||
sslOnlyMiddleware :: Yesod site
|
sslOnlyMiddleware :: Int -- ^ minutes
|
||||||
=> Int -- ^ minutes
|
-> HandlerT site IO res
|
||||||
-> HandlerT site IO res
|
-> HandlerT site IO res
|
||||||
-> HandlerT site IO res
|
|
||||||
sslOnlyMiddleware timeout handler = do
|
sslOnlyMiddleware timeout handler = do
|
||||||
addHeader "Strict-Transport-Security"
|
addHeader "Strict-Transport-Security"
|
||||||
$ T.pack $ concat [ "max-age="
|
$ T.pack $ concat [ "max-age="
|
||||||
@ -496,8 +495,7 @@ defaultCsrfCheckMiddleware handler =
|
|||||||
-- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
|
-- For details, see the "AJAX CSRF protection" section of "Yesod.Core.Handler".
|
||||||
--
|
--
|
||||||
-- Since 1.4.14
|
-- Since 1.4.14
|
||||||
csrfCheckMiddleware :: Yesod site
|
csrfCheckMiddleware :: HandlerT site IO res
|
||||||
=> HandlerT site IO res
|
|
||||||
-> HandlerT site IO Bool -- ^ Whether or not to perform the CSRF check.
|
-> HandlerT site IO Bool -- ^ Whether or not to perform the CSRF check.
|
||||||
-> CI S8.ByteString -- ^ The header name to lookup the CSRF token from.
|
-> CI S8.ByteString -- ^ The header name to lookup the CSRF token from.
|
||||||
-> Text -- ^ The POST parameter 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.
|
-- The cookie's path is set to @/@, making it valid for your whole website.
|
||||||
--
|
--
|
||||||
-- Since 1.4.14
|
-- 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
|
defaultCsrfSetCookieMiddleware handler = setCsrfCookie >> handler
|
||||||
|
|
||||||
-- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie. See 'setCsrfCookieWithCookie'.
|
-- | 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 @/@.
|
-- 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
|
-- 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
|
csrfSetCookieMiddleware handler cookie = setCsrfCookieWithCookie cookie >> handler
|
||||||
|
|
||||||
-- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'.
|
-- | Calls 'defaultCsrfSetCookieMiddleware' and 'defaultCsrfCheckMiddleware'.
|
||||||
@ -546,7 +544,7 @@ defaultCsrfMiddleware :: Yesod site => HandlerT site IO res -> HandlerT site IO
|
|||||||
defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware
|
defaultCsrfMiddleware = defaultCsrfSetCookieMiddleware . defaultCsrfCheckMiddleware
|
||||||
|
|
||||||
-- | Convert a widget to a 'PageContent'.
|
-- | Convert a widget to a 'PageContent'.
|
||||||
widgetToPageContent :: (Eq (Route site), Yesod site)
|
widgetToPageContent :: Yesod site
|
||||||
=> WidgetT site IO ()
|
=> WidgetT site IO ()
|
||||||
-> HandlerT site IO (PageContent (Route site))
|
-> HandlerT site IO (PageContent (Route site))
|
||||||
widgetToPageContent w = do
|
widgetToPageContent w = do
|
||||||
|
|||||||
@ -1119,13 +1119,13 @@ lookupPostParam :: (MonadResource m, MonadHandler m)
|
|||||||
lookupPostParam = fmap listToMaybe . lookupPostParams
|
lookupPostParam = fmap listToMaybe . lookupPostParams
|
||||||
|
|
||||||
-- | Lookup for POSTed files.
|
-- | Lookup for POSTed files.
|
||||||
lookupFile :: (MonadHandler m, MonadResource m)
|
lookupFile :: MonadHandler m
|
||||||
=> Text
|
=> Text
|
||||||
-> m (Maybe FileInfo)
|
-> m (Maybe FileInfo)
|
||||||
lookupFile = fmap listToMaybe . lookupFiles
|
lookupFile = fmap listToMaybe . lookupFiles
|
||||||
|
|
||||||
-- | Lookup for POSTed files.
|
-- | Lookup for POSTed files.
|
||||||
lookupFiles :: (MonadHandler m, MonadResource m)
|
lookupFiles :: MonadHandler m
|
||||||
=> Text
|
=> Text
|
||||||
-> m [FileInfo]
|
-> m [FileInfo]
|
||||||
lookupFiles pn = do
|
lookupFiles pn = do
|
||||||
|
|||||||
@ -189,7 +189,7 @@ jsonEncodingOrRedirect :: (MonadHandler m, J.ToJSON a)
|
|||||||
jsonEncodingOrRedirect = jsonOrRedirect' J.toEncoding
|
jsonEncodingOrRedirect = jsonOrRedirect' J.toEncoding
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
jsonOrRedirect' :: (MonadHandler m, J.ToJSON a)
|
jsonOrRedirect' :: MonadHandler m
|
||||||
=> (a -> b)
|
=> (a -> b)
|
||||||
-> Route (HandlerSite m) -- ^ Redirect target
|
-> Route (HandlerSite m) -- ^ Redirect target
|
||||||
-> a -- ^ Data to send via JSON
|
-> a -- ^ Data to send via JSON
|
||||||
|
|||||||
@ -462,7 +462,12 @@ instance MonadMask m => MonadMask (WidgetT site m) where
|
|||||||
WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e
|
WidgetT $ \e -> uninterruptibleMask $ \u -> unWidgetT (a $ q u) e
|
||||||
where q u (WidgetT b) = WidgetT (u . b)
|
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
|
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)
|
liftResourceT f = WidgetT $ \hd -> liftIO $ (, mempty) <$> runInternalState f (handlerResource hd)
|
||||||
|
|
||||||
instance MonadIO m => MonadLogger (WidgetT site m) where
|
instance MonadIO m => MonadLogger (WidgetT site m) where
|
||||||
|
|||||||
@ -439,13 +439,13 @@ $newline never
|
|||||||
|]) -- inside
|
|]) -- inside
|
||||||
|
|
||||||
-- | Creates a @\<select>@ tag for selecting multiple options.
|
-- | 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)]
|
=> [(msg, a)]
|
||||||
-> Field (HandlerT site IO) [a]
|
-> Field (HandlerT site IO) [a]
|
||||||
multiSelectFieldList = multiSelectField . optionsPairs
|
multiSelectFieldList = multiSelectField . optionsPairs
|
||||||
|
|
||||||
-- | Creates a @\<select>@ tag for selecting multiple options.
|
-- | Creates a @\<select>@ tag for selecting multiple options.
|
||||||
multiSelectField :: (Eq a, RenderMessage site FormMessage)
|
multiSelectField :: Eq a
|
||||||
=> HandlerT site IO (OptionList a)
|
=> HandlerT site IO (OptionList a)
|
||||||
-> Field (HandlerT site IO) [a]
|
-> Field (HandlerT site IO) [a]
|
||||||
multiSelectField ioptlist =
|
multiSelectField ioptlist =
|
||||||
@ -477,12 +477,12 @@ radioFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
|
|||||||
radioFieldList = radioField . optionsPairs
|
radioFieldList = radioField . optionsPairs
|
||||||
|
|
||||||
-- | Creates an input with @type="checkbox"@ for selecting multiple options.
|
-- | 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]
|
-> Field (HandlerT site IO) [a]
|
||||||
checkboxesFieldList = checkboxesField . optionsPairs
|
checkboxesFieldList = checkboxesField . optionsPairs
|
||||||
|
|
||||||
-- | Creates an input with @type="checkbox"@ for selecting multiple options.
|
-- | Creates an input with @type="checkbox"@ for selecting multiple options.
|
||||||
checkboxesField :: (Eq a, RenderMessage site FormMessage)
|
checkboxesField :: Eq a
|
||||||
=> HandlerT site IO (OptionList a)
|
=> HandlerT site IO (OptionList a)
|
||||||
-> Field (HandlerT site IO) [a]
|
-> Field (HandlerT site IO) [a]
|
||||||
checkboxesField ioptlist = (multiSelectField ioptlist)
|
checkboxesField ioptlist = (multiSelectField ioptlist)
|
||||||
@ -569,7 +569,7 @@ $newline never
|
|||||||
--
|
--
|
||||||
-- Note that this makes the field always optional.
|
-- 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
|
checkBoxField = Field
|
||||||
{ fieldParse = \e _ -> return $ checkBoxParser e
|
{ fieldParse = \e _ -> return $ checkBoxParser e
|
||||||
, fieldView = \theId name attrs val _ -> [whamlet|
|
, fieldView = \theId name attrs val _ -> [whamlet|
|
||||||
@ -757,7 +757,7 @@ selectFieldHelper outside onOpt inside opts' = Field
|
|||||||
Just y -> Right $ Just y
|
Just y -> Right $ Just y
|
||||||
|
|
||||||
-- | Creates an input with @type="file"@.
|
-- | Creates an input with @type="file"@.
|
||||||
fileField :: (Monad m, RenderMessage (HandlerSite m) FormMessage)
|
fileField :: Monad m
|
||||||
=> Field m FileInfo
|
=> Field m FileInfo
|
||||||
fileField = Field
|
fileField = Field
|
||||||
{ fieldParse = \_ files -> return $
|
{ fieldParse = \_ files -> return $
|
||||||
@ -803,7 +803,6 @@ $newline never
|
|||||||
return (res, (fv :), ints', Multipart)
|
return (res, (fv :), ints', Multipart)
|
||||||
|
|
||||||
fileAFormOpt :: MonadHandler m
|
fileAFormOpt :: MonadHandler m
|
||||||
=> RenderMessage (HandlerSite m) FormMessage
|
|
||||||
=> FieldSettings (HandlerSite m)
|
=> FieldSettings (HandlerSite m)
|
||||||
-> AForm m (Maybe FileInfo)
|
-> AForm m (Maybe FileInfo)
|
||||||
fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
|
fileAFormOpt fs = AForm $ \(master, langs) menvs ints -> do
|
||||||
|
|||||||
@ -243,8 +243,7 @@ generateFormPost
|
|||||||
-> m (xml, Enctype)
|
-> m (xml, Enctype)
|
||||||
generateFormPost form = first snd `liftM` postHelper form Nothing
|
generateFormPost form = first snd `liftM` postHelper form Nothing
|
||||||
|
|
||||||
postEnv :: (MonadHandler m, MonadResource m)
|
postEnv :: MonadHandler m => m (Maybe (Env, FileEnv))
|
||||||
=> m (Maybe (Env, FileEnv))
|
|
||||||
postEnv = do
|
postEnv = do
|
||||||
req <- getRequest
|
req <- getRequest
|
||||||
if requestMethod (reqWaiRequest req) == "GET"
|
if requestMethod (reqWaiRequest req) == "GET"
|
||||||
@ -279,7 +278,7 @@ runFormGet form = do
|
|||||||
--
|
--
|
||||||
-- Since 1.3.11
|
-- Since 1.3.11
|
||||||
generateFormGet'
|
generateFormGet'
|
||||||
:: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m)
|
:: MonadHandler m
|
||||||
=> (Html -> MForm m (FormResult a, xml))
|
=> (Html -> MForm m (FormResult a, xml))
|
||||||
-> m (xml, Enctype)
|
-> m (xml, Enctype)
|
||||||
generateFormGet' form = first snd `liftM` getHelper form Nothing
|
generateFormGet' form = first snd `liftM` getHelper form Nothing
|
||||||
|
|||||||
@ -44,7 +44,7 @@ up i = do
|
|||||||
|
|
||||||
-- | Generate a form that accepts 0 or more values from the user, allowing the
|
-- | Generate a form that accepts 0 or more values from the user, allowing the
|
||||||
-- user to specify that a new row is necessary.
|
-- 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
|
=> Html
|
||||||
-- ^ label for the form
|
-- ^ label for the form
|
||||||
-> ([[FieldView site]] -> xml)
|
-> ([[FieldView site]] -> xml)
|
||||||
@ -119,8 +119,7 @@ $newline never
|
|||||||
up 1
|
up 1
|
||||||
return res
|
return res
|
||||||
|
|
||||||
fixme :: (xml ~ WidgetT site IO ())
|
fixme :: [Either xml (FormResult a, [FieldView site])]
|
||||||
=> [Either xml (FormResult a, [FieldView site])]
|
|
||||||
-> (FormResult [a], [xml], [[FieldView site]])
|
-> (FormResult [a], [xml], [[FieldView site]])
|
||||||
fixme eithers =
|
fixme eithers =
|
||||||
(res, xmls, map snd rest)
|
(res, xmls, map snd rest)
|
||||||
|
|||||||
@ -59,7 +59,6 @@ import Network.Wai.Application.Static (staticApp)
|
|||||||
import System.IO.Unsafe (unsafePerformIO)
|
import System.IO.Unsafe (unsafePerformIO)
|
||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
( HandlerT
|
( HandlerT
|
||||||
, Yesod(..)
|
|
||||||
, YesodSubDispatch(..)
|
, YesodSubDispatch(..)
|
||||||
)
|
)
|
||||||
import Yesod.Core.Types
|
import Yesod.Core.Types
|
||||||
@ -82,7 +81,7 @@ import Yesod.EmbeddedStatic.Generators
|
|||||||
embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic
|
embeddedResourceR :: [T.Text] -> [(T.Text, T.Text)] -> Route EmbeddedStatic
|
||||||
embeddedResourceR = EmbeddedResourceR
|
embeddedResourceR = EmbeddedResourceR
|
||||||
|
|
||||||
instance Yesod master => YesodSubDispatch EmbeddedStatic (HandlerT master IO) where
|
instance YesodSubDispatch EmbeddedStatic (HandlerT master IO) where
|
||||||
yesodSubDispatch YesodSubRunnerEnv {..} req = resp
|
yesodSubDispatch YesodSubRunnerEnv {..} req = resp
|
||||||
where
|
where
|
||||||
master = yreSite ysreParentEnv
|
master = yreSite ysreParentEnv
|
||||||
@ -176,8 +175,7 @@ mkEmbeddedStatic dev esName gen = do
|
|||||||
-- > addStaticContent = embedStaticContent getStatic StaticR mini
|
-- > addStaticContent = embedStaticContent getStatic StaticR mini
|
||||||
-- > where mini = if development then Right else minifym
|
-- > where mini = if development then Right else minifym
|
||||||
-- > ...
|
-- > ...
|
||||||
embedStaticContent :: Yesod site
|
embedStaticContent :: (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site
|
||||||
=> (site -> EmbeddedStatic) -- ^ How to retrieve the embedded static subsite from your site
|
|
||||||
-> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route
|
-> (Route EmbeddedStatic -> Route site) -- ^ how to convert an embedded static route
|
||||||
-> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier
|
-> (BL.ByteString -> Either a BL.ByteString) -- ^ javascript minifier
|
||||||
-> AddStaticContent site
|
-> AddStaticContent site
|
||||||
|
|||||||
@ -28,7 +28,6 @@ import Yesod.Core
|
|||||||
( HandlerT
|
( HandlerT
|
||||||
, ParseRoute(..)
|
, ParseRoute(..)
|
||||||
, RenderRoute(..)
|
, RenderRoute(..)
|
||||||
, Yesod(..)
|
|
||||||
, getYesod
|
, getYesod
|
||||||
, liftIO
|
, 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)])))
|
-> HandlerT site IO (Maybe (Either T.Text (Route site, [(T.Text, T.Text)])))
|
||||||
|
|
||||||
-- | Helper for embedStaticContent and embedLicensedStaticContent.
|
-- | Helper for embedStaticContent and embedLicensedStaticContent.
|
||||||
staticContentHelper :: Yesod site
|
staticContentHelper :: (site -> EmbeddedStatic)
|
||||||
=> (site -> EmbeddedStatic)
|
|
||||||
-> (Route EmbeddedStatic -> Route site)
|
-> (Route EmbeddedStatic -> Route site)
|
||||||
-> (BL.ByteString -> Either a BL.ByteString)
|
-> (BL.ByteString -> Either a BL.ByteString)
|
||||||
-> AddStaticContent site
|
-> AddStaticContent site
|
||||||
|
|||||||
@ -760,8 +760,7 @@ followRedirect = do
|
|||||||
-- > (Right (ResourceR resourceId)) <- getLocation
|
-- > (Right (ResourceR resourceId)) <- getLocation
|
||||||
--
|
--
|
||||||
-- @since 1.5.4
|
-- @since 1.5.4
|
||||||
getLocation :: (Yesod site, ParseRoute site)
|
getLocation :: ParseRoute site => YesodExample site (Either T.Text (Route site))
|
||||||
=> YesodExample site (Either T.Text (Route site))
|
|
||||||
getLocation = do
|
getLocation = do
|
||||||
mr <- getResponse
|
mr <- getResponse
|
||||||
case mr of
|
case mr of
|
||||||
@ -829,9 +828,7 @@ setUrl url' = do
|
|||||||
-- > import Data.Aeson
|
-- > import Data.Aeson
|
||||||
-- > request $ do
|
-- > request $ do
|
||||||
-- > setRequestBody $ encode $ object ["age" .= (1 :: Integer)]
|
-- > setRequestBody $ encode $ object ["age" .= (1 :: Integer)]
|
||||||
setRequestBody :: (Yesod site)
|
setRequestBody :: BSL8.ByteString -> RequestBuilder site ()
|
||||||
=> BSL8.ByteString
|
|
||||||
-> RequestBuilder site ()
|
|
||||||
setRequestBody body = ST.modify $ \rbd -> rbd { rbdPostData = BinaryPostData body }
|
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.
|
-- | 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"
|
-- > byLabel "First Name" "Felipe"
|
||||||
-- > setMethod "PUT"
|
-- > setMethod "PUT"
|
||||||
-- > setUrl NameR
|
-- > setUrl NameR
|
||||||
request :: Yesod site
|
request :: RequestBuilder site ()
|
||||||
=> RequestBuilder site ()
|
|
||||||
-> YesodExample site ()
|
-> YesodExample site ()
|
||||||
request reqBuilder = do
|
request reqBuilder = do
|
||||||
YesodExampleData app site oldCookies mRes <- ST.get
|
YesodExampleData app site oldCookies mRes <- ST.get
|
||||||
|
|||||||
@ -130,10 +130,10 @@ webSocketsOptionsWith wsConnOpts buildAr inner = do
|
|||||||
sink
|
sink
|
||||||
|
|
||||||
-- | Wrapper for capturing exceptions
|
-- | 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
|
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
|
wrapWS ws x = ReaderT $ liftIO . flip ws x
|
||||||
|
|
||||||
-- | Receive a piece of data from the client.
|
-- | Receive a piece of data from the client.
|
||||||
|
|||||||
@ -41,8 +41,7 @@ import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)
|
|||||||
-- > main :: IO ()
|
-- > main :: IO ()
|
||||||
-- > main = defaultMain (fromArgs parseExtra) makeApplication
|
-- > main = defaultMain (fromArgs parseExtra) makeApplication
|
||||||
--
|
--
|
||||||
defaultMain :: (Show env, Read env)
|
defaultMain :: IO (AppConfig env extra)
|
||||||
=> IO (AppConfig env extra)
|
|
||||||
-> (AppConfig env extra -> IO Application)
|
-> (AppConfig env extra -> IO Application)
|
||||||
-> IO ()
|
-> IO ()
|
||||||
defaultMain load getApp = do
|
defaultMain load getApp = do
|
||||||
@ -60,8 +59,7 @@ type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
|
|||||||
-- @Application@ to install Warp exception handlers.
|
-- @Application@ to install Warp exception handlers.
|
||||||
--
|
--
|
||||||
-- Since 1.2.5
|
-- Since 1.2.5
|
||||||
defaultMainLog :: (Show env, Read env)
|
defaultMainLog :: IO (AppConfig env extra)
|
||||||
=> IO (AppConfig env extra)
|
|
||||||
-> (AppConfig env extra -> IO (Application, LogFunc))
|
-> (AppConfig env extra -> IO (Application, LogFunc))
|
||||||
-> IO ()
|
-> IO ()
|
||||||
defaultMainLog load getApp = do
|
defaultMainLog load getApp = do
|
||||||
@ -113,8 +111,7 @@ defaultRunner f app = do
|
|||||||
-- | Run your development app using a custom environment type and loader
|
-- | Run your development app using a custom environment type and loader
|
||||||
-- function
|
-- function
|
||||||
defaultDevelApp
|
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@
|
-> (AppConfig env extra -> IO Application) -- ^ Get your @Application@
|
||||||
-> IO (Int, Application)
|
-> IO (Int, Application)
|
||||||
defaultDevelApp load getApp = do
|
defaultDevelApp load getApp = do
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user