Skip to content

Commit

Permalink
Drop CPP conditional obsolete with base >= 4.8 (GHC 7.10)
Browse files Browse the repository at this point in the history
  • Loading branch information
andreasabel committed Jan 9, 2024
1 parent fd748e2 commit a513156
Show file tree
Hide file tree
Showing 15 changed files with 7 additions and 156 deletions.
5 changes: 0 additions & 5 deletions hackage-repo-tool/src/Hackage/Security/RepoTool/Util/IO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -123,11 +123,6 @@ data TarGzError = TarGzError FilePath SomeException
deriving (Typeable)

instance Exception TarGzError where
#if MIN_VERSION_base(4,8,0)
displayException (TarGzError path e) = path ++ ": " ++ displayException e

deriving instance Show TarGzError
#else
instance Show TarGzError where
show (TarGzError path e) = path ++ ": " ++ show e
#endif
5 changes: 0 additions & 5 deletions hackage-repo-tool/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,11 +77,6 @@ topLevelExceptionHandler e = do
putStrLn $ displayException e
exitFailure

#if !MIN_VERSION_base(4,8,0)
displayException :: Exception e => e -> String
displayException = show
#endif

{-------------------------------------------------------------------------------
Creating keys
-------------------------------------------------------------------------------}
Expand Down
5 changes: 0 additions & 5 deletions hackage-root-tool/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -49,11 +49,6 @@ topLevelExceptionHandler e = do
putStrLn $ displayException e
exitFailure

#if !MIN_VERSION_base(4,8,0)
displayException :: Exception e => e -> String
displayException = show
#endif

{-------------------------------------------------------------------------------
Creating keys
-------------------------------------------------------------------------------}
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -133,17 +133,10 @@ instance Pretty UnexpectedResponse where
instance Pretty InvalidProxy where
pretty (InvalidProxy p) = "Invalid proxy " ++ show p

#if MIN_VERSION_base(4,8,0)
deriving instance Show UnexpectedResponse
deriving instance Show InvalidProxy
instance Exception UnexpectedResponse where displayException = pretty
instance Exception InvalidProxy where displayException = pretty
#else
instance Show UnexpectedResponse where show = pretty
instance Show InvalidProxy where show = pretty
instance Exception UnexpectedResponse
instance Exception InvalidProxy
#endif

{-------------------------------------------------------------------------------
Additional operations
Expand Down
12 changes: 1 addition & 11 deletions hackage-security/src/Hackage/Security/Client.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE StaticPointers #-}
#endif

-- | Main entry point into the Hackage Security framework for clients
module Hackage.Security.Client (
-- * Checking for updates
Expand Down Expand Up @@ -952,21 +951,12 @@ data InvalidFileInIndex = forall dec. InvalidFileInIndex {
}
deriving (Typeable)

#if MIN_VERSION_base(4,8,0)
deriving instance Show InvalidPackageException
deriving instance Show LocalFileCorrupted
deriving instance Show InvalidFileInIndex
instance Exception InvalidPackageException where displayException = pretty
instance Exception LocalFileCorrupted where displayException = pretty
instance Exception InvalidFileInIndex where displayException = pretty
#else
instance Show InvalidPackageException where show = pretty
instance Show LocalFileCorrupted where show = pretty
instance Show InvalidFileInIndex where show = pretty
instance Exception InvalidPackageException
instance Exception LocalFileCorrupted
instance Exception InvalidFileInIndex
#endif

instance Pretty InvalidPackageException where
pretty (InvalidPackageException pkgId) = "Invalid package " ++ display pkgId
Expand Down
5 changes: 0 additions & 5 deletions hackage-security/src/Hackage/Security/Client/Repository.hs
Original file line number Diff line number Diff line change
Expand Up @@ -385,13 +385,8 @@ data SomeRemoteError :: * where
SomeRemoteError :: Exception e => e -> SomeRemoteError
deriving (Typeable)

#if MIN_VERSION_base(4,8,0)
deriving instance Show SomeRemoteError
instance Exception SomeRemoteError where displayException = pretty
#else
instance Exception SomeRemoteError
instance Show SomeRemoteError where show = pretty
#endif

instance Pretty SomeRemoteError where
pretty (SomeRemoteError ex) = displayException ex
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -498,13 +498,8 @@ instance Pretty FileTooLarge where
expected (FileSizeExact n) = "exactly " ++ show n
expected (FileSizeBound n) = "at most " ++ show n

#if MIN_VERSION_base(4,8,0)
deriving instance Show FileTooLarge
instance Exception FileTooLarge where displayException = pretty
#else
instance Exception FileTooLarge
instance Show FileTooLarge where show = pretty
#endif

{-------------------------------------------------------------------------------
Information about remote files
Expand Down
5 changes: 0 additions & 5 deletions hackage-security/src/Hackage/Security/JSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -84,13 +84,8 @@ data DeserializationError =
| DeserializationErrorFileType String String
deriving (Typeable)

#if MIN_VERSION_base(4,8,0)
deriving instance Show DeserializationError
instance Exception DeserializationError where displayException = pretty
#else
instance Show DeserializationError where show = pretty
instance Exception DeserializationError
#endif

instance Pretty DeserializationError where
pretty (DeserializationErrorMalformed str) =
Expand Down
27 changes: 0 additions & 27 deletions hackage-security/src/Hackage/Security/Key.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,10 +37,6 @@ import qualified Data.ByteString.Char8 as BS.C8
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Lazy as BS.L

#if !MIN_VERSION_base(4,7,0)
import qualified Data.Typeable as Typeable
#endif

import Hackage.Security.Util.JSON
import Hackage.Security.Util.Some
import Hackage.Security.Util.TypedEmbedded
Expand Down Expand Up @@ -277,26 +273,3 @@ instance ReportSchemaErrors m => FromJSON m (Some KeyType) where
case tag of
"ed25519" -> return . Some $ KeyTypeEd25519
_otherwise -> expected "valid key type" (Just tag)

{-------------------------------------------------------------------------------
Orphans
Pre-7.8 (base 4.7) we cannot have Typeable instance for higher-kinded types.
Instead, here we provide some instance for specific instantiations.
-------------------------------------------------------------------------------}

#if !MIN_VERSION_base(4,7,0)
tyConKey, tyConPublicKey, tyConPrivateKey :: Typeable.TyCon
tyConKey = Typeable.mkTyCon3 "hackage-security" "Hackage.Security.Key" "Key"
tyConPublicKey = Typeable.mkTyCon3 "hackage-security" "Hackage.Security.Key" "PublicKey"
tyConPrivateKey = Typeable.mkTyCon3 "hackage-security" "Hackage.Security.Key" "PrivateKey"

instance Typeable (Some Key) where
typeOf _ = Typeable.mkTyConApp tyConSome [Typeable.mkTyConApp tyConKey []]

instance Typeable (Some PublicKey) where
typeOf _ = Typeable.mkTyConApp tyConSome [Typeable.mkTyConApp tyConPublicKey []]

instance Typeable (Some PrivateKey) where
typeOf _ = Typeable.mkTyConApp tyConSome [Typeable.mkTyConApp tyConPrivateKey []]
#endif
3 changes: 1 addition & 2 deletions hackage-security/src/Hackage/Security/Trusted.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE StaticPointers #-}
#endif

module Hackage.Security.Trusted (
module Hackage.Security.Trusted.TCB
-- * Derived functions
Expand Down
23 changes: 0 additions & 23 deletions hackage-security/src/Hackage/Security/Trusted/TCB.hs
Original file line number Diff line number Diff line change
Expand Up @@ -16,14 +16,8 @@ module Hackage.Security.Trusted.TCB (
, signaturesVerified
, verifyRole'
, verifyFingerprints
#if __GLASGOW_HASKELL__ >= 710
-- * Re-exports
, StaticPtr
#else
-- * Fake static pointers
, StaticPtr
, static
#endif
) where

import Prelude
Expand All @@ -38,17 +32,7 @@ import Hackage.Security.Key
import Hackage.Security.Util.Pretty
import qualified Hackage.Security.Util.Lens as Lens

#if __GLASGOW_HASKELL__ >= 710
import GHC.StaticPtr
#else
-- Fake static pointers for ghc < 7.10. This means Trusted offers no
-- additional type safety, but that's okay: we can still verify the code
-- with ghc 7.10 and get the additional checks.
newtype StaticPtr a = StaticPtr { deRefStaticPtr :: a }

static :: a -> StaticPtr a
static = StaticPtr
#endif

-- | Trusted values
--
Expand Down Expand Up @@ -209,17 +193,10 @@ data RootUpdated = RootUpdated

type VerificationHistory = [Either RootUpdated VerificationError]

#if MIN_VERSION_base(4,8,0)
deriving instance Show VerificationError
deriving instance Show RootUpdated
instance Exception VerificationError where displayException = pretty
instance Exception RootUpdated where displayException = pretty
#else
instance Exception VerificationError
instance Show VerificationError where show = pretty
instance Show RootUpdated where show = pretty
instance Exception RootUpdated
#endif

indentedLines :: [String] -> String
indentedLines = unlines . map (" " ++)
Expand Down
33 changes: 4 additions & 29 deletions hackage-security/src/Hackage/Security/Util/Checked.hs
Original file line number Diff line number Diff line change
@@ -1,16 +1,13 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE RoleAnnotations #-}

{-# OPTIONS_GHC -fno-warn-unused-binds #-}
#if __GLASGOW_HASKELL__ >= 800
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
#endif

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE IncoherentInstances #-}
#endif

{-# LANGUAGE DeriveDataTypeable#-}

-- | Checked exceptions
module Hackage.Security.Util.Checked (
Throws
Expand All @@ -30,11 +27,7 @@ import Control.Exception (Exception, IOException)
import qualified Control.Exception as Base
import Data.Typeable (Typeable)

#if __GLASGOW_HASKELL__ >= 708
import GHC.Prim (coerce)
#else
import Unsafe.Coerce (unsafeCoerce)
#endif

{-------------------------------------------------------------------------------
Basic infrastructure
Expand All @@ -43,9 +36,7 @@ import Unsafe.Coerce (unsafeCoerce)
-- | Checked exceptions
class Throws e where

#if __GLASGOW_HASKELL__ >= 708
type role Throws representational
#endif

unthrow :: forall a e proxy . proxy e -> (Throws e => a) -> a
unthrow _ x = unWrap (coerceWrap (Wrap x :: Wrap e a))
Expand All @@ -56,22 +47,10 @@ unthrow _ x = unWrap (coerceWrap (Wrap x :: Wrap e a))

-- | Determine if an exception is asynchronous, based on its type.
isAsync :: Exception e => e -> Bool
#if MIN_VERSION_base(4, 7, 0)
isAsync e =
case Base.fromException $ Base.toException e of
Just Base.SomeAsyncException{} -> True
Nothing -> False
#else
-- Earlier versions of GHC had no SomeAsyncException. We have to
-- instead make up a list of async exceptions.
isAsync e =
let se = Base.toException e
in case () of
()
| Just (_ :: Base.AsyncException) <- Base.fromException se -> True
| show e == "<<timeout>>" -> True
| otherwise -> False
#endif

-- | 'Base.catch', but immediately rethrows asynchronous exceptions
-- (as determined by 'isAsync').
Expand Down Expand Up @@ -131,11 +110,7 @@ internalError = throwUnchecked . userError
newtype Wrap e a = Wrap { unWrap :: Throws e => a }

coerceWrap :: Wrap e a -> Wrap (Catch e) a
#if __GLASGOW_HASKELL__ >= 708
coerceWrap = coerce
#else
coerceWrap = unsafeCoerce
#endif

data Proxy a = Proxy

Expand Down
8 changes: 1 addition & 7 deletions hackage-security/src/Hackage/Security/Util/JSON.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ < 710
{-# LANGUAGE OverlappingInstances #-}
#endif

-- |
module Hackage.Security.Util.JSON (
-- * Type classes
Expand Down Expand Up @@ -120,16 +118,12 @@ instance ReportSchemaErrors m => FromJSON m Int54 where
fromJSON val = expected' "int" val

instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
(Monad m, ToJSON m a) => ToJSON m [a] where
toJSON = liftM JSArray . mapM toJSON

instance
#if __GLASGOW_HASKELL__ >= 710
{-# OVERLAPPABLE #-}
#endif
(ReportSchemaErrors m, FromJSON m a) => FromJSON m [a] where
fromJSON (JSArray as) = mapM fromJSON as
fromJSON val = expected' "array" val
Expand Down
13 changes: 0 additions & 13 deletions hackage-security/src/Hackage/Security/Util/Some.hs
Original file line number Diff line number Diff line change
Expand Up @@ -13,30 +13,17 @@ module Hackage.Security.Util.Some (
, SomePretty(..)
-- ** Type checking
, typecheckSome
#if !MIN_VERSION_base(4,7,0)
-- ** Compatibility with base < 4.7
, tyConSome
#endif
) where

import Prelude
#if MIN_VERSION_base(4,7,0)
import Data.Typeable (Typeable)
#else
import qualified Data.Typeable as Typeable
#endif

import Hackage.Security.Util.TypedEmbedded
import Hackage.Security.Util.Pretty

data Some f = forall a. Some (f a)

#if MIN_VERSION_base(4,7,0)
deriving instance Typeable Some
#else
tyConSome :: Typeable.TyCon
tyConSome = Typeable.mkTyCon3 "hackage-security" "Hackage.Security.Util.Some" "Some"
#endif

{-------------------------------------------------------------------------------
Equality on Some types
Expand Down
7 changes: 0 additions & 7 deletions hackage-security/src/Text/JSON/Canonical.hs
Original file line number Diff line number Diff line change
Expand Up @@ -37,14 +37,9 @@ import Text.ParserCombinators.Parsec
, parse )
import Text.PrettyPrint hiding (char)
import qualified Text.PrettyPrint as Doc
#if !(MIN_VERSION_base(4,7,0))
import Control.Applicative ((<$>), (<$), pure, (<*>), (<*), (*>))
#endif
import Control.Arrow (first)
import Data.Bits (Bits)
#if MIN_VERSION_base(4,7,0)
import Data.Bits (FiniteBits)
#endif
import Data.Char (isDigit, digitToInt)
import Data.Data (Data)
import Data.Function (on)
Expand Down Expand Up @@ -83,9 +78,7 @@ newtype Int54 = Int54 { int54ToInt64 :: Int64 }
, Ord
, Real
, Ix
#if MIN_VERSION_base(4,7,0)
, FiniteBits
#endif
, Bits
, Storable
, PrintfArg
Expand Down

0 comments on commit a513156

Please sign in to comment.