diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/CabalHelper/Compiletime/Compat/ProgramDb.hs | 14 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/GuessGhc.hs | 92 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Wrapper.hs | 32 | 
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  | 
