aboutsummaryrefslogtreecommitdiff
path: root/CabalHelper/Compiletime/GuessGhc.hs
diff options
context:
space:
mode:
authorDaniel Gröber <dxld@darkboxed.org>2017-09-18 01:23:22 +0200
committerDaniel Gröber <dxld@darkboxed.org>2017-09-18 01:35:40 +0200
commitf864a5eae8262752162c6b0d124aea4601ed9ac1 (patch)
tree1b765d25741b6e47d4ad458c8041c0881dd353b8 /CabalHelper/Compiletime/GuessGhc.hs
parent70d743eb6a8b7f8da182524fa0b2c4bf02399d50 (diff)
Fix literally everything :)
Sorry for the megacommit - Seperate modules into: - Compiletime, modules which are only used while building the package - Runtime, modues included in the wrapper binary to be compiled on the users machine at runtime - Shared, modues used in both contexts - Refactor runtime compilation - Completely revamp output paths - Don't chdir when invoking ghc - Require cabal-version 1.14 in cabal file
Diffstat (limited to 'CabalHelper/Compiletime/GuessGhc.hs')
-rw-r--r--CabalHelper/Compiletime/GuessGhc.hs86
1 files changed, 86 insertions, 0 deletions
diff --git a/CabalHelper/Compiletime/GuessGhc.hs b/CabalHelper/Compiletime/GuessGhc.hs
new file mode 100644
index 0000000..e1cf577
--- /dev/null
+++ b/CabalHelper/Compiletime/GuessGhc.hs
@@ -0,0 +1,86 @@
+module CabalHelper.Compiletime.GuessGhc (guessToolFromGhcPath) where
+
+import Data.Maybe
+import Data.Char
+import Distribution.Simple.BuildPaths
+import System.Directory
+import System.FilePath
+
+-- 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.
+
+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