Commit 4e33454f authored by Herbert Valerio Riedel's avatar Herbert Valerio Riedel 🕺
Browse files

Make Distribution.Simple.Configure warning-free & CPP-free

GHC 8.0 changed the `ErrorCall` type to have an extended constructor,
and backward compatibility has been provided via PatternSynonyms:

    data ErrorCall = ErrorCallWithLocation String String
        deriving (Eq, Ord)

    pattern ErrorCall :: String -> ErrorCall
    pattern ErrorCall err <- ErrorCallWithLocation err _ where
            ErrorCall err  = ErrorCallWithLocation err ""

However, due to https://ghc.haskell.org/ticket/8779 the
exhaustive-checker doesn't cope well with pattern-synonyms yet, and so
we get a non-exhaustive pattern-match failure when matching on
'ErrorCall' now.

As the matching on the constructor 'ErrorCall' is done here to help
infer the Exception instance, we can also just annotate the type
directly, and eschew the problematic pattern match.

While at it, this commit also makes this module CPP-free.
parent 81f98998
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
#if __GLASGOW_HASKELL__ >= 711
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
......@@ -132,11 +129,7 @@ import qualified Distribution.Simple.HaskellSuite as HaskellSuite
import Prelude hiding ( mapM )
import Control.Exception
( Exception, evaluate, throw, throwIO, try )
#if __GLASGOW_HASKELL__ >= 711
import Control.Exception ( pattern ErrorCall )
#else
import Control.Exception ( ErrorCall(..) )
#endif
import Control.Exception ( ErrorCall )
import Control.Monad
( liftM, when, unless, foldM, filterM )
import Distribution.Compat.Binary ( decodeOrFailIO, encode )
......@@ -151,10 +144,7 @@ import Data.Maybe
import Data.Either
( partitionEithers )
import qualified Data.Set as Set
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
( Monoid(..) )
#endif
import Data.Monoid as Mon ( Monoid(..) )
import qualified Data.Map as Map
import Data.Map (Map)
import Data.Traversable
......@@ -232,7 +222,7 @@ getConfigStateFile filename = do
headerParseResult <- try $ evaluate $ parseHeader header
let (cabalId, compId) =
case headerParseResult of
Left (ErrorCall _) -> throw ConfigStateFileBadHeader
Left (_ :: ErrorCall) -> throw ConfigStateFileBadHeader
Right x -> x
let getStoredValue = do
......@@ -1208,7 +1198,7 @@ configurePkgconfigPackages verbosity pkg_descr conf
\bench bi -> bench { benchmarkBuildInfo = bi }
pkgconfigBuildInfo :: [Dependency] -> IO BuildInfo
pkgconfigBuildInfo [] = return mempty
pkgconfigBuildInfo [] = return Mon.mempty
pkgconfigBuildInfo pkgdeps = do
let pkgs = nub [ display pkg | Dependency pkg _ <- pkgdeps ]
ccflags <- pkgconfig ("--cflags" : pkgs)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment