diff --git a/.travis.yml b/.travis.yml index 582d9a41..aab881d9 100644 --- a/.travis.yml +++ b/.travis.yml @@ -178,9 +178,9 @@ script: if [ `uname` = "Darwin" ] then # Use slightly less intensive options on OS X due to Travis timeouts - stack --no-terminal $ARGS test --fast + stack --no-terminal $ARGS test --fast --pedantic else - stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps + stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps --pedantic fi ;; cabal) diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs index 5a8eb79b..9a5d3a0e 100644 --- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs +++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs @@ -10,7 +10,7 @@ module Yesod.Auth.OAuth , tumblrUrl , module Web.Authenticate.OAuth ) where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative as A ((<$>), (<*>)) import Control.Arrow ((***)) import Control.Exception.Lifted import Control.Monad.IO.Class @@ -66,8 +66,8 @@ authOAuth oauth mkCreds = AuthPlugin name dispatch login ] else do (verifier, oaTok) <- - runInputGet $ (,) <$> ireq textField "oauth_verifier" - <*> ireq textField "oauth_token" + runInputGet $ (,) A.<$> ireq textField "oauth_verifier" + A.<*> ireq textField "oauth_token" return $ Credential [ ("oauth_verifier", encodeUtf8 verifier) , ("oauth_token", encodeUtf8 oaTok) , ("oauth_token_secret", encodeUtf8 tokSec) @@ -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 9fe96010..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. @@ -227,7 +227,7 @@ class (Yesod master, PathPiece (AuthId master), RenderMessage master FormMessage -- This is an experimental API that is not broadly used throughout the yesod-auth code base runHttpRequest :: Request -> (Response BodyReader -> HandlerT master IO a) -> HandlerT master IO a runHttpRequest req inner = do - man <- authHttpManager <$> getYesod + man <- authHttpManager Control.Applicative.<$> getYesod HandlerT $ \t -> withResponse req man $ \res -> unHandlerT (inner res) t {-# MINIMAL loginDest, logoutDest, (authenticate | getAuthId), authPlugins, authHttpManager #-} diff --git a/yesod-auth/Yesod/Auth/Email.hs b/yesod-auth/Yesod/Auth/Email.hs index dd439a8c..0f4bd8fd 100644 --- a/yesod-auth/Yesod/Auth/Email.hs +++ b/yesod-auth/Yesod/Auth/Email.hs @@ -131,8 +131,7 @@ import Data.Time (addUTCTime, getCurrentTime) import Safe (readMay) import System.IO.Unsafe (unsafePerformIO) import qualified Text.Email.Validate -import Network.HTTP.Types.Status (status400) -import Data.Aeson.Types (Parser(..), Result(..), parseMaybe, withObject, (.:?)) +import Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?)) import Data.Maybe (isJust, isNothing, fromJust) loginR, registerR, forgotPasswordR, setpassR :: AuthRoute @@ -170,10 +169,10 @@ data EmailCreds site = EmailCreds , emailCredsEmail :: Email } -data ForgotPasswordForm = ForgotPasswordForm { forgotEmail :: Text } -data PasswordForm = PasswordForm { passwordCurrent :: Text, passwordNew :: Text, passwordConfirm :: Text } -data UserForm = UserForm { email :: Text } -data UserLoginForm = UserLoginForm { loginEmail :: Text, loginPassword :: Text } +data ForgotPasswordForm = ForgotPasswordForm { _forgotEmail :: Text } +data PasswordForm = PasswordForm { _passwordCurrent :: Text, _passwordNew :: Text, _passwordConfirm :: Text } +data UserForm = UserForm { _userFormEmail :: Text } +data UserLoginForm = UserLoginForm { _loginEmail :: Text, _loginPassword :: Text } class ( YesodAuth site , PathPiece (AuthEmailId site) @@ -298,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. @@ -308,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 @@ -324,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 @@ -352,7 +351,7 @@ emailLoginHandler toParent = do (widget, enctype) <- liftWidgetT $ generateFormPost loginForm [whamlet| -
+
^{widget}
@@ -371,7 +370,8 @@ emailLoginHandler toParent = do passwordMsg <- renderMessage' Msg.Password (passwordRes, passwordView) <- mreq passwordField (passwordSettings passwordMsg) Nothing - let userRes = UserLoginForm <$> emailRes <*> passwordRes + let userRes = UserLoginForm Control.Applicative.<$> emailRes + Control.Applicative.<*> passwordRes let widget = do [whamlet| #{extra} @@ -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 @@ -603,21 +603,21 @@ postLoginR = do , emailCredsEmail <$> mecreds , emailCredsStatus <$> mecreds ) of - (Just aid, Just email, Just True) -> do + (Just aid, Just email', Just True) -> do mrealpass <- lift $ getPassword aid case mrealpass of Nothing -> return Nothing Just realpass -> return $ if isValidPass pass realpass - then Just email + then Just email' else Nothing _ -> return Nothing let isEmail = Text.Email.Validate.isValid $ encodeUtf8 identifier case maid of - Just email -> + Just email' -> lift $ setCredsRedirect $ Creds (if isEmail then "email" else "username") - email - [("verifiedEmail", email)] + email' + [("verifiedEmail", email')] Nothing -> loginErrorMessageI LoginR $ if isEmail @@ -636,22 +636,22 @@ 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 selectRep $ do provideJsonMessage $ messageRender Msg.SetPass provideRep $ lift $ authLayout $ do - (widget, enctype) <- liftWidgetT $ generateFormPost $ setPasswordForm needOld + (widget, enctype) <- liftWidgetT $ generateFormPost setPasswordForm setTitleI Msg.SetPassTitle [whamlet|

_{Msg.SetPass} - + ^{widget} |] where - setPasswordForm needOld extra = do + setPasswordForm extra = do (currentPasswordRes, currentPasswordView) <- mreq passwordField currentPasswordSettings Nothing (newPasswordRes, newPasswordView) <- mreq passwordField newPasswordSettings Nothing (confirmPasswordRes, confirmPasswordView) <- mreq passwordField confirmPasswordSettings Nothing @@ -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-auth/Yesod/Auth/GoogleEmail2.hs b/yesod-auth/Yesod/Auth/GoogleEmail2.hs index fb8d9f43..a1302999 100644 --- a/yesod-auth/Yesod/Auth/GoogleEmail2.hs +++ b/yesod-auth/Yesod/Auth/GoogleEmail2.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} @@ -59,7 +60,7 @@ import Yesod.Core (HandlerSite, HandlerT, MonadHandler, lift, liftIO, lookupGetParam, lookupSession, notFound, redirect, setSession, whamlet, (.:), - addMessage, getYesod, authRoute, + addMessage, getYesod, toHtml) @@ -85,8 +86,9 @@ import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TL -import Network.HTTP.Client (Manager, parseUrl, requestHeaders, +import Network.HTTP.Client (Manager, requestHeaders, responseBody, urlEncodedBody) +import qualified Network.HTTP.Client as HTTP import Network.HTTP.Client.Conduit (Request, bodyReaderSource) import Network.HTTP.Conduit (http) import Network.HTTP.Types (renderQueryText) @@ -167,7 +169,7 @@ authPlugin storeToken clientID clientSecret = return $ decodeUtf8 $ toByteString $ fromByteString "https://accounts.google.com/o/oauth2/auth" - `mappend` renderQueryText True qs + `Data.Monoid.mappend` renderQueryText True qs login tm = do [whamlet|_{Msg.LoginGoogle}|] @@ -206,7 +208,13 @@ authPlugin storeToken clientID clientSecret = render <- getUrlRender - req' <- liftIO $ parseUrl "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration + req' <- liftIO $ +#if MIN_VERSION_http_client(0,4,30) + HTTP.parseUrlThrow +#else + HTTP.parseUrl +#endif + "https://accounts.google.com/o/oauth2/token" -- FIXME don't hardcode, use: https://accounts.google.com/.well-known/openid-configuration let req = urlEncodedBody [ ("code", encodeUtf8 code) @@ -264,7 +272,13 @@ getPerson manager token = parseMaybe parseJSON <$> (do personValueRequest :: MonadIO m => Token -> m Request personValueRequest token = do - req2' <- liftIO $ parseUrl "https://www.googleapis.com/plus/v1/people/me" + req2' <- liftIO $ +#if MIN_VERSION_http_client(0,4,30) + HTTP.parseUrlThrow +#else + HTTP.parseUrl +#endif + "https://www.googleapis.com/plus/v1/people/me" return req2' { requestHeaders = [ ("Authorization", encodeUtf8 $ "Bearer " `mappend` accessToken token) @@ -284,8 +298,8 @@ data Token = Token { accessToken :: Text instance FromJSON Token where parseJSON = withObject "Tokens" $ \o -> Token - <$> o .: "access_token" - <*> o .: "token_type" + Control.Applicative.<$> o .: "access_token" + Control.Applicative.<*> o .: "token_type" -------------------------------------------------------------------------------- -- | Gender of the person diff --git a/yesod-auth/Yesod/Auth/Hardcoded.hs b/yesod-auth/Yesod/Auth/Hardcoded.hs index 0f7061ad..9421feb4 100644 --- a/yesod-auth/Yesod/Auth/Hardcoded.hs +++ b/yesod-auth/Yesod/Auth/Hardcoded.hs @@ -186,8 +186,8 @@ postLoginR :: (YesodAuthHardcoded master) => HandlerT Auth (HandlerT master IO) TypedContent postLoginR = do (username, password) <- lift (runInputPost - ((,) <$> ireq textField "username" - <*> ireq textField "password")) + ((,) Control.Applicative.<$> ireq textField "username" + Control.Applicative.<*> ireq textField "password")) isValid <- lift (validatePassword username password) if isValid then lift (setCredsRedirect (Creds "hardcoded" username [])) diff --git a/yesod-auth/Yesod/Auth/Message.hs b/yesod-auth/Yesod/Auth/Message.hs index c87afbf8..a2020550 100644 --- a/yesod-auth/Yesod/Auth/Message.hs +++ b/yesod-auth/Yesod/Auth/Message.hs @@ -87,7 +87,7 @@ englishMessage RegisterLong = "Register a new account" englishMessage EnterEmail = "Enter your e-mail address below, and a confirmation e-mail will be sent to you." englishMessage ConfirmationEmailSentTitle = "Confirmation e-mail sent" englishMessage (ConfirmationEmailSent email) = - "A confirmation e-mail has been sent to " `mappend` + "A confirmation e-mail has been sent to " `Data.Monoid.mappend` email `mappend` "." englishMessage AddressVerified = "Address verified, please set a new password" @@ -464,7 +464,7 @@ finnishMessage LoginYahoo = "Kirjaudu Yahoo-tilillä" finnishMessage Email = "Sähköposti" finnishMessage UserName = "Käyttäjätunnus" -- FIXME by Google Translate "user name" finnishMessage Password = "Salasana" -finnishMessage Password = "Current password" +finnishMessage CurrentPassword = "Current password" finnishMessage Register = "Luo uusi" finnishMessage RegisterLong = "Luo uusi tili" finnishMessage EnterEmail = "Kirjoita alle sähköpostiosoitteesi, johon vahvistussähköposti lähetetään." diff --git a/yesod-auth/Yesod/PasswordStore.hs b/yesod-auth/Yesod/PasswordStore.hs index 2bcfc503..9408b7bc 100755 --- a/yesod-auth/Yesod/PasswordStore.hs +++ b/yesod-auth/Yesod/PasswordStore.hs @@ -163,7 +163,7 @@ pbkdf2 password (SaltBS salt) c = let hLen = 32 dkLen = hLen in go hLen dkLen where - go hLen dkLen | dkLen > (2^32 - 1) * hLen = error "Derived key too long." + go hLen dkLen | dkLen > (2^(32 :: Int) - 1) * hLen = error "Derived key too long." | otherwise = let !l = ceiling ((fromIntegral dkLen / fromIntegral hLen) :: Double) !r = dkLen - (l - 1) * hLen @@ -413,17 +413,3 @@ modifySTRef' ref f = do let x' = f x x' `seq` writeSTRef ref x' #endif - -#if MIN_VERSION_bytestring(0, 10, 0) -toStrict :: BL.ByteString -> BS.ByteString -toStrict = BL.toStrict - -fromStrict :: BS.ByteString -> BL.ByteString -fromStrict = BL.fromStrict -#else -toStrict :: BL.ByteString -> BS.ByteString -toStrict = BS.concat . BL.toChunks - -fromStrict :: BS.ByteString -> BL.ByteString -fromStrict = BL.fromChunks . return -#endif diff --git a/yesod-bin/Build.hs b/yesod-bin/Build.hs index 88073226..3050a1a8 100644 --- a/yesod-bin/Build.hs +++ b/yesod-bin/Build.hs @@ -11,7 +11,7 @@ module Build , safeReadFile ) where -import Control.Applicative ((<|>), many, (<$>)) +import Control.Applicative as App ((<|>), many, (<$>)) import qualified Data.Attoparsec.Text as A import Data.Char (isSpace, isUpper) import qualified Data.Text as T @@ -28,7 +28,7 @@ import Control.Monad.Trans.Writer (WriterT, tell, execWriterT) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Class (lift) -import Data.Monoid (Monoid (mappend, mempty)) +import Data.Monoid (Monoid (..)) import qualified Data.Map as Map import qualified Data.Set as Set @@ -77,7 +77,7 @@ getDeps hsSourceDirs = do return $ (hss, fixDeps $ zip hss deps') data AnyFilesTouched = NoFilesTouched | SomeFilesTouched -instance Monoid AnyFilesTouched where +instance Data.Monoid.Monoid AnyFilesTouched where mempty = NoFilesTouched mappend NoFilesTouched NoFilesTouched = mempty mappend _ _ = SomeFilesTouched @@ -201,7 +201,7 @@ determineDeps x = do Left _ -> return [] Right r -> mapM go r >>= filterM (doesFileExist . snd) . concat where - go (Just (StaticFiles fp, _)) = map ((,) AlwaysOutdated) <$> getFolderContents fp + go (Just (StaticFiles fp, _)) = map ((,) AlwaysOutdated) App.<$> getFolderContents fp go (Just (Hamlet, f)) = return [(AlwaysOutdated, f)] go (Just (Widget, f)) = return [ (AlwaysOutdated, "templates/" ++ f ++ ".hamlet") diff --git a/yesod-core/Yesod/Core/Class/Handler.hs b/yesod-core/Yesod/Core/Class/Handler.hs index 9890511a..1d711900 100644 --- a/yesod-core/Yesod/Core/Class/Handler.hs +++ b/yesod-core/Yesod/Core/Class/Handler.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Because of ErrorT module Yesod.Core.Class.Handler ( MonadHandler (..) , MonadWidget (..) 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-core/bench/widget.hs b/yesod-core/bench/widget.hs index 7eefb906..fd210cbe 100644 --- a/yesod-core/bench/widget.hs +++ b/yesod-core/bench/widget.hs @@ -7,20 +7,16 @@ module Main where import Criterion.Main import Text.Hamlet -import Numeric (showInt) import qualified Data.ByteString.Lazy as L 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 Control.Monad.Trans.Writer -import Control.Monad.Trans.RWS -import Data.Functor.Identity import Yesod.Core.Types -import Data.Monoid -import Data.IORef +import Data.Int +main :: IO () main = defaultMain [ bench "bigTable html" $ nf bigTableHtml bigTableData , bench "bigTable hamlet" $ nf bigTableHamlet bigTableData @@ -35,6 +31,7 @@ main = defaultMain bigTableData = replicate rows [1..10] {-# NOINLINE bigTableData #-} +bigTableHtml :: Show a => [[a]] -> Int64 bigTableHtml rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet| $forall row <- rows @@ -43,6 +40,7 @@ bigTableHtml rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet|
#{show cell} |] +bigTableHamlet :: Show a => [[a]] -> Int64 bigTableHamlet rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet| $forall row <- rows @@ -51,6 +49,7 @@ bigTableHamlet rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet|
#{show cell} |] +bigTableWidget :: Show a => [[a]] -> IO Int64 bigTableWidget rows = fmap (L.length . Utf8.renderHtml . ($ render)) (run [whamlet| $forall row <- rows @@ -64,6 +63,7 @@ bigTableWidget rows = fmap (L.length . Utf8.renderHtml . ($ render)) (run [whaml (_, GWData { gwdBody = Body x }) <- w undefined return x -bigTableBlaze t = L.length $ Utf8.renderHtml $ table $ mconcat $ map row t +bigTableBlaze :: Show a => [[a]] -> Int64 +bigTableBlaze t = L.length $ Utf8.renderHtml $ table $ Data.Monoid.mconcat $ map row t where row r = tr $ mconcat $ map (td . toHtml . show) r diff --git a/yesod-core/test.hs b/yesod-core/test.hs deleted file mode 100644 index c85d1890..00000000 --- a/yesod-core/test.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Test.Hspec -import qualified YesodCoreTest - -main :: IO () -main = hspec YesodCoreTest.specs diff --git a/yesod-core/test/Hierarchy.hs b/yesod-core/test/Hierarchy.hs index 3f4890fc..c6994f46 100644 --- a/yesod-core/test/Hierarchy.hs +++ b/yesod-core/test/Hierarchy.hs @@ -17,6 +17,9 @@ module Hierarchy , toText , Env (..) , subDispatch + -- to avoid warnings + , deleteDelete2 + , deleteDelete3 ) where import Test.Hspec diff --git a/yesod-core/test/RouteSpec.hs b/yesod-core/test/RouteSpec.hs index efc0d8d0..f746a2de 100644 --- a/yesod-core/test/RouteSpec.hs +++ b/yesod-core/test/RouteSpec.hs @@ -118,7 +118,7 @@ instance Dispatcher MySub master where route = MySubRoute (pieces, []) instance Dispatcher MySubParam master where - dispatcher env (pieces, method) = + dispatcher env (pieces, _method) = case map unpack pieces of [[c]] -> let route = ParamRoute c @@ -234,56 +234,65 @@ main = hspec $ do describe "overlap checking" $ do it "catches overlapping statics" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /foo Foo2 |] findOverlapNames routes @?= [("Foo1", "Foo2")] it "catches overlapping dynamics" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /#Int Foo1 /#String Foo2 |] findOverlapNames routes @?= [("Foo1", "Foo2")] it "catches overlapping statics and dynamics" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /#String Foo2 |] findOverlapNames routes @?= [("Foo1", "Foo2")] it "catches overlapping multi" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /##*Strings Foo2 |] findOverlapNames routes @?= [("Foo1", "Foo2")] it "catches overlapping subsite" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /foo Foo2 Subsite getSubsite |] findOverlapNames routes @?= [("Foo1", "Foo2")] it "no false positives" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /bar/#String Foo2 |] findOverlapNames routes @?= [] it "obeys ignore rules" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /#!String Foo2 /!foo Foo3 |] findOverlapNames routes @?= [] it "obeys multipiece ignore rules #779" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 /+![String] Foo2 |] findOverlapNames routes @?= [] it "ignore rules for entire route #779" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /foo Foo1 !/+[String] Foo2 !/#String Foo3 @@ -291,7 +300,8 @@ main = hspec $ do |] findOverlapNames routes @?= [] it "ignore rules for hierarchy" $ do - let routes = [parseRoutesNoCheck| + let routes :: [ResourceTree String] + routes = [parseRoutesNoCheck| /+[String] Foo1 !/foo Foo2: /foo Foo3 diff --git a/yesod-core/test/YesodCoreTest/Auth.hs b/yesod-core/test/YesodCoreTest/Auth.hs index 393737b9..b42296a9 100644 --- a/yesod-core/test/YesodCoreTest/Auth.hs +++ b/yesod-core/test/YesodCoreTest/Auth.hs @@ -1,5 +1,9 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses #-} -module YesodCoreTest.Auth (specs, Widget) where +module YesodCoreTest.Auth + ( specs + , Widget + , resourcesApp + ) where import Yesod.Core import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/Cache.hs b/yesod-core/test/YesodCoreTest/Cache.hs index 332a8bc9..04282f81 100644 --- a/yesod-core/test/YesodCoreTest/Cache.hs +++ b/yesod-core/test/YesodCoreTest/Cache.hs @@ -3,7 +3,11 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} -module YesodCoreTest.Cache (cacheTest, Widget) where +module YesodCoreTest.Cache + ( cacheTest + , Widget + , resourcesC + ) where import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/CleanPath.hs b/yesod-core/test/YesodCoreTest/CleanPath.hs index ef100369..8decc03a 100644 --- a/yesod-core/test/YesodCoreTest/CleanPath.hs +++ b/yesod-core/test/YesodCoreTest/CleanPath.hs @@ -2,7 +2,11 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-} {-# LANGUAGE CPP #-} -module YesodCoreTest.CleanPath (cleanPathTest, Widget) where +module YesodCoreTest.CleanPath + ( cleanPathTest + , Widget + , resourcesY + ) where import Test.Hspec @@ -60,7 +64,7 @@ instance Yesod Y where corrected = filter (not . TS.null) s joinPath Y ar pieces' qs' = - fromText ar `mappend` encodePath pieces qs + fromText ar `Data.Monoid.mappend` encodePath pieces qs where pieces = if null pieces' then [""] else pieces' qs = map (TE.encodeUtf8 *** go) qs' diff --git a/yesod-core/test/YesodCoreTest/ErrorHandling.hs b/yesod-core/test/YesodCoreTest/ErrorHandling.hs index e62e1841..f8517b36 100644 --- a/yesod-core/test/YesodCoreTest/ErrorHandling.hs +++ b/yesod-core/test/YesodCoreTest/ErrorHandling.hs @@ -4,6 +4,7 @@ module YesodCoreTest.ErrorHandling ( errorHandlingTest , Widget + , resourcesApp ) where import Yesod.Core import Test.Hspec @@ -98,7 +99,7 @@ getFileBadNameR :: Handler TypedContent getFileBadNameR = return $ TypedContent "ignored" $ ContentFile (error "filebadname") Nothing goodBuilderContent :: Builder -goodBuilderContent = mconcat $ replicate 100 $ fromByteString "This is a test\n" +goodBuilderContent = Data.Monoid.mconcat $ replicate 100 $ fromByteString "This is a test\n" getGoodBuilderR :: Handler TypedContent getGoodBuilderR = return $ TypedContent "text/plain" $ toContent goodBuilderContent @@ -114,6 +115,7 @@ getErrorR 7 = setLanguage undefined getErrorR 8 = cacheSeconds undefined getErrorR 9 = setUltDest (undefined :: Text) getErrorR 10 = setMessage undefined +getErrorR x = error $ "getErrorR: " ++ show x errorHandlingTest :: Spec errorHandlingTest = describe "Test.ErrorHandling" $ do diff --git a/yesod-core/test/YesodCoreTest/Exceptions.hs b/yesod-core/test/YesodCoreTest/Exceptions.hs index 026510e2..df738b33 100644 --- a/yesod-core/test/YesodCoreTest/Exceptions.hs +++ b/yesod-core/test/YesodCoreTest/Exceptions.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -module YesodCoreTest.Exceptions (exceptionsTest, Widget) where +module YesodCoreTest.Exceptions + ( exceptionsTest + , Widget + , resourcesY + ) where import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/InternalRequest.hs b/yesod-core/test/YesodCoreTest/InternalRequest.hs index b29bfd54..314a08ff 100644 --- a/yesod-core/test/YesodCoreTest/InternalRequest.hs +++ b/yesod-core/test/YesodCoreTest/InternalRequest.hs @@ -21,8 +21,8 @@ randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do -- NOTE: this testcase may break on other systems/architectures if -- mkStdGen is not identical everywhere (is it?). -looksRandom :: Bool -looksRandom = runST $ do +_looksRandom :: Bool +_looksRandom = runST $ do gen <- MWC.create s <- randomString 20 gen return $ s == "VH9SkhtptqPs6GqtofVg" @@ -57,7 +57,7 @@ tokenSpecs = describe "Yesod.Internal.Request.parseWaiRequest (reqToken)" $ do noDisabledToken :: Bool noDisabledToken = reqToken r == Nothing where - r = parseWaiRequest' defaultRequest mempty False 1000 + r = parseWaiRequest' defaultRequest Data.Monoid.mempty False 1000 ignoreDisabledToken :: Bool ignoreDisabledToken = reqToken r == Nothing where diff --git a/yesod-core/test/YesodCoreTest/JsLoader.hs b/yesod-core/test/YesodCoreTest/JsLoader.hs index 15956553..955d6975 100644 --- a/yesod-core/test/YesodCoreTest/JsLoader.hs +++ b/yesod-core/test/YesodCoreTest/JsLoader.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -module YesodCoreTest.JsLoader (specs, Widget) where +module YesodCoreTest.JsLoader + ( specs + , Widget + , resourcesH + ) where import YesodCoreTest.JsLoaderSites.Bottom (B(..)) diff --git a/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs b/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs index 58e05624..82356b7b 100644 --- a/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs +++ b/yesod-core/test/YesodCoreTest/JsLoaderSites/Bottom.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -module YesodCoreTest.JsLoaderSites.Bottom (B(..), Widget) where +module YesodCoreTest.JsLoaderSites.Bottom + ( B(..) + , Widget + , resourcesB -- avoid warning + ) where import Yesod.Core diff --git a/yesod-core/test/YesodCoreTest/Json.hs b/yesod-core/test/YesodCoreTest/Json.hs index 968df40d..a338765e 100644 --- a/yesod-core/test/YesodCoreTest/Json.hs +++ b/yesod-core/test/YesodCoreTest/Json.hs @@ -1,5 +1,9 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ViewPatterns #-} -module YesodCoreTest.Json (specs, Widget) where +module YesodCoreTest.Json + ( specs + , Widget + , resourcesApp + ) where import Yesod.Core import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/Links.hs b/yesod-core/test/YesodCoreTest/Links.hs index 7ea42a71..2089026f 100644 --- a/yesod-core/test/YesodCoreTest/Links.hs +++ b/yesod-core/test/YesodCoreTest/Links.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-} -module YesodCoreTest.Links (linksTest, Widget) where +module YesodCoreTest.Links + ( linksTest + , Widget + , resourcesY + ) where import Test.Hspec @@ -26,12 +30,16 @@ mkYesod "Y" [parseRoutes| data Vector a = Vector deriving (Show, Read, Eq) -instance PathMultiPiece (Vector a) +instance PathMultiPiece (Vector a) where + toPathMultiPiece = error "toPathMultiPiece" + fromPathMultiPiece = error "fromPathMultiPiece" data Foo x y = Foo deriving (Show, Read, Eq) -instance PathPiece (Foo x y) +instance PathPiece (Foo x y) where + toPathPiece = error "toPathPiece" + fromPathPiece = error "fromPathPiece" instance Yesod Y diff --git a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs index ec9cfdbb..0785df0b 100644 --- a/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs +++ b/yesod-core/test/YesodCoreTest/NoOverloadedStrings.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- the module name is a lie!!! -module YesodCoreTest.NoOverloadedStrings (noOverloadedTest, Widget) where +module YesodCoreTest.NoOverloadedStrings + ( noOverloadedTest + , Widget + , resourcesY + ) where import Test.Hspec import YesodCoreTest.NoOverloadedStringsSub @@ -60,7 +64,7 @@ runner f = toWaiApp Y >>= runSession f case_sanity :: IO () case_sanity = runner $ do res <- request defaultRequest - assertBody mempty res + assertBody Data.Monoid.mempty res case_subsite :: IO () case_subsite = runner $ do diff --git a/yesod-core/test/YesodCoreTest/RawResponse.hs b/yesod-core/test/YesodCoreTest/RawResponse.hs index fd71a16a..b55688d5 100644 --- a/yesod-core/test/YesodCoreTest/RawResponse.hs +++ b/yesod-core/test/YesodCoreTest/RawResponse.hs @@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ScopedTypeVariables #-} -module YesodCoreTest.RawResponse (specs, Widget) where +module YesodCoreTest.RawResponse + ( specs + , Widget + , resourcesApp + ) where import Yesod.Core import Test.Hspec -import qualified Data.Map as Map -import Network.Wai.Test import Network.Wai (responseStream) -import Data.Text (Text) -import Data.ByteString.Lazy (ByteString) import qualified Data.Conduit.List as CL import qualified Data.ByteString.Char8 as S8 import Data.Conduit @@ -15,7 +15,7 @@ import qualified Data.Conduit.Binary as CB import Data.Char (toUpper) import Control.Exception (try, IOException) import Data.Conduit.Network -import Network.Socket (sClose) +import Network.Socket (close) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (withAsync) import Control.Monad.Trans.Resource (register) @@ -36,7 +36,7 @@ instance Yesod App getHomeR :: Handler () getHomeR = do - ref <- liftIO $ newIORef 0 + ref <- liftIO $ newIORef (0 :: Int) _ <- register $ writeIORef ref 1 sendRawResponse $ \src sink -> liftIO $ do val <- readIORef ref @@ -66,7 +66,7 @@ getFreePort = do case esocket of Left (_ :: IOException) -> loop (succ port) Right socket -> do - sClose socket + close socket return port specs :: Spec diff --git a/yesod-core/test/YesodCoreTest/Redirect.hs b/yesod-core/test/YesodCoreTest/Redirect.hs index 4df457db..d4e63932 100644 --- a/yesod-core/test/YesodCoreTest/Redirect.hs +++ b/yesod-core/test/YesodCoreTest/Redirect.hs @@ -1,5 +1,9 @@ {-# LANGUAGE QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings #-} -module YesodCoreTest.Redirect (specs, Widget) where +module YesodCoreTest.Redirect + ( specs + , Widget + , resourcesY + ) where import YesodCoreTest.YesodTest import Yesod.Core.Handler (redirectWith, setEtag) diff --git a/yesod-core/test/YesodCoreTest/Reps.hs b/yesod-core/test/YesodCoreTest/Reps.hs index 33bc0c54..461a39b8 100644 --- a/yesod-core/test/YesodCoreTest/Reps.hs +++ b/yesod-core/test/YesodCoreTest/Reps.hs @@ -1,5 +1,9 @@ {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ViewPatterns #-} -module YesodCoreTest.Reps (specs, Widget) where +module YesodCoreTest.Reps + ( specs + , Widget + , resourcesApp + ) where import Yesod.Core import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/RequestBodySize.hs b/yesod-core/test/YesodCoreTest/RequestBodySize.hs index 42fa767b..9926b42e 100644 --- a/yesod-core/test/YesodCoreTest/RequestBodySize.hs +++ b/yesod-core/test/YesodCoreTest/RequestBodySize.hs @@ -1,7 +1,11 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -module YesodCoreTest.RequestBodySize (specs, Widget) where +module YesodCoreTest.RequestBodySize + ( specs + , Widget + , resourcesY + ) where import Test.Hspec diff --git a/yesod-core/test/YesodCoreTest/StubLaxSameSite.hs b/yesod-core/test/YesodCoreTest/StubLaxSameSite.hs index 365c9a07..48353c2d 100644 --- a/yesod-core/test/YesodCoreTest/StubLaxSameSite.hs +++ b/yesod-core/test/YesodCoreTest/StubLaxSameSite.hs @@ -1,5 +1,9 @@ {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} -module YesodCoreTest.StubLaxSameSite ( App ( App ) ) where +module YesodCoreTest.StubLaxSameSite + ( App ( App ) + , Widget + , resourcesApp + ) where import Yesod.Core import qualified Web.ClientSession as CS diff --git a/yesod-core/test/YesodCoreTest/StubSslOnly.hs b/yesod-core/test/YesodCoreTest/StubSslOnly.hs index 3ee24fd2..98386c44 100644 --- a/yesod-core/test/YesodCoreTest/StubSslOnly.hs +++ b/yesod-core/test/YesodCoreTest/StubSslOnly.hs @@ -1,5 +1,9 @@ {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} -module YesodCoreTest.StubSslOnly ( App ( App ) ) where +module YesodCoreTest.StubSslOnly + ( App ( App ) + , Widget + , resourcesApp + ) where import Yesod.Core import qualified Web.ClientSession as CS diff --git a/yesod-core/test/YesodCoreTest/StubStrictSameSite.hs b/yesod-core/test/YesodCoreTest/StubStrictSameSite.hs index 0324178e..a354d983 100644 --- a/yesod-core/test/YesodCoreTest/StubStrictSameSite.hs +++ b/yesod-core/test/YesodCoreTest/StubStrictSameSite.hs @@ -1,5 +1,9 @@ {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} -module YesodCoreTest.StubStrictSameSite ( App ( App ) ) where +module YesodCoreTest.StubStrictSameSite + ( App ( App ) + , Widget + , resourcesApp + ) where import Yesod.Core import qualified Web.ClientSession as CS diff --git a/yesod-core/test/YesodCoreTest/StubUnsecured.hs b/yesod-core/test/YesodCoreTest/StubUnsecured.hs index 44367dae..c9db12bd 100644 --- a/yesod-core/test/YesodCoreTest/StubUnsecured.hs +++ b/yesod-core/test/YesodCoreTest/StubUnsecured.hs @@ -1,5 +1,9 @@ {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} -module YesodCoreTest.StubUnsecured ( App ( App ) ) where +module YesodCoreTest.StubUnsecured + ( App ( App ) + , Widget + , resourcesApp + ) where import Yesod.Core diff --git a/yesod-core/test/YesodCoreTest/WaiSubsite.hs b/yesod-core/test/YesodCoreTest/WaiSubsite.hs index aae07e80..87d81144 100644 --- a/yesod-core/test/YesodCoreTest/WaiSubsite.hs +++ b/yesod-core/test/YesodCoreTest/WaiSubsite.hs @@ -1,5 +1,9 @@ {-# LANGUAGE CPP, QuasiQuotes, TemplateHaskell, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, ViewPatterns #-} -module YesodCoreTest.WaiSubsite (specs, Widget) where +module YesodCoreTest.WaiSubsite + ( specs + , Widget + , resourcesY + ) where import YesodCoreTest.YesodTest import Yesod.Core diff --git a/yesod-core/test/YesodCoreTest/Widget.hs b/yesod-core/test/YesodCoreTest/Widget.hs index 2b16e543..5d04fcb1 100644 --- a/yesod-core/test/YesodCoreTest/Widget.hs +++ b/yesod-core/test/YesodCoreTest/Widget.hs @@ -1,7 +1,10 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances, ViewPatterns #-} -module YesodCoreTest.Widget (widgetTest) where +module YesodCoreTest.Widget + ( widgetTest + , resourcesY + ) where import Test.Hspec diff --git a/yesod-core/test/test.hs b/yesod-core/test/test.hs deleted file mode 120000 index a2dc0374..00000000 --- a/yesod-core/test/test.hs +++ /dev/null @@ -1 +0,0 @@ -../test.hs \ No newline at end of file diff --git a/yesod-core/test/test.hs b/yesod-core/test/test.hs new file mode 100644 index 00000000..c85d1890 --- /dev/null +++ b/yesod-core/test/test.hs @@ -0,0 +1,5 @@ +import Test.Hspec +import qualified YesodCoreTest + +main :: IO () +main = hspec YesodCoreTest.specs diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index bbffd416..5496a8d3 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -12,7 +12,6 @@ cabal-version: >= 1.8 build-type: Simple homepage: http://www.yesodweb.com/ extra-source-files: - test.hs test/YesodCoreTest.hs test/YesodCoreTest/*.hs test/YesodCoreTest/JsLoaderSites/Bottom.hs @@ -119,6 +118,15 @@ test-suite test-routes hs-source-dirs: test, . other-modules: Hierarchy + Yesod.Routes.Class + Yesod.Routes.Overlap + Yesod.Routes.Parse + Yesod.Routes.TH + Yesod.Routes.TH.Dispatch + Yesod.Routes.TH.ParseRoute + Yesod.Routes.TH.RenderRoute + Yesod.Routes.TH.RouteAttrs + Yesod.Routes.TH.Types -- Workaround for: http://ghc.haskell.org/trac/ghc/ticket/8443 extensions: TemplateHaskell @@ -138,6 +146,37 @@ test-suite tests main-is: test.hs hs-source-dirs: test + other-modules: YesodCoreTest + YesodCoreTest.Auth + YesodCoreTest.Cache + YesodCoreTest.CleanPath + YesodCoreTest.Csrf + YesodCoreTest.ErrorHandling + YesodCoreTest.Exceptions + YesodCoreTest.InternalRequest + YesodCoreTest.JsLoader + YesodCoreTest.JsLoaderSites.Bottom + YesodCoreTest.Json + YesodCoreTest.Links + YesodCoreTest.LiteApp + YesodCoreTest.Media + YesodCoreTest.MediaData + YesodCoreTest.NoOverloadedStrings + YesodCoreTest.NoOverloadedStringsSub + YesodCoreTest.RawResponse + YesodCoreTest.Redirect + YesodCoreTest.Reps + YesodCoreTest.RequestBodySize + YesodCoreTest.Ssl + YesodCoreTest.Streaming + YesodCoreTest.StubLaxSameSite + YesodCoreTest.StubSslOnly + YesodCoreTest.StubStrictSameSite + YesodCoreTest.StubUnsecured + YesodCoreTest.WaiSubsite + YesodCoreTest.Widget + YesodCoreTest.YesodTest + cpp-options: -DTEST build-depends: base ,hspec >= 1.3 diff --git a/yesod-eventsource/Yesod/EventSource.hs b/yesod-eventsource/Yesod/EventSource.hs index 4a265124..f0918034 100644 --- a/yesod-eventsource/Yesod/EventSource.hs +++ b/yesod-eventsource/Yesod/EventSource.hs @@ -11,7 +11,7 @@ module Yesod.EventSource import Blaze.ByteString.Builder (Builder) import Control.Monad (when) import Data.Functor ((<$>)) -import Data.Monoid (mappend, mempty) +import Data.Monoid (Monoid (..)) import Yesod.Core import qualified Data.Conduit as C import qualified Network.Wai as W @@ -24,7 +24,7 @@ import qualified Network.Wai.EventSource.EventStream as ES -- set any necessary headers. prepareForEventSource :: MonadHandler m => m EventSourcePolyfill prepareForEventSource = do - reqWith <- lookup "X-Requested-With" . W.requestHeaders <$> waiRequest + reqWith <- lookup "X-Requested-With" . W.requestHeaders Data.Functor.<$> waiRequest let polyfill | reqWith == Just "XMLHttpRequest" = Remy'sESPolyfill | otherwise = NoESPolyfill addHeader "Cache-Control" "no-cache" -- extremely important! @@ -87,7 +87,7 @@ pollingEventSource initial act = do -- when we the connection should be closed. joinEvents (ev:evs) acc = case ES.eventToBuilder ev of - Just b -> joinEvents evs (acc `mappend` b) + Just b -> joinEvents evs (acc `Data.Monoid.mappend` b) Nothing -> (fst $ joinEvents [] acc, False) joinEvents [] acc = (acc, True) diff --git a/yesod-form/Yesod/Form/Fields.hs b/yesod-form/Yesod/Form/Fields.hs index e080062a..7bdeb516 100644 --- a/yesod-form/Yesod/Form/Fields.hs +++ b/yesod-form/Yesod/Form/Fields.hs @@ -63,12 +63,10 @@ import Yesod.Form.Types import Yesod.Form.I18n.English import Yesod.Form.Functions (parseHelper) import Yesod.Core -import Text.Hamlet import Text.Blaze (ToMarkup (toMarkup), unsafeByteString) #define ToHtml ToMarkup #define toHtml toMarkup #define preEscapedText preEscapedToMarkup -import Text.Cassius import Data.Time (Day, TimeOfDay(..)) import qualified Text.Email.Validate as Email import Data.Text.Encoding (encodeUtf8, decodeUtf8With) @@ -88,7 +86,6 @@ import Data.Maybe (listToMaybe, fromMaybe) import qualified Blaze.ByteString.Builder.Html.Utf8 as B import Blaze.ByteString.Builder (writeByteString, toLazyByteString) import Blaze.ByteString.Builder.Internal.Write (fromWriteList) -import Database.Persist (PersistEntityBackend) import Text.Blaze.Html.Renderer.String (renderHtml) import qualified Data.ByteString as S @@ -96,11 +93,11 @@ import qualified Data.ByteString.Lazy as L import Data.Text as T ( Text, append, concat, cons, head , intercalate, isPrefixOf, null, unpack, pack, splitOn ) -import qualified Data.Text as T (drop, dropWhile) +import qualified Data.Text as T (drop, dropWhile) import qualified Data.Text.Read import qualified Data.Map as Map -import Yesod.Persist (selectList, runDB, Filter, SelectOpt, Key, YesodPersist, PersistEntity, PersistQuery) +import Yesod.Persist (selectList, Filter, SelectOpt, Key) import Control.Arrow ((&&&)) import Control.Applicative ((<$>), (<|>)) @@ -323,7 +320,7 @@ timeParser = do where hour = do x <- digit - y <- (return <$> digit) <|> return [] + y <- (return Control.Applicative.<$> digit) <|> return [] let xy = x : y let i = read xy if i < 0 || i >= 24 @@ -442,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 = @@ -480,17 +477,17 @@ 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) { fieldView = - \theId name attrs val isReq -> do + \theId name attrs val _isReq -> do opts <- fmap olOptions $ handlerToWidget ioptlist let optselected (Left _) _ = False optselected (Right vals) opt = (optionInternalValue opt) `elem` vals @@ -572,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| @@ -760,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 $ @@ -806,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 ed83624f..66787523 100644 --- a/yesod-form/Yesod/Form/Functions.hs +++ b/yesod-form/Yesod/Form/Functions.hs @@ -59,9 +59,7 @@ import Text.Blaze (Markup, toMarkup) #define Html Markup #define toHtml toMarkup import Yesod.Core -import Yesod.Core.Handler (defaultCsrfParamName) import Network.Wai (requestMethod) -import Text.Hamlet (shamlet) import Data.Monoid (mempty, (<>)) import Data.Maybe (listToMaybe, fromMaybe) import qualified Data.Map as Map @@ -217,7 +215,7 @@ postHelper form env = do let tokenKey = defaultCsrfParamName let token = case reqToken req of - Nothing -> mempty + Nothing -> Data.Monoid.mempty Just n -> [shamlet||] m <- getYesod langs <- languages @@ -245,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" @@ -281,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/I18n/Czech.hs b/yesod-form/Yesod/Form/I18n/Czech.hs index 694522b5..a75a2ffb 100644 --- a/yesod-form/Yesod/Form/I18n/Czech.hs +++ b/yesod-form/Yesod/Form/I18n/Czech.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) czechFormMessage :: FormMessage -> Text -czechFormMessage (MsgInvalidInteger t) = "Neplatné celé číslo: " `mappend` t +czechFormMessage (MsgInvalidInteger t) = "Neplatné celé číslo: " `Data.Monoid.mappend` t czechFormMessage (MsgInvalidNumber t) = "Neplatné číslo: " `mappend` t czechFormMessage (MsgInvalidEntry t) = "Neplatná položka: " `mappend` t czechFormMessage MsgInvalidTimeFormat = "Neplatný čas, musí být ve formátu HH:MM[:SS]" diff --git a/yesod-form/Yesod/Form/I18n/Dutch.hs b/yesod-form/Yesod/Form/I18n/Dutch.hs index be5bf64c..a872d1c7 100644 --- a/yesod-form/Yesod/Form/I18n/Dutch.hs +++ b/yesod-form/Yesod/Form/I18n/Dutch.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) dutchFormMessage :: FormMessage -> Text -dutchFormMessage (MsgInvalidInteger t) = "Ongeldig aantal: " `mappend` t +dutchFormMessage (MsgInvalidInteger t) = "Ongeldig aantal: " `Data.Monoid.mappend` t dutchFormMessage (MsgInvalidNumber t) = "Ongeldig getal: " `mappend` t dutchFormMessage (MsgInvalidEntry t) = "Ongeldige invoer: " `mappend` t dutchFormMessage MsgInvalidTimeFormat = "Ongeldige tijd, het juiste formaat is (UU:MM[:SS])" diff --git a/yesod-form/Yesod/Form/I18n/English.hs b/yesod-form/Yesod/Form/I18n/English.hs index f13ca683..7feec5b1 100644 --- a/yesod-form/Yesod/Form/I18n/English.hs +++ b/yesod-form/Yesod/Form/I18n/English.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) englishFormMessage :: FormMessage -> Text -englishFormMessage (MsgInvalidInteger t) = "Invalid integer: " `mappend` t +englishFormMessage (MsgInvalidInteger t) = "Invalid integer: " `Data.Monoid.mappend` t englishFormMessage (MsgInvalidNumber t) = "Invalid number: " `mappend` t englishFormMessage (MsgInvalidEntry t) = "Invalid entry: " `mappend` t englishFormMessage MsgInvalidTimeFormat = "Invalid time, must be in HH:MM[:SS] format" diff --git a/yesod-form/Yesod/Form/I18n/French.hs b/yesod-form/Yesod/Form/I18n/French.hs index ce971ac4..81a36a7e 100644 --- a/yesod-form/Yesod/Form/I18n/French.hs +++ b/yesod-form/Yesod/Form/I18n/French.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) frenchFormMessage :: FormMessage -> Text -frenchFormMessage (MsgInvalidInteger t) = "Entier invalide : " `mappend` t +frenchFormMessage (MsgInvalidInteger t) = "Entier invalide : " `Data.Monoid.mappend` t frenchFormMessage (MsgInvalidNumber t) = "Nombre invalide : " `mappend` t frenchFormMessage (MsgInvalidEntry t) = "Entrée invalide : " `mappend` t frenchFormMessage MsgInvalidTimeFormat = "Heure invalide (elle doit être au format HH:MM ou HH:MM:SS" diff --git a/yesod-form/Yesod/Form/I18n/German.hs b/yesod-form/Yesod/Form/I18n/German.hs index d6f4de94..ec800547 100644 --- a/yesod-form/Yesod/Form/I18n/German.hs +++ b/yesod-form/Yesod/Form/I18n/German.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) germanFormMessage :: FormMessage -> Text -germanFormMessage (MsgInvalidInteger t) = "Ungültige Ganzzahl: " `mappend` t +germanFormMessage (MsgInvalidInteger t) = "Ungültige Ganzzahl: " `Data.Monoid.mappend` t germanFormMessage (MsgInvalidNumber t) = "Ungültige Zahl: " `mappend` t germanFormMessage (MsgInvalidEntry t) = "Ungültiger Eintrag: " `mappend` t germanFormMessage MsgInvalidTimeFormat = "Ungültiges Zeitformat, HH:MM[:SS] Format erwartet" diff --git a/yesod-form/Yesod/Form/I18n/Japanese.hs b/yesod-form/Yesod/Form/I18n/Japanese.hs index e94f1f9f..9e929c7a 100644 --- a/yesod-form/Yesod/Form/I18n/Japanese.hs +++ b/yesod-form/Yesod/Form/I18n/Japanese.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) japaneseFormMessage :: FormMessage -> Text -japaneseFormMessage (MsgInvalidInteger t) = "無効な整数です: " `mappend` t +japaneseFormMessage (MsgInvalidInteger t) = "無効な整数です: " `Data.Monoid.mappend` t japaneseFormMessage (MsgInvalidNumber t) = "無効な数値です: " `mappend` t japaneseFormMessage (MsgInvalidEntry t) = "無効な入力です: " `mappend` t japaneseFormMessage MsgInvalidTimeFormat = "無効な時刻です。HH:MM[:SS]フォーマットで入力してください" diff --git a/yesod-form/Yesod/Form/I18n/Norwegian.hs b/yesod-form/Yesod/Form/I18n/Norwegian.hs index be5d741a..cb74eaad 100644 --- a/yesod-form/Yesod/Form/I18n/Norwegian.hs +++ b/yesod-form/Yesod/Form/I18n/Norwegian.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) norwegianBokmålFormMessage :: FormMessage -> Text -norwegianBokmålFormMessage (MsgInvalidInteger t) = "Ugyldig antall: " `mappend` t +norwegianBokmålFormMessage (MsgInvalidInteger t) = "Ugyldig antall: " `Data.Monoid.mappend` t norwegianBokmålFormMessage (MsgInvalidNumber t) = "Ugyldig nummer: " `mappend` t norwegianBokmålFormMessage (MsgInvalidEntry t) = "Ugyldig oppføring: " `mappend` t norwegianBokmålFormMessage MsgInvalidTimeFormat = "Ugyldig klokkeslett, må være i formatet HH:MM[:SS]" diff --git a/yesod-form/Yesod/Form/I18n/Portuguese.hs b/yesod-form/Yesod/Form/I18n/Portuguese.hs index d0b9d7b6..01aabede 100644 --- a/yesod-form/Yesod/Form/I18n/Portuguese.hs +++ b/yesod-form/Yesod/Form/I18n/Portuguese.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) portugueseFormMessage :: FormMessage -> Text -portugueseFormMessage (MsgInvalidInteger t) = "Número inteiro inválido: " `mappend` t +portugueseFormMessage (MsgInvalidInteger t) = "Número inteiro inválido: " `Data.Monoid.mappend` t portugueseFormMessage (MsgInvalidNumber t) = "Número inválido: " `mappend` t portugueseFormMessage (MsgInvalidEntry t) = "Entrada inválida: " `mappend` t portugueseFormMessage MsgInvalidTimeFormat = "Hora inválida, deve estar no formato HH:MM[:SS]" diff --git a/yesod-form/Yesod/Form/I18n/Russian.hs b/yesod-form/Yesod/Form/I18n/Russian.hs index a53f9da9..c235270a 100644 --- a/yesod-form/Yesod/Form/I18n/Russian.hs +++ b/yesod-form/Yesod/Form/I18n/Russian.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) russianFormMessage :: FormMessage -> Text -russianFormMessage (MsgInvalidInteger t) = "Неверно записано целое число: " `mappend` t +russianFormMessage (MsgInvalidInteger t) = "Неверно записано целое число: " `Data.Monoid.mappend` t russianFormMessage (MsgInvalidNumber t) = "Неверный формат числа: " `mappend` t russianFormMessage (MsgInvalidEntry t) = "Неверный выбор: " `mappend` t russianFormMessage MsgInvalidTimeFormat = "Неверно указано время, используйте формат ЧЧ:ММ[:СС]" diff --git a/yesod-form/Yesod/Form/I18n/Spanish.hs b/yesod-form/Yesod/Form/I18n/Spanish.hs index 6c6d846f..795e67a4 100644 --- a/yesod-form/Yesod/Form/I18n/Spanish.hs +++ b/yesod-form/Yesod/Form/I18n/Spanish.hs @@ -7,7 +7,7 @@ import Data.Monoid (mappend) import Data.Text (Text) spanishFormMessage :: FormMessage -> Text -spanishFormMessage (MsgInvalidInteger t) = "Número entero inválido: " `mappend` t +spanishFormMessage (MsgInvalidInteger t) = "Número entero inválido: " `Data.Monoid.mappend` t spanishFormMessage (MsgInvalidNumber t) = "Número inválido: " `mappend` t spanishFormMessage (MsgInvalidEntry t) = "Entrada inválida: " `mappend` t spanishFormMessage MsgInvalidTimeFormat = "Hora inválida, debe tener el formato HH:MM[:SS]" @@ -24,4 +24,4 @@ spanishFormMessage MsgSelectNone = "" spanishFormMessage (MsgInvalidBool t) = "Booleano inválido: " `mappend` t spanishFormMessage MsgBoolYes = "Sí" spanishFormMessage MsgBoolNo = "No" -spanishFormMessage MsgDelete = "¿Eliminar?" \ No newline at end of file +spanishFormMessage MsgDelete = "¿Eliminar?" diff --git a/yesod-form/Yesod/Form/I18n/Swedish.hs b/yesod-form/Yesod/Form/I18n/Swedish.hs index 48d59aca..ed3e3b9b 100644 --- a/yesod-form/Yesod/Form/I18n/Swedish.hs +++ b/yesod-form/Yesod/Form/I18n/Swedish.hs @@ -6,7 +6,7 @@ import Data.Monoid (mappend) import Data.Text (Text) swedishFormMessage :: FormMessage -> Text -swedishFormMessage (MsgInvalidInteger t) = "Ogiltigt antal: " `mappend` t +swedishFormMessage (MsgInvalidInteger t) = "Ogiltigt antal: " `Data.Monoid.mappend` t swedishFormMessage (MsgInvalidNumber t) = "Ogiltigt nummer: " `mappend` t swedishFormMessage (MsgInvalidEntry t) = "Invalid entry: " `mappend` t swedishFormMessage MsgInvalidTimeFormat = "Ogiltigt klockslag, måste vara på formatet HH:MM[:SS]" diff --git a/yesod-form/Yesod/Form/Input.hs b/yesod-form/Yesod/Form/Input.hs index 1643547e..4591ac17 100644 --- a/yesod-form/Yesod/Form/Input.hs +++ b/yesod-form/Yesod/Form/Input.hs @@ -29,7 +29,7 @@ type DText = [Text] -> [Text] newtype FormInput m a = FormInput { unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) } instance Monad m => Functor (FormInput m) where fmap a (FormInput f) = FormInput $ \c d e e' -> liftM (either Left (Right . a)) $ f c d e e' -instance Monad m => Applicative (FormInput m) where +instance Monad m => Control.Applicative.Applicative (FormInput m) where pure = FormInput . const . const . const . const . return . Right (FormInput f) <*> (FormInput x) = FormInput $ \c d e e' -> do res1 <- f c d e e' diff --git a/yesod-form/Yesod/Form/Jquery.hs b/yesod-form/Yesod/Form/Jquery.hs index 63e3d57a..a5a2bfce 100644 --- a/yesod-form/Yesod/Form/Jquery.hs +++ b/yesod-form/Yesod/Form/Jquery.hs @@ -18,14 +18,13 @@ import Yesod.Core import Yesod.Form import Data.Time (Day) import Data.Default -import Text.Hamlet (shamlet) -import Text.Julius (julius, rawJS) +import Text.Julius (rawJS) import Data.Text (Text, pack, unpack) import Data.Monoid (mconcat) -- | Gets the Google hosted jQuery UI 1.8 CSS file with the given theme. googleHostedJqueryUiCss :: Text -> Text -googleHostedJqueryUiCss theme = mconcat +googleHostedJqueryUiCss theme = Data.Monoid.mconcat [ "//ajax.googleapis.com/ajax/libs/jqueryui/1.8/themes/" , theme , "/jquery-ui.css" diff --git a/yesod-form/Yesod/Form/MassInput.hs b/yesod-form/Yesod/Form/MassInput.hs index 24a0602d..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,14 +119,13 @@ $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) where (xmls, rest) = partitionEithers eithers - res = sequenceA $ map fst rest + res = Data.Traversable.sequenceA $ map fst rest massDivs, massTable :: [[FieldView site]] diff --git a/yesod-form/Yesod/Form/Nic.hs b/yesod-form/Yesod/Form/Nic.hs index c291520c..10057c0c 100644 --- a/yesod-form/Yesod/Form/Nic.hs +++ b/yesod-form/Yesod/Form/Nic.hs @@ -19,8 +19,7 @@ module Yesod.Form.Nic import Yesod.Core import Yesod.Form import Text.HTML.SanitizeXSS (sanitizeBalance) -import Text.Hamlet (shamlet) -import Text.Julius (julius, rawJS) +import Text.Julius (rawJS) import Text.Blaze.Html.Renderer.String (renderHtml) import Data.Text (Text, pack) import Data.Maybe (listToMaybe) diff --git a/yesod-form/Yesod/Form/Types.hs b/yesod-form/Yesod/Form/Types.hs index 65e4d5f8..c3d367c0 100644 --- a/yesod-form/Yesod/Form/Types.hs +++ b/yesod-form/Yesod/Form/Types.hs @@ -51,28 +51,28 @@ instance Functor FormResult where fmap _ FormMissing = FormMissing fmap _ (FormFailure errs) = FormFailure errs fmap f (FormSuccess a) = FormSuccess $ f a -instance Applicative FormResult where +instance Control.Applicative.Applicative FormResult where pure = FormSuccess (FormSuccess f) <*> (FormSuccess g) = FormSuccess $ f g (FormFailure x) <*> (FormFailure y) = FormFailure $ x ++ y (FormFailure x) <*> _ = FormFailure x _ <*> (FormFailure y) = FormFailure y _ <*> _ = FormMissing -instance Monoid m => Monoid (FormResult m) where +instance Data.Monoid.Monoid m => Monoid (FormResult m) where mempty = pure mempty mappend x y = mappend <$> x <*> y instance Semigroup m => Semigroup (FormResult m) where - x <> y = (<>) <$> x <*> y + x <> y = (<>) Control.Applicative.<$> x <*> y -- | @since 1.4.5 -instance Foldable FormResult where +instance Data.Foldable.Foldable FormResult where foldMap f r = case r of FormSuccess a -> f a - FormFailure errs -> mempty + FormFailure _errs -> mempty FormMissing -> mempty -- | @since 1.4.5 -instance Traversable FormResult where +instance Data.Traversable.Traversable FormResult where traverse f r = case r of FormSuccess a -> fmap FormSuccess (f a) FormFailure errs -> pure (FormFailure errs) diff --git a/yesod-persistent/Yesod/Persist/Core.hs b/yesod-persistent/Yesod/Persist/Core.hs index ea5999a7..aecef655 100644 --- a/yesod-persistent/Yesod/Persist/Core.hs +++ b/yesod-persistent/Yesod/Persist/Core.hs @@ -23,7 +23,7 @@ module Yesod.Persist.Core ) where import Database.Persist -import Control.Monad.Trans.Reader (ReaderT, runReaderT, withReaderT) +import Control.Monad.Trans.Reader (ReaderT, runReaderT) import Yesod.Core import Data.Conduit diff --git a/yesod-static/Yesod/EmbeddedStatic.hs b/yesod-static/Yesod/EmbeddedStatic.hs index deec0235..7663ad9f 100644 --- a/yesod-static/Yesod/EmbeddedStatic.hs +++ b/yesod-static/Yesod/EmbeddedStatic.hs @@ -49,7 +49,7 @@ module Yesod.EmbeddedStatic ( , module Yesod.EmbeddedStatic.Generators ) where -import Control.Applicative ((<$>)) +import Control.Applicative as A ((<$>)) import Data.IORef import Data.Maybe (catMaybes) import Language.Haskell.TH @@ -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 @@ -136,7 +135,7 @@ mkEmbeddedStatic :: Bool -- ^ development? -> [Generator] -- ^ the generators (see "Yesod.EmbeddedStatic.Generators") -> Q [Dec] mkEmbeddedStatic dev esName gen = do - entries <- concat <$> sequence gen + entries <- concat A.<$> sequence gen computed <- runIO $ mapM (if dev then devEmbed else prodEmbed) entries let settings = Static.mkSettings $ return $ map cStEntry computed @@ -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/Generators.hs b/yesod-static/Yesod/EmbeddedStatic/Generators.hs index 1893a01f..2d8aeab1 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Generators.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Generators.hs @@ -30,10 +30,9 @@ module Yesod.EmbeddedStatic.Generators ( -- $example ) where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative as A ((<$>), (<*>)) import Control.Exception (try, SomeException) import Control.Monad (forM, when) -import Control.Monad.Trans.Resource (runResourceT) import Data.Char (isDigit, isLower) import Data.Conduit (($$)) import Data.Default (def) @@ -209,9 +208,9 @@ compressTool f opts ct = do } (Just hin, Just hout, _, ph) <- Proc.createProcess p (compressed, (), code) <- runConcurrently $ (,,) - <$> Concurrently (sourceHandle hout $$ C.consume) - <*> Concurrently (BL.hPut hin ct >> hClose hin) - <*> Concurrently (Proc.waitForProcess ph) + A.<$> Concurrently (sourceHandle hout $$ C.consume) + A.<*> Concurrently (BL.hPut hin ct >> hClose hin) + A.<*> Concurrently (Proc.waitForProcess ph) if code == ExitSuccess then do putStrLn $ "Compressed successfully with " ++ f diff --git a/yesod-static/Yesod/EmbeddedStatic/Internal.hs b/yesod-static/Yesod/EmbeddedStatic/Internal.hs index a2e92ab0..9e778bea 100644 --- a/yesod-static/Yesod/EmbeddedStatic/Internal.hs +++ b/yesod-static/Yesod/EmbeddedStatic/Internal.hs @@ -16,7 +16,7 @@ module Yesod.EmbeddedStatic.Internal ( , widgetSettings ) where -import Control.Applicative ((<$>)) +import Control.Applicative as A ((<$>)) import Data.IORef import Language.Haskell.TH import Network.HTTP.Types (Status(..), status404, status200, status304) @@ -28,7 +28,6 @@ import Yesod.Core ( HandlerT , ParseRoute(..) , RenderRoute(..) - , Yesod(..) , getYesod , liftIO ) @@ -140,13 +139,12 @@ 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 staticContentHelper getStatic staticR minify ext _ ct = do - wIORef <- widgetFiles . getStatic <$> getYesod + wIORef <- widgetFiles . getStatic A.<$> getYesod let hash = T.pack $ base64md5 ct hash' = Just $ T.encodeUtf8 hash filename = T.concat [hash, ".", ext] diff --git a/yesod-static/Yesod/Static.hs b/yesod-static/Yesod/Static.hs index 45ad218b..1356f22d 100644 --- a/yesod-static/Yesod/Static.hs +++ b/yesod-static/Yesod/Static.hs @@ -96,9 +96,8 @@ import Data.Conduit.List (sourceList, consume) import Data.Conduit.Binary (sourceFile) import qualified Data.Conduit.Text as CT import Data.Functor.Identity (runIdentity) -import System.FilePath ((), (<.>), FilePath, takeDirectory) +import System.FilePath ((), (<.>), takeDirectory) import qualified System.FilePath as F -import System.Directory (createDirectoryIfMissing) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import Data.Default @@ -349,7 +348,6 @@ mkStaticFilesList fp fs makeHash = do | isLower (head name') -> name' | otherwise -> '_' : name' f' <- [|map pack $(TH.lift f)|] - pack' <- [|pack|] qs <- if makeHash then do hash <- qRunIO $ base64md5File $ pathFromRawPieces fp f [|[(pack "etag", pack $(TH.lift hash))]|] @@ -505,9 +503,6 @@ instance Default CombineSettings where , csCombinedFolder = "combined" } -errorIntro :: [FilePath] -> [Char] -> [Char] -errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s - liftRoutes :: [Route Static] -> Q Exp liftRoutes = fmap ListE . mapM go diff --git a/yesod-static/test/GeneratorTestUtil.hs b/yesod-static/test/GeneratorTestUtil.hs index 510aee0c..47dbe251 100644 --- a/yesod-static/test/GeneratorTestUtil.hs +++ b/yesod-static/test/GeneratorTestUtil.hs @@ -5,8 +5,8 @@ import Control.Applicative import Control.Monad (when) import Data.List (sortBy) import Language.Haskell.TH -import Test.HUnit hiding (Location) -import Yesod.EmbeddedStatic.Types +import Test.HUnit +import Yesod.EmbeddedStatic.Types as Y import qualified Data.ByteString.Lazy as BL -- We test the generators by executing them at compile time @@ -20,8 +20,8 @@ data GenTestResult = GenError String | GenSuccessWithDevel (IO BL.ByteString) -- | Creates a GenTestResult at compile time by testing the entry. -testEntry :: Maybe String -> Location -> IO BL.ByteString -> Entry -> ExpQ -testEntry name _ _ e | ebHaskellName e /= (mkName <$> name) = +testEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> Entry -> ExpQ +testEntry name _ _ e | ebHaskellName e /= (mkName Control.Applicative.<$> name) = [| GenError ("haskell name " ++ $(litE $ stringL $ show $ ebHaskellName e) ++ " /= " ++ $(litE $ stringL $ show name)) |] @@ -34,12 +34,12 @@ testEntry _ _ act e = do then [| GenSuccessWithDevel $(ebDevelReload e) |] else [| GenError "production content" |] -testOneEntry :: Maybe String -> Location -> IO BL.ByteString -> [Entry] -> ExpQ +testOneEntry :: Maybe String -> Y.Location -> IO BL.ByteString -> [Entry] -> ExpQ testOneEntry name loc ct [e] = testEntry name loc ct e testOneEntry _ _ _ _ = [| GenError "not exactly one entry" |] -- | Tests a list of entries -testEntries :: [(Maybe String, Location, IO BL.ByteString)] -> [Entry] -> ExpQ +testEntries :: [(Maybe String, Y.Location, IO BL.ByteString)] -> [Entry] -> ExpQ testEntries a b | length a /= length b = [| [GenError "lengths differ"] |] testEntries a b = listE $ zipWith f a' b' where diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index 2685255f..c7321e9d 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -78,6 +78,17 @@ test-suite tests main-is: tests.hs type: exitcode-stdio-1.0 cpp-options: -DTEST_EXPORT + other-modules: EmbedDevelTest + EmbedProductionTest + EmbedTestGenerator + FileGeneratorTests + GeneratorTestUtil + Yesod.EmbeddedStatic + Yesod.EmbeddedStatic.Generators + Yesod.EmbeddedStatic.Internal + Yesod.EmbeddedStatic.Types + Yesod.Static + YesodStaticTest build-depends: base , hspec >= 1.3 , yesod-test >= 1.4 diff --git a/yesod-test/Yesod/Test.hs b/yesod-test/Yesod/Test.hs index 9764ebf7..93a05b99 100644 --- a/yesod-test/Yesod/Test.hs +++ b/yesod-test/Yesod/Test.hs @@ -132,6 +132,7 @@ import Network.Wai.Test hiding (assertHeader, assertNoHeader, request) import qualified Control.Monad.Trans.State as ST import Control.Monad.IO.Class import System.IO +import Yesod.Core.Unsafe (runFakeHandler) import Yesod.Test.TransversingCSS import Yesod.Core import qualified Data.Text.Lazy as TL @@ -678,7 +679,7 @@ addTokenFromCookieNamedToHeaderNamed cookieName headerName = do getRequestCookies :: RequestBuilder site Cookies getRequestCookies = do requestBuilderData <- ST.get - headers <- case simpleHeaders <$> rbdResponse requestBuilderData of + headers <- case simpleHeaders Control.Applicative.<$> rbdResponse requestBuilderData of Just h -> return h Nothing -> failure "getRequestCookies: No request has been made yet; the cookies can't be looked up." @@ -759,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 @@ -802,7 +802,7 @@ setUrl :: (Yesod site, RedirectUrl site url) -> RequestBuilder site () setUrl url' = do site <- fmap rbdSite ST.get - eurl <- runFakeHandler + eurl <- Yesod.Core.Unsafe.runFakeHandler M.empty (const $ error "Yesod.Test: No logger available") site @@ -828,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. @@ -858,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-test/Yesod/Test/TransversingCSS.hs b/yesod-test/Yesod/Test/TransversingCSS.hs index 4450d300..658f30a0 100644 --- a/yesod-test/Yesod/Test/TransversingCSS.hs +++ b/yesod-test/Yesod/Test/TransversingCSS.hs @@ -59,8 +59,8 @@ type HtmlLBS = L.ByteString -- * Right: List of matching Html fragments. findBySelector :: HtmlLBS -> Query -> Either String [String] findBySelector html query = (\x -> map (renderHtml . toHtml . node) . runQuery x) - <$> (Right $ fromDocument $ HD.parseLBS html) - <*> parseQuery query + Control.Applicative.<$> (Right $ fromDocument $ HD.parseLBS html) + Control.Applicative.<*> parseQuery query -- Run a compiled query on Html, returning a list of matching Html fragments. runQuery :: Cursor -> [[SelectorGroup]] -> [Cursor] diff --git a/yesod-test/test/main.hs b/yesod-test/test/main.hs index 5b4c1a4e..ff2cca7c 100644 --- a/yesod-test/test/main.hs +++ b/yesod-test/test/main.hs @@ -6,6 +6,13 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Main + ( main + -- avoid warnings + , resourcesRoutedApp + , Widget + ) where import Test.HUnit hiding (Test) import Test.Hspec @@ -22,16 +29,17 @@ import Control.Applicative import Network.Wai (pathInfo, requestHeaders) import Data.Maybe (fromMaybe) import Data.Either (isLeft, isRight) -import Control.Exception.Lifted(try, SomeException) import Data.ByteString.Lazy.Char8 () import qualified Data.Map as Map import qualified Text.HTML.DOM as HD import Network.HTTP.Types.Status (status301, status303, unsupportedMediaType415) +parseQuery_ :: Text -> [[SelectorGroup]] parseQuery_ = either error id . parseQuery + +findBySelector_ :: HtmlLBS -> Query -> [String] findBySelector_ x = either error id . findBySelector x -parseHtml_ = HD.parseLBS data RoutedApp = RoutedApp @@ -86,7 +94,7 @@ main = hspec $ do [NodeContent "Hello World"] ] ] - in parseHtml_ html @?= doc + in HD.parseLBS html @?= doc it "HTML" $ let html = "foo

Hello World

" doc = Document (Prologue [] Nothing []) root [] @@ -101,7 +109,7 @@ main = hspec $ do [NodeContent "Hello World"] ] ] - in parseHtml_ html @?= doc + in HD.parseLBS html @?= doc describe "basic usage" $ yesodSpec app $ do ydescribe "tests1" $ do yit "tests1a" $ do @@ -310,7 +318,7 @@ app = liteApp $ do ((mfoo, widget), _) <- runFormPost $ renderDivs $ (,) - <$> areq textField "Some Label" Nothing + Control.Applicative.<$> areq textField "Some Label" Nothing <*> areq fileField "Some File" Nothing case mfoo of FormSuccess (foo, _) -> return $ toHtml foo @@ -337,7 +345,7 @@ cookieApp = liteApp $ do onStatic "cookie" $ do onStatic "foo" $ dispatchTo $ do setMessage "Foo" - redirect ("/cookie/home" :: Text) + () <- redirect ("/cookie/home" :: Text) return () instance Yesod RoutedApp where 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/Config2.hs b/yesod/Yesod/Default/Config2.hs index ff45207f..08abe31b 100644 --- a/yesod/Yesod/Default/Config2.hs +++ b/yesod/Yesod/Default/Config2.hs @@ -28,10 +28,6 @@ module Yesod.Default.Config2 import Data.Yaml.Config -#if __GLASGOW_HASKELL__ < 710 -import Control.Applicative ((<$>)) -import Data.Monoid -#endif import Data.Semigroup import Data.Aeson import qualified Data.HashMap.Strict as H 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