From 1fbc090874cc9631cc54898b0af58583ce35bc29 Mon Sep 17 00:00:00 2001 From: Daniel Gröber Date: Sun, 12 Aug 2018 04:31:35 +0200 Subject: Add Cabal 2.4 support --- src/CabalHelper/Compiletime/Compat/ProgramDb.hs | 14 ++++ src/CabalHelper/Compiletime/GuessGhc.hs | 92 ------------------------- src/CabalHelper/Compiletime/Wrapper.hs | 32 ++++++--- 3 files changed, 38 insertions(+), 100 deletions(-) create mode 100644 src/CabalHelper/Compiletime/Compat/ProgramDb.hs delete mode 100644 src/CabalHelper/Compiletime/GuessGhc.hs (limited to 'src') diff --git a/src/CabalHelper/Compiletime/Compat/ProgramDb.hs b/src/CabalHelper/Compiletime/Compat/ProgramDb.hs new file mode 100644 index 0000000..89dd886 --- /dev/null +++ b/src/CabalHelper/Compiletime/Compat/ProgramDb.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE CPP #-} +module CabalHelper.Compiletime.Compat.ProgramDb + ( defaultProgramDb + , programPath + , lookupProgram + , ghcProgram + , ghcPkgProgram + ) where + +import Distribution.Simple.Program + +#if !MIN_VERSION_Cabal(2,0,0) +defaultProgramDb = defaultProgramConfiguration +#endif diff --git a/src/CabalHelper/Compiletime/GuessGhc.hs b/src/CabalHelper/Compiletime/GuessGhc.hs deleted file mode 100644 index f4b33d5..0000000 --- a/src/CabalHelper/Compiletime/GuessGhc.hs +++ /dev/null @@ -1,92 +0,0 @@ --- Copyright (c) 2003-2014, Isaac Jones, Simon Marlow, Martin Sjögren, --- Bjorn Bringert, Krasimir Angelov, --- Malcolm Wallace, Ross Patterson, Ian Lynagh, --- Duncan Coutts, Thomas Schilling, --- Johan Tibell, Mikhail Glushenkov --- All rights reserved. - --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: - --- * Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. - --- * Redistributions in binary form must reproduce the above --- copyright notice, this list of conditions and the following --- disclaimer in the documentation and/or other materials provided --- with the distribution. - --- * Neither the name of Isaac Jones nor the names of other --- contributors may be used to endorse or promote products derived --- from this software without specific prior written permission. - --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS --- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT --- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR --- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT --- OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT --- LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, --- DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY --- THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT --- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE --- OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -{-| -Module : CabalHelper.Compiletime.GuessGhc -Description : Logic for finding @ghc-pkg@ based on path to @ghc@ -License : BSD3 --} - -module CabalHelper.Compiletime.GuessGhc (guessToolFromGhcPath) where - -import Data.Maybe -import Data.Char -import Distribution.Simple.BuildPaths -import System.Directory -import System.FilePath - -guessToolFromGhcPath :: FilePath -- ^ Tool name - -> FilePath -- ^ GHC exe path - -> IO (Maybe FilePath) -guessToolFromGhcPath toolname ghcPath - = do let - path = ghcPath - dir = takeDirectory path - versionSuffix = takeVersionSuffix (dropExeExtension path) - guessNormal = dir toolname <.> exeExtension' - guessGhcVersioned = dir (toolname ++ "-ghc" ++ versionSuffix) - <.> exeExtension' - guessVersioned = dir (toolname ++ versionSuffix) - <.> exeExtension' - guesses | null versionSuffix = [guessNormal] - | otherwise = [guessGhcVersioned, - guessVersioned, - guessNormal] - exists <- mapM doesFileExist guesses - return $ listToMaybe [ file | (file, True) <- zip guesses exists ] - - where takeVersionSuffix :: FilePath -> String - takeVersionSuffix = takeWhileEndLE isSuffixChar - - isSuffixChar :: Char -> Bool - isSuffixChar c = isDigit c || c == '.' || c == '-' - - dropExeExtension :: FilePath -> FilePath - dropExeExtension filepath = - case splitExtension filepath of - (filepath', extension) | extension == exeExtension' -> filepath' - | otherwise -> filepath - --- | @takeWhileEndLE p@ is equivalent to @reverse . takeWhile p . reverse@, but --- is usually faster (as well as being easier to read). -takeWhileEndLE :: (a -> Bool) -> [a] -> [a] -takeWhileEndLE p = fst . foldr go ([], False) - where - go x (rest, done) - | not done && p x = (x:rest, False) - | otherwise = (rest, True) - -exeExtension' :: FilePath -exeExtension' = Distribution.Simple.BuildPaths.exeExtension diff --git a/src/CabalHelper/Compiletime/Wrapper.hs b/src/CabalHelper/Compiletime/Wrapper.hs index bee64ee..3ea3462 100644 --- a/src/CabalHelper/Compiletime/Wrapper.hs +++ b/src/CabalHelper/Compiletime/Wrapper.hs @@ -36,11 +36,13 @@ import Distribution.System (buildPlatform) import Distribution.Text (display) import Distribution.Verbosity (silent, deafening) import Distribution.Package (packageName, packageVersion) +import Distribution.Simple.GHC as GHC (configure) import Paths_cabal_helper (version) +import CabalHelper.Compiletime.Compat.ProgramDb + ( defaultProgramDb, programPath, lookupProgram, ghcProgram, ghcPkgProgram) import CabalHelper.Compiletime.Compat.Version import CabalHelper.Compiletime.Compile -import CabalHelper.Compiletime.GuessGhc import CabalHelper.Compiletime.Types import CabalHelper.Shared.Common import CabalHelper.Shared.InterfaceTypes @@ -98,13 +100,27 @@ parseCommandArgs opts argv guessProgramPaths :: Options -> IO Options guessProgramPaths opts = do - if not (same oGhcProgram opts dopts) && same oGhcPkgProgram opts dopts - then do - mghcPkg <- guessToolFromGhcPath "ghc-pkg" (oGhcProgram opts) - return opts { - oGhcPkgProgram = fromMaybe (oGhcPkgProgram opts) mghcPkg - } - else return opts + let v | oVerbose opts = deafening + | otherwise = silent + + mGhcPath0 | same oGhcProgram opts dopts = Nothing + | otherwise = Just $ oGhcProgram opts + mGhcPkgPath0 | same oGhcPkgProgram opts dopts = Nothing + | otherwise = Just $ oGhcPkgProgram opts + + (_compiler, _mplatform, progdb) + <- GHC.configure + v + mGhcPath0 + mGhcPkgPath0 + defaultProgramDb + + let mghcPath1 = programPath <$> lookupProgram ghcProgram progdb + mghcPkgPath1 = programPath <$> lookupProgram ghcPkgProgram progdb + + return $ opts { oGhcProgram = fromMaybe (oGhcProgram opts) mghcPath1 + , oGhcPkgProgram = fromMaybe (oGhcProgram opts) mghcPkgPath1 + } where same f o o' = f o == f o' dopts = defaultOptions -- cgit v1.2.3