aboutsummaryrefslogtreecommitdiff
path: root/src/CabalHelper
diff options
context:
space:
mode:
Diffstat (limited to 'src/CabalHelper')
-rw-r--r--src/CabalHelper/Compiletime/Compat/ProgramDb.hs14
-rw-r--r--src/CabalHelper/Compiletime/GuessGhc.hs92
-rw-r--r--src/CabalHelper/Compiletime/Wrapper.hs32
3 files changed, 38 insertions, 100 deletions
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