diff options
| -rw-r--r-- | .travis.yml | 19 | ||||
| -rw-r--r-- | CabalHelper/Common.hs | 98 | ||||
| -rw-r--r-- | CabalHelper/Data.hs | 39 | ||||
| -rw-r--r-- | CabalHelper/GuessGhc.hs | 83 | ||||
| -rw-r--r-- | CabalHelper/Main.hs | 344 | ||||
| -rw-r--r-- | CabalHelper/Types.hs | 40 | ||||
| -rw-r--r-- | CabalHelper/Wrapper.hs | 368 | ||||
| -rw-r--r-- | Distribution/Helper.hs | 278 | ||||
| -rw-r--r-- | LICENSE | 661 | ||||
| -rw-r--r-- | Setup.hs | 70 | ||||
| -rw-r--r-- | cabal-helper.cabal | 67 |
11 files changed, 2067 insertions, 0 deletions
diff --git a/.travis.yml b/.travis.yml new file mode 100644 index 0000000..d3fc908 --- /dev/null +++ b/.travis.yml @@ -0,0 +1,19 @@ +language: haskell +ghc: + - 7.4 + - 7.6 + - 7.8 + +install: + - cabal update + - echo $PATH + - which cabal + - cabal install -j --only-dependencies --enable-tests + +script: + - touch ChangeLog # Create ChangeLog if we're not on the release branch + - cabal check + - if [ -n "$(ghc --version | awk '{ print $8 }' | sed -n '/^7.8/p')" ]; then export WERROR="--ghc-option=-Werror"; fi + - cabal configure --enable-tests $WERROR + - cabal build +# - cabal test diff --git a/CabalHelper/Common.hs b/CabalHelper/Common.hs new file mode 100644 index 0000000..2e8ff6a --- /dev/null +++ b/CabalHelper/Common.hs @@ -0,0 +1,98 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-} +module CabalHelper.Common where + +import Control.Applicative +import Control.Exception as E +import Control.Monad +import Data.List +import Data.Maybe +import Data.Version +import Data.Typeable +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import System.Environment +import System.IO +import System.Exit +import Text.ParserCombinators.ReadP + +data Panic = Panic String deriving (Typeable, Show) +instance Exception Panic + +panic :: String -> a +panic msg = throw $ Panic msg + +handlePanic :: IO a -> IO a +handlePanic action = + action `E.catch` \(Panic msg) -> errMsg msg >> exitFailure + +errMsg :: String -> IO () +errMsg str = do + prog <- getProgName + hPutStrLn stderr $ prog ++ ": " ++ str + +align :: String -> String -> String -> String +align n an str = let + h:rest = lines str + [hm] = match n h + rest' = [ move (hm - rm) r | r <- rest, rm <- match an r] + in + unlines (h:rest') + where + match p str' = maybeToList $ + fst <$> find ((p `isPrefixOf`) . snd) ([0..] `zip` tails str') + move i str' | i > 0 = replicate i ' ' ++ str' + move i str' = drop i str' + + +-- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and +-- compiler version +getCabalConfigHeader :: FilePath -> IO (Maybe (Version, Version)) +getCabalConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do + parseHeader <$> BS.hGetLine h + +parseHeader :: ByteString -> Maybe (Version, Version) +parseHeader header = case BS8.words header of + ["Saved", "package", "config", "for", _pkgId , + "written", "by", cabalId, + "using", compId] + -> liftM2 (,) (ver cabalId) (ver compId) + _ -> Nothing + where + ver i = snd <$> parsePkgId i + +parsePkgId :: ByteString -> Maybe (ByteString, Version) +parsePkgId bs = + case BS8.split '-' bs of + [pkg, vers] -> Just (pkg, parseVer $ BS8.unpack vers) + _ -> Nothing + +parseVer :: String -> Version +parseVer vers = runReadP parseVersion vers + +-- majorVer :: Version -> Version +-- majorVer (Version b _) = Version (take 2 b) [] + +-- sameMajorVersion :: Version -> Version -> Bool +-- sameMajorVersion a b = majorVer a == majorVer b + +runReadP :: ReadP t -> String -> t +runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of + (a,""):[] -> a + _ -> error $ "Error parsing: " ++ show i diff --git a/CabalHelper/Data.hs b/CabalHelper/Data.hs new file mode 100644 index 0000000..28d0859 --- /dev/null +++ b/CabalHelper/Data.hs @@ -0,0 +1,39 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-# LANGUAGE TemplateHaskell #-} +module CabalHelper.Data where + +import Control.Monad +import Data.Functor +import Language.Haskell.TH +import System.FilePath +import System.Directory +import System.IO.Temp + +withHelperSources :: (FilePath -> IO a) -> IO a +withHelperSources action = withSystemTempDirectory "caba-helper" $ \dir -> do + let chdir = dir </> "CabalHelper" + createDirectory chdir + forM_ sourceFiles $ \(fn, src) -> writeFile (chdir </> fn) src + action dir + +sourceFiles :: [(FilePath, String)] +sourceFiles = + [ ("Main.hs", $(LitE . StringL <$> runIO (readFile "CabalHelper/Main.hs"))) + , ("Common.hs", $(LitE . StringL <$> runIO (readFile "CabalHelper/Common.hs"))) + , ("Types.hs", $(LitE . StringL <$> runIO (readFile "CabalHelper/Types.hs"))) + ] diff --git a/CabalHelper/GuessGhc.hs b/CabalHelper/GuessGhc.hs new file mode 100644 index 0000000..0827456 --- /dev/null +++ b/CabalHelper/GuessGhc.hs @@ -0,0 +1,83 @@ +module CabalHelper.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) diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs new file mode 100644 index 0000000..777ac7a --- /dev/null +++ b/CabalHelper/Main.hs @@ -0,0 +1,344 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-# LANGUAGE CPP, BangPatterns, RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +import Distribution.Simple.Utils (cabalVersion) +import Distribution.Simple.Configure + +import Distribution.Package (PackageIdentifier, InstalledPackageId, PackageId) +import Distribution.PackageDescription (PackageDescription, + FlagAssignment, + Executable(..), + Library(..), + TestSuite(..), + Benchmark(..), + BuildInfo(..), + TestSuiteInterface(..), + BenchmarkInterface(..), + withLib) +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.PackageDescription.Configuration (flattenPackageDescription) + +import Distribution.Simple.Program (requireProgram, ghcProgram) +import Distribution.Simple.Program.Types (ConfiguredProgram(..)) +import Distribution.Simple.Configure (getPersistBuildConfig) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), + Component(..), + ComponentName(..), + ComponentLocalBuildInfo(..), + componentBuildInfo, + externalPackageDeps, + withComponentsLBI, + inplacePackageId) + +import Distribution.Simple.GHC (componentGhcOptions) +import Distribution.Simple.Program.GHC (GhcOptions(..), renderGhcOptions) + +import Distribution.Simple.Setup (ConfigFlags(..),Flag(..)) +import Distribution.Simple.Build (initialBuildSteps) +import Distribution.Simple.BuildPaths (autogenModuleName, cppHeaderName, exeExtension) +import Distribution.Simple.Compiler (PackageDB(..)) + +import Distribution.ModuleName (components) +import qualified Distribution.ModuleName as C (ModuleName) +import Distribution.Text (display) +import Distribution.Verbosity (Verbosity, silent, deafening) + +#if CABAL_MAJOR == 1 && CABAL_MINOR >= 22 +import Distribution.Utils.NubList +#endif + +import Control.Applicative ((<$>)) +import Control.Monad +import Control.Exception (catch, PatternMatchFail(..)) +import Data.List +import Data.Maybe +import Data.Monoid +import Data.IORef +import System.Environment +import System.Directory +import System.FilePath +import System.Exit +import System.IO +import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO) +import Text.Printf + +import CabalHelper.Common +import CabalHelper.Types + +usage = do + prog <- getProgName + hPutStr stderr $ align "(" "|" ("Usage: " ++ prog ++ " " ++ usageMsg) + where + usageMsg = "" + ++"DIST_DIR ( version\n" + ++" | print-lbi\n" + ++" | write-autogen-files\n" + ++" | ghc-options [--with-inplace]\n" + ++" | ghc-src-options [--with-inplace]\n" + ++" | ghc-pkg-options [--with-inplace]\n" + ++" | entrypoints\n" + ++" | source-dirs\n" + ++" ) ...\n" + +commands :: [String] +commands = [ "print-bli" + , "write-autogen-files" + , "component-from-file" + , "ghc-options" + , "ghc-src-options" + , "ghc-pkg-options" + , "entrypoints" + , "source-dirs"] + +main :: IO () +main = do + args <- getArgs + + distdir:args' <- case args of + [] -> usage >> exitFailure + _ -> return args + + ddexists <- doesDirectoryExist distdir + when (not ddexists) $ do + errMsg $ "distdir '"++distdir++"' does not exist" + exitFailure + + v <- maybe silent (const deafening) . lookup "GHC_MOD_DEBUG" <$> getEnvironment + lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir + let pd = localPkgDescr lbi + + let + -- a =<< b $$ c == (a =<< b) $$ c + -- a <$$> b $$ c == a <$$> (b $$ c) + infixr 2 $$ + ($$) = ($) + infixr 1 <$$> + (<$$>) = (<$>) + + collectCmdOptions :: [String] -> [[String]] + collectCmdOptions = + reverse . map reverse . foldl f [] . dropWhile isOpt + where + isOpt = ("--" `isPrefixOf`) + f [] x = [[x]] + f (a:as) x + | isOpt x = (x:a):as + | otherwise = [x]:(a:as) + + let cmds = collectCmdOptions args' + + if any (["version"] `isPrefixOf`) cmds + then do + putStrLn $ + printf "using version %s of the Cabal library" (display cabalVersion) + exitSuccess + else return () + + print =<< flip mapM cmds $$ \cmd -> do + case cmd of + "write-autogen-files":[] -> do + let pd = localPkgDescr lbi + -- calls writeAutogenFiles + initialBuildSteps distdir pd lbi v + return Nothing + + "ghc-options":flags -> + Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$ + \c clbi bi -> let + outdir = componentOutDir lbi c + (clbi', adopts) = case flags of + ["--with-inplace"] -> (clbi, mempty) + [] -> removeInplaceDeps pd clbi + opts = componentGhcOptions v lbi bi clbi' outdir + in + renderGhcOptions' lbi v $ opts `mappend` adopts + + "ghc-src-options":flags -> + Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$ + \c clbi bi -> let + outdir = componentOutDir lbi c + (clbi', adopts) = case flags of + ["--with-inplace"] -> (clbi, mempty) + [] -> removeInplaceDeps pd clbi + opts = componentGhcOptions v lbi bi clbi' outdir + comp = compiler lbi + + opts' = mempty { + -- Not really needed but "unexpected package db stack: []" + ghcOptPackageDBs = [GlobalPackageDB], + ghcOptCppOptions = ghcOptCppOptions opts, + ghcOptCppIncludePath = ghcOptCppIncludePath opts, + ghcOptCppIncludes = ghcOptCppIncludes opts, + ghcOptFfiIncludes = ghcOptFfiIncludes opts, + ghcOptSourcePathClear = ghcOptSourcePathClear opts, + ghcOptSourcePath = ghcOptSourcePath opts + } + in + renderGhcOptions' lbi v $ opts `mappend` adopts + + "ghc-pkg-options":flags -> + Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$ + \c clbi bi -> let + comp = compiler lbi + outdir = componentOutDir lbi c + (clbi', adopts) = case flags of + ["--with-inplace"] -> (clbi, mempty) + [] -> removeInplaceDeps pd clbi + opts = componentGhcOptions v lbi bi clbi' outdir + + opts' = mempty { + ghcOptPackageDBs = ghcOptPackageDBs opts, + ghcOptPackages = ghcOptPackages opts, + ghcOptHideAllPackages = ghcOptHideAllPackages opts + } + in + renderGhcOptions' lbi v $ opts' `mappend` adopts + + "entrypoints":[] -> do + eps <- componentsMap lbi v distdir $ \c clbi bi -> + return $ componentEntrypoints c + -- MUST append Setup component at the end otherwise CabalHelper gets + -- confused + let eps' = eps ++ [(GmSetupHsName, Right [GmModuleName "Setup"])] + return $ Just $ GmCabalHelperEntrypoints eps' + + "source-dirs":[] -> + Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$ + \c clbi bi -> return $ hsSourceDirs bi + + "print-lbi":[] -> + return $ Just $ GmCabalHelperLbi $ show lbi + + cmd:_ | not (cmd `elem` commands) -> + errMsg ("Unknown command: " ++ cmd) >> usage >> exitFailure + _ -> + errMsg "Invalid usage!" >> usage >> exitFailure + + +getLibrary :: PackageDescription -> Library +getLibrary pd = unsafePerformIO $ do + lr <- newIORef (error "libraryMap: empty IORef") + withLib pd (writeIORef lr) + readIORef lr + +componentsMap :: LocalBuildInfo + -> Verbosity + -> FilePath + -> ( Component + -> ComponentLocalBuildInfo + -> BuildInfo + -> IO a) + -> IO [(GmComponentName, a)] +componentsMap lbi v distdir f = do + let pd = localPkgDescr lbi + + lr <- newIORef [] + + withComponentsLBI pd lbi $ \c clbi -> do + let bi = componentBuildInfo c + name = componentNameFromComponent c + + l' <- readIORef lr + r <- f c clbi bi + writeIORef lr $ (componentNameToGm name, r):l' + reverse <$> readIORef lr + +componentNameToGm CLibName = GmLibName +componentNameToGm (CExeName n) = GmExeName n +componentNameToGm (CTestName n) = GmTestName n +componentNameToGm (CBenchName n) = GmBenchName n + +componentNameFromComponent (CLib Library {}) = CLibName +componentNameFromComponent (CExe Executable {..}) = CExeName exeName +componentNameFromComponent (CTest TestSuite {..}) = CTestName testName +componentNameFromComponent (CBench Benchmark {..}) = CBenchName benchmarkName + +componentOutDir lbi (CLib Library {..})= buildDir lbi +componentOutDir lbi (CExe Executable {..})= exeOutDir lbi exeName +componentOutDir lbi (CTest TestSuite { testInterface = TestSuiteExeV10 _ _, ..}) = + exeOutDir lbi testName +componentOutDir lbi (CTest TestSuite { testInterface = TestSuiteLibV09 _ _, ..}) = + exeOutDir lbi (testName ++ "Stub") +componentOutDir lbi (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ _, ..})= + exeOutDir lbi benchmarkName + +gmModuleName :: C.ModuleName -> GmModuleName +gmModuleName = GmModuleName . intercalate "." . components + +componentEntrypoints :: Component -> Either FilePath [GmModuleName] +componentEntrypoints (CLib Library {..}) + = Right $ map gmModuleName $ exposedModules ++ (otherModules libBuildInfo) +componentEntrypoints (CExe Executable {..}) + = Left modulePath +componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp }) + = Left fp +componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn }) + = Right [gmModuleName mn] +componentEntrypoints (CTest TestSuite {}) + = Right [] +componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ fp}) + = Left fp +componentEntrypoints (CBench Benchmark {}) + = Left [] + +exeOutDir :: LocalBuildInfo -> String -> FilePath +exeOutDir lbi exeName = + ----- Copied from Distribution/Simple/GHC.hs:buildOrReplExe + -- exeNameReal, the name that GHC really uses (with .exe on Windows) + let exeNameReal = exeName <.> + (if takeExtension exeName /= ('.':exeExtension) + then exeExtension + else "") + + targetDir = (buildDir lbi) </> exeName + in targetDir + + +removeInplaceDeps :: PackageDescription + -> ComponentLocalBuildInfo + -> (ComponentLocalBuildInfo, GhcOptions) +removeInplaceDeps pd clbi = let + (ideps, deps) = partition isInplaceDep (componentPackageDeps clbi) + hasIdeps = not $ null ideps + clbi' = clbi { componentPackageDeps = deps } + lib = getLibrary pd + src_dirs = hsSourceDirs (libBuildInfo lib) + adopts = mempty { + ghcOptSourcePath = +#if CABAL_MAJOR == 1 && CABAL_MINOR >= 22 + toNubListR src_dirs +#else + src_dirs +#endif + + } + + in (clbi', if hasIdeps then adopts else mempty) + + where + isInplaceDep :: (InstalledPackageId, PackageId) -> Bool + isInplaceDep (ipid, pid) = inplacePackageId pid == ipid + +renderGhcOptions' lbi v opts = do +#if CABAL_MAJOR == 1 && CABAL_MINOR < 20 + (ghcProg, _) <- requireProgram v ghcProgram (withPrograms lbi) + let Just ghcVer = programVersion ghcProg + return $ renderGhcOptions ghcVer opts +#else + return $ renderGhcOptions (compiler lbi) opts +#endif diff --git a/CabalHelper/Types.hs b/CabalHelper/Types.hs new file mode 100644 index 0000000..85cf2d2 --- /dev/null +++ b/CabalHelper/Types.hs @@ -0,0 +1,40 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +module CabalHelper.Types where + +newtype ChModuleName = ChModuleName String + deriving (Eq, Ord, Read, Show) + +data ChComponentName = ChSetupHsName + | ChLibName + | ChExeName String + | ChTestName String + | ChBenchName String + deriving (Eq, Ord, Read, Show) + +data Response + = ResponseStrings [(ChComponentName, [String])] + | ResponseEntrypoints [(ChComponentName, ChEntrypoint)] + | ResponseLbi String + deriving (Eq, Ord, Read, Show) + +data ChEntrypoint = ChExeEntrypoint { chMainIs :: FilePath + , chOtherModules :: [ChModuleName] + } + | ChLibentrypoint { chExposedModules :: [ChModuleName] + , chOtherModules :: [ChModuleName] + } deriving (Eq, Ord, Read, Show) diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs new file mode 100644 index 0000000..6ba933d --- /dev/null +++ b/CabalHelper/Wrapper.hs @@ -0,0 +1,368 @@ +-- cabal-helper: Simple interface to Cabal's configuration state +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-# LANGUAGE RecordWildCards, FlexibleContexts #-} +module Main where + +import Control.Applicative +import Control.Arrow +import Control.Exception as E +import Control.Monad +import Control.Monad.Trans.Maybe +import Control.Monad.IO.Class +import Data.Char +import Data.List +import Data.Maybe +import Data.String +import Data.Version +import Text.Printf +import System.Console.GetOpt +import System.Environment +import System.Directory +import System.FilePath +import System.Process +import System.Exit +import System.IO + +import Distribution.System (buildPlatform) +import Distribution.Text (display) + +import Paths_cabal_helper (version) +import CabalHelper.Data +import CabalHelper.Common +import CabalHelper.GuessGhc + +usage :: IO () +usage = do + prog <- getProgName + hPutStr stderr $ align "(" "|" ("Usage: " ++ prog ++ " " ++ usageMsg) + where + usageMsg = "\ +\( print-appdatadir\n\ +\| print-build-platform\n\ +\| DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n" + +data Options = Options { + ghcProgram :: FilePath + , ghcPkgProgram :: FilePath + , cabalProgram :: FilePath +} + +defaultOptions :: Options +defaultOptions = Options "ghc" "ghc-pkg" "cabal" + +globalArgSpec :: [OptDescr (Options -> Options)] +globalArgSpec = + [ option "" ["with-ghc"] "GHC executable to use" $ + reqArg "PROG" $ \p o -> o { ghcProgram = p } + + , option "" ["with-ghc-pkg"] "ghc-pkg executable to use (only needed when guessing from GHC path fails)" $ + reqArg "PROG" $ \p o -> o { ghcPkgProgram = p } + + , option "" ["with-cabal"] "cabal-install executable to use" $ + reqArg "PROG" $ \p o -> o { cabalProgram = p } + ] + where + option :: [Char] -> [String] -> String -> ArgDescr a -> OptDescr a + option s l udsc dsc = Option s l dsc udsc + + reqArg :: String -> (String -> a) -> ArgDescr a + reqArg udsc dsc = ReqArg dsc udsc + +parseCommandArgs :: Options -> [String] -> (Options, [String]) +parseCommandArgs opts argv + = case getOpt Permute globalArgSpec argv of + (o,r,[]) -> (foldr id opts o, r) + (_,_,errs) -> + panic $ "Parsing command options failed: " ++ concat errs + +guessProgramPaths :: Options -> IO Options +guessProgramPaths opts = do + if not (same ghcProgram opts dopts) && same ghcPkgProgram opts dopts + then do + mghcPkg <- guessToolFromGhcPath "ghc-pkg" (ghcProgram opts) + return opts { + ghcPkgProgram = fromMaybe (ghcPkgProgram opts) mghcPkg + } + else return opts + where + same f o o' = f o == f o' + dopts = defaultOptions + +main :: IO () +main = handlePanic $ do + (opts', args) <- parseCommandArgs defaultOptions <$> getArgs + opts <- guessProgramPaths opts' + case args of + [] -> usage + "--help":[] -> usage + "print-appdatadir":[] -> putStrLn =<< appDataDir + "print-build-platform":[] -> putStrLn $ display buildPlatform + distdir:args' -> do + cfgf <- canonicalizePath (distdir </> "setup-config") + mhdr <- getCabalConfigHeader cfgf + case mhdr of + Nothing -> panic $ printf "\ +\Could not read Cabal's persistent setup configuration header\n\ +\- Check first line of: %s\n\ +\- Maybe try: $ cabal configure" cfgf + + Just (hdrCabalVersion, _hdrCompilerVersion) -> do + eexe <- compileHelper opts hdrCabalVersion distdir + case eexe of + Left e -> exitWith e + Right exe -> + case args' of + "print-exe":_ -> putStrLn exe + _ -> do + (_,_,_,h) <- createProcess $ proc exe args + exitWith =<< waitForProcess h + +appDataDir :: IO FilePath +appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod" + +compileHelper :: Options -> Version -> FilePath -> IO (Either ExitCode FilePath) +compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do + run [ Right <$> MaybeT (cachedExe cabalVer) + , compileGlobal chdir + , cachedCabalPkg chdir + , compileCabalSource chdir + , MaybeT (Just <$> compileSandbox chdir) + ] + + where + run actions = fromJust <$> runMaybeT (msum actions) + + -- | Check if this version is globally available + compileGlobal :: FilePath -> MaybeT IO (Either ExitCode FilePath) + compileGlobal chdir = do + _ <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts + liftIO $ compileWithPkg chdir Nothing + + -- | Check if we already compiled this version of cabal into a private + -- package-db + cachedCabalPkg :: FilePath -> MaybeT IO (Either ExitCode FilePath) + cachedCabalPkg chdir = do + db_exists <- liftIO $ cabalPkgDbExists opts cabalVer + case db_exists of + False -> mzero + True -> liftIO $ do + db <- cabalPkgDb opts cabalVer + compileWithPkg chdir (Just db) + + -- | See if we're in a cabal source tree + compileCabalSource :: FilePath -> MaybeT IO (Either ExitCode FilePath) + compileCabalSource chdir = do + let couldBeSrcDir = takeDirectory distdir + cabalFile = couldBeSrcDir </> "Cabal.cabal" + cabal <- liftIO $ doesFileExist cabalFile + case cabal of + False -> mzero + True -> liftIO $ do + ver <- cabalFileVersion <$> readFile cabalFile + compileWithCabalTree chdir ver couldBeSrcDir + + -- | Compile the requested cabal version into an isolated package-db + compileSandbox :: FilePath -> IO (Either ExitCode FilePath) + compileSandbox chdir = do + db <- installCabal opts cabalVer `E.catch` + \(SomeException _) -> errorInstallCabal cabalVer + compileWithPkg chdir (Just db) + + compileWithCabalTree chdir ver srcDir = + compile opts $ Compile chdir (Just srcDir) Nothing ver [] + + compileWithPkg chdir mdb = + compile opts $ Compile chdir Nothing mdb cabalVer [cabalPkgId cabalVer] + + cabalPkgId v = "Cabal-" ++ showVersion v + +-- errorNoCabal :: Version -> a +-- errorNoCabal cabalVer = panic $ printf "\ +-- \No appropriate Cabal package found, wanted version %s.\n" +-- where +-- sver = showVersion cabalVer + +errorInstallCabal :: Version -> a +errorInstallCabal cabalVer = panic $ printf "\ +\Installing Cabal version %s failed.\n\ +\n\ +\You have two choices now:\n\ +\- Either you install this version of Cabal in your globa/luser package-db\n\ +\ somehow\n\ +\n\ +\- Or you can see if you can update your cabal-install to use a different\n\ +\ version of the Cabal library that we can build with:\n\ +\ $ cabal install cabal-install --constraint 'Cabal > %s'\n\ +\n\ +\To check the version cabal-install is currently using try:\n\ +\ $ cabal --version\n" sver sver + where + sver = showVersion cabalVer + +data Compile = Compile { + cabalHelperSourceDir :: FilePath, + cabalSourceDir :: Maybe FilePath, + packageDb :: Maybe FilePath, + cabalVersion :: Version, + packageDeps :: [String] + } + +compile :: Options -> Compile -> IO (Either ExitCode FilePath) +compile Options {..} Compile {..} = do + outdir <- appDataDir + createDirectoryIfMissing True outdir + exe <- exePath cabalVersion + + let Version (mj:mi:_) _ = cabalVersion + let ghc_opts = + concat [ + [ "-outputdir", outdir + , "-o", exe + , "-optP-DCABAL_HELPER=1" + , "-optP-DCABAL_MAJOR=" ++ show mj + , "-optP-DCABAL_MINOR=" ++ show mi + ], + maybeToList $ ("-package-db="++) <$> packageDb, + map ("-i"++) $ cabalHelperSourceDir:maybeToList cabalSourceDir, + concatMap (\p -> ["-package", p]) packageDeps, + [ "--make", cabalHelperSourceDir </> "CabalHelper/Main.hs" ] + ] + + -- TODO: touch exe after, ghc doesn't do that if the input files didn't + -- actually change + rv <- callProcessStderr' Nothing ghcProgram ghc_opts + return $ case rv of + ExitSuccess -> Right exe + e@(ExitFailure _) -> Left e + +exePath :: Version -> IO FilePath +exePath cabalVersion = do + outdir <- appDataDir + return $ outdir </> "cabal-helper-" ++ showVersion version -- our ver + ++ "-Cabal-" ++ showVersion cabalVersion + +cachedExe :: Version -> IO (Maybe FilePath) +cachedExe cabalVersion = do + exe <- exePath cabalVersion + exists <- doesFileExist exe + return $ if exists then Just exe else Nothing + +callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode +callProcessStderr' mwd exe args = do + (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr + , cwd = mwd } + waitForProcess h + +callProcessStderr :: Maybe FilePath -> FilePath -> [String] -> IO () +callProcessStderr mwd exe args = do + rv <- callProcessStderr' mwd exe args + case rv of + ExitSuccess -> return () + ExitFailure v -> processFailedException "callProcessStderr" exe args v + +processFailedException :: String -> String -> [String] -> Int -> IO a +processFailedException fn exe args rv = + panic $ concat [fn, ": ", exe, " " + , intercalate " " (map show args) + , " (exit " ++ show rv ++ ")"] + +installCabal :: Options -> Version -> IO FilePath +installCabal opts ver = do + appdir <- appDataDir + hPutStr stderr $ printf "\ +\cabal-helper-wrapper: Installing a private copy of Cabal, this might take a\n\ +\while but will only happen once per Cabal version.\n\ +\\n\ +\If anything goes horribly wrong just delete this directory and try again:\n\ +\ %s\n\ +\\n\ +\If you want to avoid this automatic installation altogether install version\n\ +\%s of Cabal manually (into your user or global package-db):\n\ +\ $ cabal install Cabal-%s\n\ +\..." appdir (showVersion ver) (showVersion ver) + + db <- createPkgDb opts ver + callProcessStderr (Just "/") (cabalProgram opts) $ concat + [ + [ "--package-db=clear" + , "--package-db=global" + , "--package-db=" ++ db + , "--prefix=" ++ db </> "prefix" + , "-v0" + , "--with-ghc=" ++ ghcProgram opts + ] + , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions + then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ] + else [] + , [ "install", "Cabal-"++showVersion ver ] + ] + hPutStrLn stderr "Done" + return db + +ghcVersion :: Options -> IO Version +ghcVersion Options {..} = do + parseVer . trim <$> readProcess ghcProgram ["--numeric-version"] "" + +ghcPkgVersion :: Options -> IO Version +ghcPkgVersion Options {..} = do + parseVer . trim <$> readProcess ghcPkgProgram ["--numeric-version"] "" + +trim :: String -> String +trim = dropWhileEnd isSpace + +createPkgDb :: Options -> Version -> IO FilePath +createPkgDb opts@Options {..} ver = do + db <- cabalPkgDb opts ver + exists <- doesDirectoryExist db + when (not exists) $ callProcessStderr Nothing ghcPkgProgram ["init", db] + return db + +cabalPkgDb :: Options -> Version -> IO FilePath +cabalPkgDb opts ver = do + appdir <- appDataDir + ghcVer <- ghcVersion opts + return $ appdir </> "Cabal-" ++ showVersion ver ++ "-db-" ++ showVersion ghcVer + +cabalPkgDbExists :: Options -> Version -> IO Bool +cabalPkgDbExists opts ver = do + db <- cabalPkgDb opts ver + dexists <- doesDirectoryExist db + case dexists of + False -> return False + True -> do + vers <- listCabalVersions' opts (Just db) + return $ ver `elem` vers + +listCabalVersions :: Options -> IO [Version] +listCabalVersions opts = listCabalVersions' opts Nothing + +-- TODO: Include sandbox? Probably only relevant for build-type:custom projects. +listCabalVersions' :: Options -> Maybe FilePath -> IO [Version] +listCabalVersions' Options {..} mdb = do + let mdbopt = ("--package-db="++) <$> mdb + opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt + + catMaybes . map (fmap snd . parsePkgId . fromString) . words + <$> readProcess ghcPkgProgram opts "" + +-- | Find @version: XXX@ delcaration in a cabal file +cabalFileVersion :: String -> Version +cabalFileVersion cabalFile = do + fromJust $ parseVer . extract <$> find ("version" `isPrefixOf`) ls + where + ls = map (map toLower) $ lines cabalFile + extract = dropWhile (/=':') >>> dropWhile isSpace >>> takeWhile (not . isSpace) diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs new file mode 100644 index 0000000..84a23aa --- /dev/null +++ b/Distribution/Helper.hs @@ -0,0 +1,278 @@ +-- ghc-mod: Making Haskell development *more* fun +-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org> +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU Affero General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU Affero General Public License for more details. +-- +-- You should have received a copy of the GNU Affero General Public License +-- along with this program. If not, see <http://www.gnu.org/licenses/>. + +{-# LANGUAGE CPP, FlexibleContexts, ConstraintKinds, DeriveDataTypeable #-} +module Distribution.Helper ( + Programs(..) + + -- * Running Queries + , Query + , runQuery + , runKQuery + , runKQuery_ + + -- * Queries against Cabal\'s on disk state + + , entrypoints + , sourceDirs + , ghcOptions + , ghcSrcOptions + , ghcPkgOptions + + -- * Managing @dist/@ + , reconfigure + , writeAutogenFiles + + -- * $libexec related error handling + , LibexecNotFoundError(..) + , libexecNotFoundError + ) where + +import Control.Applicative +import Control.Arrow +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.State.Strict +import Control.Monad.Reader +import Control.Exception +import Data.Monoid +import Data.List +import Data.Default +import Data.Typeable +import System.Environment +import System.FilePath +import System.Directory +import System.Process +import Text.Printf + +import Paths_cabal_helper (getLibexecDir) +import CabalHelper.Types + +-- | Paths or names of various programs we need. +data Programs = Programs { + cabalProgram :: FilePath, + ghcProgram :: FilePath, + ghcPkgProgram :: FilePath + } + +instance Default Programs where + def = Programs "cabal" "ghc" "ghc-pkg" + +data SomeLocalBuildInfo = SomeLocalBuildInfo { + slbiEntrypoints :: [(ChComponentName, ChEntrypoint)], + slbiSourceDirs :: [(ChComponentName, [String])], + slbiGhcOptions :: [(ChComponentName, [String])], + slbiGhcSrcOptions :: [(ChComponentName, [String])], + slbiGhcPkgOptions :: [(ChComponentName, [String])] + } deriving (Eq, Ord, Read, Show) + +-- | Caches helper executable result so it doesn't have to be run more than once +-- as reading in Cabal's @LocalBuildInfo@ datatype from disk is very slow but +-- running all possible queries against it at once is cheap. +newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo) + (ReaderT (Programs, FilePath) m) a } + +type MonadQuery m = ( MonadIO m + , MonadState (Maybe SomeLocalBuildInfo) m + , MonadReader (Programs, FilePath) m) + +run r s action = flip runReaderT r (flip evalStateT s (unQuery action)) + +-- | @runQuery query distdir@. Run a 'Query'. @distdir@ is where Cabal's +-- @setup-config@ file is located. +runQuery :: Monad m + => Query m a + -> FilePath -- ^ Path to @dist/@ + -> m a +runQuery action fp = run (def, fp) Nothing action + +-- | Run a 'Query' as an Arrow by wrapping it in a 'Kleisli' constructor. +runKQuery :: Monad m + => Kleisli (Query m) a b + -> FilePath -- ^ Path to @dist/@ + -> a + -> m b +runKQuery (Kleisli action) fp a = run (def, fp) Nothing (action a) + +-- | Same as 'runKQuery' but pass unit as input to the arrow. +runKQuery_ :: Monad m + => Kleisli (Query m) () b + -> FilePath -- ^ Path to @dist/@ + -> m b +runKQuery_ (Kleisli action) fp = run (def, fp) Nothing (action ()) + +getSlbi :: MonadQuery m => m SomeLocalBuildInfo +getSlbi = do + s <- get + case s of + Nothing -> do + slbi <- getSomeConfigState + put (Just slbi) + return slbi + Just slbi -> return slbi + +-- | Modules or files Cabal would have the compiler build directly. Can be used +-- to compute the home module closure for a component. +entrypoints :: MonadIO m => Query m [(ChComponentName, ChEntrypoint)] + +-- | A component's @source-dirs@ field, beware as if this is empty implicit +-- behaviour in GHC kicks in. +sourceDirs :: MonadIO m => Query m [(ChComponentName, [FilePath])] + +-- | All options cabal would pass to GHC. +ghcOptions :: MonadIO m => Query m [(ChComponentName, [String])] + +-- | Only search path related GHC options. +ghcSrcOptions :: MonadIO m => Query m [(ChComponentName, [String])] + +-- | Only package related GHC options, sufficient for things don't need to +-- access any home modules. +ghcPkgOptions :: MonadIO m => Query m [(ChComponentName, [String])] + +entrypoints = Query $ slbiEntrypoints `liftM` getSlbi +sourceDirs = Query $ slbiSourceDirs `liftM` getSlbi +ghcOptions = Query $ slbiGhcOptions `liftM` getSlbi +ghcSrcOptions = Query $ slbiGhcSrcOptions `liftM` getSlbi +ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi + +-- | Run @cabal configure@ +reconfigure :: MonadIO m + => Programs -- ^ Program paths + -> [String] -- ^ Command line arguments to be passed to @cabal@ + -> m () +reconfigure progs cabalOpts = do + let progOpts = + [ "--with-ghc=" ++ ghcProgram progs ] + -- Only pass ghc-pkg if it was actually set otherwise we + -- might break cabal's guessing logic + ++ if ghcPkgProgram progs /= ghcPkgProgram def + then [ "--with-ghc-pkg=" ++ ghcPkgProgram progs ] + else [] + ++ cabalOpts + _ <- liftIO $ readProcess (cabalProgram progs) ("configure":progOpts) "" + return () + +getSomeConfigState :: MonadQuery m => m SomeLocalBuildInfo +getSomeConfigState = ask >>= \(progs, distdir) -> do + let progArgs = [ "--with-ghc=" ++ ghcProgram progs + , "--with-ghc-pkg=" ++ ghcPkgProgram progs + , "--with-cabal=" ++ cabalProgram progs + ] + + let args = [ "entrypoints" + , "source-dirs" + , "ghc-options" + , "ghc-src-options" + , "ghc-pkg-options" + ] ++ progArgs + + res <- liftIO $ do + exe <- findLibexecExe "cabal-helper-wrapper" + out <- readProcess exe (distdir:args) "" + evaluate (read out) `catch` \(SomeException _) -> + error $ concat ["getSomeConfigState", ": ", exe, " " + , intercalate " " (map show $ distdir:args) + , " (read failed)"] + + let [ Just (ResponseEntrypoints eps), + Just (ResponseStrings srcDirs), + Just (ResponseStrings ghcOpts), + Just (ResponseStrings ghcSrcOpts), + Just (ResponseStrings ghcPkgOpts) ] = res + + return $ SomeLocalBuildInfo eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts + +-- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files +-- in the usual place. +writeAutogenFiles :: MonadIO m + => FilePath -- ^ Path to the @dist/@ directory + -> m () +writeAutogenFiles distdir = liftIO $ do + exe <- findLibexecExe "cabal-helper-wrapper" + callProcess exe [distdir, "write-autogen-files"] + +-- | This exception is thrown by all 'runQuery' functions if the internal +-- wrapper executable cannot be found. You may catch this and present the user +-- an appropriate error message however the default is to print +-- 'libexecNotFoundError'. +data LibexecNotFoundError = LibexecNotFoundError String FilePath + deriving (Typeable) +instance Exception LibexecNotFoundError +instance Show LibexecNotFoundError where + show (LibexecNotFoundError exe dir) = + libexecNotFoundError exe dir "https://github.com/DanielG/cabal-helper/issues" + +findLibexecExe :: String -> IO FilePath +findLibexecExe "cabal-helper-wrapper" = do + libexecdir <- getLibexecDir + let exeName = "cabal-helper-wrapper" + exe = libexecdir </> exeName + + exists <- doesFileExist exe + + if exists + then return exe + else do + mdir <- tryFindCabalHelperTreeLibexecDir + case mdir of + Nothing -> + error $ throw $ LibexecNotFoundError exeName libexecdir + Just dir -> + return $ dir </> "dist" </> "build" </> exeName </> exeName +findLibexecExe exe = error $ "findLibexecExe: Unknown executable: " ++ exe + +tryFindCabalHelperTreeLibexecDir :: IO (Maybe FilePath) +tryFindCabalHelperTreeLibexecDir = do + exe <- getExecutablePath' + dir <- case takeFileName exe of + "ghc" -> do -- we're probably in ghci; try CWD + getCurrentDirectory + _ -> + return $ (!!4) $ iterate takeDirectory exe + exists <- doesFileExist $ dir </> "cabal-helper.cabal" + return $ if exists + then Just dir + else Nothing + +libexecNotFoundError :: String -- ^ Name of the executable we were trying to + -- find + -> FilePath -- ^ Path to @$libexecdir@ + -> String -- ^ URL the user will be directed towards to + -- report a bug. + -> String +libexecNotFoundError exe dir reportBug = printf + ( "Could not find $libexecdir/%s\n" + ++"\n" + ++"If you are a developer set the environment variable\n" + ++"`cabal_helper_libexecdir' to override $libexecdir[1]. The following will\n" + ++"work in the cabal-helper source tree:\n" + ++"\n" + ++" $ export cabal_helper_libexecdir=$PWD/dist/build/%s\n" + ++"\n" + ++"[1]: %s\n" + ++"\n" + ++"If you don't know what I'm talking about something went wrong with your\n" + ++"installation. Please report this problem here:\n" + ++"\n" + ++" %s") exe exe dir reportBug + +getExecutablePath' :: IO FilePath +getExecutablePath' = +#if MIN_VERSION_base(4,6,0) + getExecutablePath +#else + getProgName +#endif @@ -0,0 +1,661 @@ + GNU AFFERO GENERAL PUBLIC LICENSE + Version 3, 19 November 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU Affero General Public License is a free, copyleft license for +software and other kinds of works, specifically designed to ensure +cooperation with the community in the case of network server software. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +our General Public Licenses are intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + Developers that use our General Public Licenses protect your rights +with two steps: (1) assert copyright on the software, and (2) offer +you this License which gives you legal permission to copy, distribute +and/or modify the software. + + A secondary benefit of defending all users' freedom is that +improvements made in alternate versions of the program, if they +receive widespread use, become available for other developers to +incorporate. Many developers of free software are heartened and +encouraged by the resulting cooperation. However, in the case of +software used on network servers, this result may fail to come about. +The GNU General Public License permits making a modified version and +letting the public access it on a server without ever releasing its +source code to the public. + + The GNU Affero General Public License is designed specifically to +ensure that, in such cases, the modified source code becomes available +to the community. It requires the operator of a network server to +provide the source code of the modified version running there to the +users of that server. Therefore, public use of a modified version, on +a publicly accessible server, gives the public access to the source +code of the modified version. + + An older license, called the Affero General Public License and +published by Affero, was designed to accomplish similar goals. This is +a different license, not a version of the Affero GPL, but Affero has +released a new version of the Affero GPL which permits relicensing under +this license. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU Affero General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Remote Network Interaction; Use with the GNU General Public License. + + Notwithstanding any other provision of this License, if you modify the +Program, your modified version must prominently offer all users +interacting with it remotely through a computer network (if your version +supports such interaction) an opportunity to receive the Corresponding +Source of your version by providing access to the Corresponding Source +from a network server at no charge, through some standard or customary +means of facilitating copying of software. This Corresponding Source +shall include the Corresponding Source for any work covered by version 3 +of the GNU General Public License that is incorporated pursuant to the +following paragraph. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the work with which it is combined will remain governed by version +3 of the GNU General Public License. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU Affero General Public License from time to time. Such new versions +will be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU Affero General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU Affero General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU Affero General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. + +Also add information on how to contact you by electronic and paper mail. + + If your software can interact with users remotely through a computer +network, you should also make sure that it provides a way for users to +get its source. For example, if your program is a web application, its +interface could display a "Source" link that leads users to an archive +of the code. There are many ways you could offer source, and different +solutions will be better for different programs; see section 13 for the +specific requirements. + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU AGPL, see +<http://www.gnu.org/licenses/>. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..05a0ae1 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,70 @@ +#!/usr/bin/env runhaskell +{-# LANGUAGE RecordWildCards #-} +import Distribution.Simple +import Distribution.Simple.Setup +import Distribution.Simple.Install +import Distribution.Simple.InstallDirs as ID +import Distribution.Simple.LocalBuildInfo +import Distribution.PackageDescription + +import Control.Applicative +import Data.List +import Data.Maybe +import System.FilePath + +main :: IO () +main = defaultMainWithHooks $ simpleUserHooks { copyHook = xInstallTargetHook } + +xInstallTargetHook :: + PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () +xInstallTargetHook pd lbi _uh cf = do + let (extended, regular) = partition (isJust . installTarget) (executables pd) + + let pd_regular = pd { executables = regular } + + _ <- flip mapM extended $ \exe -> do + putStrLn $ "extended " ++ show (exeName exe) + + let + idirtpl = installDirTemplates lbi + env = installDirsTemplateEnv idirtpl + libexecdir' = fromPathTemplate (libexecdir idirtpl) + + pd_extended = onlyExePackageDesc [exe] pd + install_target = fromJust $ installTarget exe + install_target' = ID.substPathTemplate env install_target + -- $libexec isn't a real thing :/ so we have to simulate it + install_target'' = substLibExec' libexecdir' install_target' + + let lbi' = lbi { + installDirTemplates = + (installDirTemplates lbi) { + bindir = install_target'' + } + } + + install pd_extended lbi' cf + + install pd_regular lbi cf + + where + installTarget :: Executable -> Maybe PathTemplate + installTarget exe = + toPathTemplate <$> lookup "x-install-target" (customFieldsBI $ buildInfo exe) + + substLibExec libexecdir "$libexecdir" = libexecdir + substLibExec _ comp = comp + + substLibExec' dir = + withPT $ + withSP $ map (substLibExec dir . dropTrailingPathSeparator) + + + withPT f pt = toPathTemplate $ f (fromPathTemplate pt) + withSP f p = joinPath $ f (splitPath p) + +onlyExePackageDesc :: [Executable] -> PackageDescription -> PackageDescription +onlyExePackageDesc exes pd = emptyPackageDescription { + package = package pd + , executables = exes + } diff --git a/cabal-helper.cabal b/cabal-helper.cabal new file mode 100644 index 0000000..5b74af5 --- /dev/null +++ b/cabal-helper.cabal @@ -0,0 +1,67 @@ +name: cabal-helper +version: 0.1.0.0 +synopsis: Simple interface to Cabal's configuration state used by ghc-mod +description: + CabalHelper provides a library which wraps the internal use of executables + to lift the restrictions imposed by linking against versions of GHC before + @7.10@. + + CabalHelper uses a wrapper executable to compile the actual cabal-helper + executable at runtime while linking against an arbitrary version of + Cabal. This runtime-compiled helper executable is then used to extract + various bits and peices from Cabal on disk state (dist/setup-config) written + by it's configure command. + + In addition to this the wrapper executable also supports installing any + version of Cabal from hackage in case it cannot be found in any available + package database. The wrapper installs these instances of the Cabal library + into a private package database so as to not interfere with the user's + packages. + + Furthermore the wrapper supports one special case namely reading a state + file for Cabal itself. This is needed as Cabal compiles it's Setup.hs using + itself and not using any version of Cabal installed in any package database. + + Currently CabalHelper supports @Cabal >= 1.16@. + +license: AGPL-3 +license-file: LICENSE +author: Daniel Gröber <dxld@darkboxed.org> +maintainer: dxld@darkboxed.org +category: Distribution +build-type: Simple +cabal-version: >=1.10 + +source-repository head + type: git + location: https://github.com/DanielG/cabal-helper.git + +library + exposed-modules: Distribution.Helper + build-depends: base >= 4.5 && < 5 + default-language: Haskell2010 + Build-Depends: base + , data-default + , directory + , filepath + , transformers + , mtl + , process + + +Executable cabal-helper-wrapper + Default-Language: Haskell2010 + Other-Extensions: TemplateHaskell + Main-Is: CabalHelper/Wrapper.hs + Other-Modules: Paths_cabal_helper + GHC-Options: -Wall + X-Install-Target: $libexecdir + Build-Depends: base >= 4.5 && < 5 + , bytestring + , Cabal + , directory + , filepath + , process + , transformers + , template-haskell + , temporary |