diff --git a/demo/auth/email_auth_ses_mailer.hs b/demo/auth/email_auth_ses_mailer.hs index 2c0774ad..31f727a7 100644 --- a/demo/auth/email_auth_ses_mailer.hs +++ b/demo/auth/email_auth_ses_mailer.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -15,7 +14,6 @@ import Data.Yaml import Data.Text (Text) import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy.Encoding as LTE -import Data.Typeable (Typeable) import Database.Persist.Sqlite import Database.Persist.TH import Network.Mail.Mime @@ -37,7 +35,6 @@ User verkey Text Maybe -- Used for resetting passwords verified Bool UniqueUser email - deriving Typeable |] data App = App diff --git a/yesod-auth-oauth/ChangeLog.md b/yesod-auth-oauth/ChangeLog.md index 7bd91f76..b7047210 100644 --- a/yesod-auth-oauth/ChangeLog.md +++ b/yesod-auth-oauth/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.6.0.2 + +* Remove unnecessary deriving of Typeable + ## 1.6.0.1 * Compile with GHC 8.6 [#1561](https://github.com/yesodweb/yesod/pull/1561) diff --git a/yesod-auth-oauth/Yesod/Auth/OAuth.hs b/yesod-auth-oauth/Yesod/Auth/OAuth.hs index a8d1d63a..f2ccae1b 100644 --- a/yesod-auth-oauth/Yesod/Auth/OAuth.hs +++ b/yesod-auth-oauth/Yesod/Auth/OAuth.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} @@ -32,7 +32,7 @@ import Yesod.Core data YesodOAuthException = CredentialError String Credential | SessionError String - deriving (Show, Typeable) + deriving Show instance Exception YesodOAuthException diff --git a/yesod-auth-oauth/yesod-auth-oauth.cabal b/yesod-auth-oauth/yesod-auth-oauth.cabal index 4f6487b5..3da9e8c1 100644 --- a/yesod-auth-oauth/yesod-auth-oauth.cabal +++ b/yesod-auth-oauth/yesod-auth-oauth.cabal @@ -1,5 +1,5 @@ name: yesod-auth-oauth -version: 1.6.0.1 +version: 1.6.0.2 license: BSD3 license-file: LICENSE author: Hiromi Ishii diff --git a/yesod-auth/ChangeLog.md b/yesod-auth/ChangeLog.md index 70e199e4..d656e10c 100644 --- a/yesod-auth/ChangeLog.md +++ b/yesod-auth/ChangeLog.md @@ -1,8 +1,9 @@ # ChangeLog for yesod-auth -## Unreleased +## 1.6.8.1 * Email: Fix typo in `defaultEmailLoginHandler` template [#1605](https://github.com/yesodweb/yesod/pull/1605) +* Remove unnecessary deriving of Typeable ## 1.6.8 diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs index cb66f288..dd69812f 100644 --- a/yesod-auth/Yesod/Auth.hs +++ b/yesod-auth/Yesod/Auth.hs @@ -8,7 +8,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Auth @@ -515,7 +514,6 @@ maybeAuthPair = runMaybeT $ do newtype CachedMaybeAuth val = CachedMaybeAuth { unCachedMaybeAuth :: Maybe val } - deriving Typeable -- | Class which states that the given site is an instance of @YesodAuth@ -- and that its @AuthId@ is a lookup key for the full user information in @@ -607,7 +605,7 @@ instance YesodAuth master => RenderMessage master AuthMessage where renderMessage = renderAuthMessage data AuthException = InvalidFacebookResponse - deriving (Show, Typeable) + deriving Show instance Exception AuthException instance YesodAuth master => YesodSubDispatch Auth master where diff --git a/yesod-auth/Yesod/Auth/Routes.hs b/yesod-auth/Yesod/Auth/Routes.hs index 06dad79a..36013c3e 100644 --- a/yesod-auth/Yesod/Auth/Routes.hs +++ b/yesod-auth/Yesod/Auth/Routes.hs @@ -4,7 +4,6 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} module Yesod.Auth.Routes where diff --git a/yesod-auth/yesod-auth.cabal b/yesod-auth/yesod-auth.cabal index 7e485d6d..83ecf1e2 100644 --- a/yesod-auth/yesod-auth.cabal +++ b/yesod-auth/yesod-auth.cabal @@ -1,5 +1,5 @@ name: yesod-auth -version: 1.6.8 +version: 1.6.8.1 license: MIT license-file: LICENSE author: Michael Snoyman, Patrick Brisbin diff --git a/yesod-core/ChangeLog.md b/yesod-core/ChangeLog.md index f4923073..4f65bd99 100644 --- a/yesod-core/ChangeLog.md +++ b/yesod-core/ChangeLog.md @@ -1,8 +1,12 @@ # ChangeLog for yesod-core +## 1.6.17.1 + +* Remove unnecessary deriving of Typeable + ## 1.6.17 -Adds `contentTypeIsJson` [#1646](https://github.com/yesodweb/yesod/pull/1646) +* Adds `contentTypeIsJson` [#1646](https://github.com/yesodweb/yesod/pull/1646) ## 1.6.16.1 diff --git a/yesod-core/src/Yesod/Core/Handler.hs b/yesod-core/src/Yesod/Core/Handler.hs index d0917acc..8237917a 100644 --- a/yesod-core/src/Yesod/Core/Handler.hs +++ b/yesod-core/src/Yesod/Core/Handler.hs @@ -8,7 +8,6 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-} --------------------------------------------------------- -- @@ -1037,7 +1036,7 @@ instance (key ~ Text, val ~ Text) => RedirectUrl master (Route master, Map.Map k -- > redirect (NewsfeedR :#: storyId) -- -- @since 1.2.9. -data Fragment a b = a :#: b deriving (Show, Typeable) +data Fragment a b = a :#: b deriving Show instance (RedirectUrl master a, PathPiece b) => RedirectUrl master (Fragment a b) where toTextUrl (a :#: b) = (\ua -> T.concat [ua, "#", toPathPiece b]) <$> toTextUrl a diff --git a/yesod-core/src/Yesod/Core/Types.hs b/yesod-core/src/Yesod/Core/Types.hs index a71e7690..3d4f00d3 100644 --- a/yesod-core/src/Yesod/Core/Types.hs +++ b/yesod-core/src/Yesod/Core/Types.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleInstances #-} @@ -37,7 +36,6 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TBuilder import Data.Time (UTCTime) -import Data.Typeable (Typeable) import GHC.Generics (Generic) import Language.Haskell.TH.Syntax (Loc) import qualified Network.HTTP.Types as H @@ -333,7 +331,7 @@ data ErrorResponse = | NotAuthenticated | PermissionDenied !Text | BadMethod !H.Method - deriving (Show, Eq, Typeable, Generic) + deriving (Show, Eq, Generic) instance NFData ErrorResponse ----- header stuff @@ -411,7 +409,6 @@ data HandlerContents = | HCCreated !Text | HCWai !W.Response | HCWaiApp !W.Application - deriving Typeable instance Show HandlerContents where show (HCContent status (TypedContent t _)) = "HCContent " ++ show (status, t) diff --git a/yesod-core/src/Yesod/Routes/Parse.hs b/yesod-core/src/Yesod/Routes/Parse.hs index dcc9e501..7b0ea749 100644 --- a/yesod-core/src/Yesod/Routes/Parse.hs +++ b/yesod-core/src/Yesod/Routes/Parse.hs @@ -1,5 +1,4 @@ {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE PatternGuards #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter module Yesod.Routes.Parse diff --git a/yesod-core/test/YesodCoreTest/Cache.hs b/yesod-core/test/YesodCoreTest/Cache.hs index 7320c114..8ccc5447 100644 --- a/yesod-core/test/YesodCoreTest/Cache.hs +++ b/yesod-core/test/YesodCoreTest/Cache.hs @@ -1,7 +1,6 @@ {-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} module YesodCoreTest.Cache ( cacheTest @@ -22,10 +21,8 @@ import qualified Data.ByteString.Lazy.Char8 as L8 data C = C newtype V1 = V1 Int - deriving Typeable newtype V2 = V2 Int - deriving Typeable mkYesod "C" [parseRoutes| / RootR GET diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index 7a6cec8c..b4b5a2cb 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -1,5 +1,5 @@ name: yesod-core -version: 1.6.17 +version: 1.6.17.1 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod-static/ChangeLog.md b/yesod-static/ChangeLog.md index 9c79808a..f275cb39 100644 --- a/yesod-static/ChangeLog.md +++ b/yesod-static/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.6.0.2 + +* Remove unnecessary deriving of Typeable + ## 1.6.0.1 * Make test suite build with GHC 8.6 [#1561](https://github.com/yesodweb/yesod/pull/1561) diff --git a/yesod-static/test/unicode/warp.hs b/yesod-static/test/unicode/warp.hs index a7434ed9..82e18c1a 100644 --- a/yesod-static/test/unicode/warp.hs +++ b/yesod-static/test/unicode/warp.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} +{-# LANGUAGE RecordWildCards #-} import Network.Wai.Application.Static ( StaticSettings (..), staticApp, defaultMimeType, defaultListing , defaultMimeTypes, mimeTypeByExt @@ -25,7 +25,7 @@ data Args = Args , verbose :: Bool , mime :: [(String, String)] } - deriving (Show, Data, Typeable) + deriving (Show, Data) defaultArgs = Args "." ["index.html", "index.htm"] 3000 False False False [] diff --git a/yesod-static/yesod-static.cabal b/yesod-static/yesod-static.cabal index d5e58d7c..2673ece1 100644 --- a/yesod-static/yesod-static.cabal +++ b/yesod-static/yesod-static.cabal @@ -1,5 +1,5 @@ name: yesod-static -version: 1.6.0.1 +version: 1.6.0.2 license: MIT license-file: LICENSE author: Michael Snoyman diff --git a/yesod/ChangeLog.md b/yesod/ChangeLog.md index db13e23b..40335e0e 100644 --- a/yesod/ChangeLog.md +++ b/yesod/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.6.0.1 + +* Remove unnecessary deriving of Typeable + ## 1.6.0 * Upgrade to yesod-core 1.6 diff --git a/yesod/Yesod/Default/Config.hs b/yesod/Yesod/Default/Config.hs index 6e2dbf45..b0d01bca 100644 --- a/yesod/Yesod/Default/Config.hs +++ b/yesod/Yesod/Default/Config.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} module Yesod.Default.Config diff --git a/yesod/Yesod/Default/Main.hs b/yesod/Yesod/Default/Main.hs index a6282062..890db540 100644 --- a/yesod/Yesod/Default/Main.hs +++ b/yesod/Yesod/Default/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} module Yesod.Default.Main diff --git a/yesod/yesod.cabal b/yesod/yesod.cabal index 192fd2da..9f32dbd6 100644 --- a/yesod/yesod.cabal +++ b/yesod/yesod.cabal @@ -1,5 +1,5 @@ name: yesod -version: 1.6.0 +version: 1.6.0.1 license: MIT license-file: LICENSE author: Michael Snoyman