diff options
Diffstat (limited to 'src/CabalHelper/Compiletime/Wrapper.hs')
| -rw-r--r-- | src/CabalHelper/Compiletime/Wrapper.hs | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/src/CabalHelper/Compiletime/Wrapper.hs b/src/CabalHelper/Compiletime/Wrapper.hs new file mode 100644 index 0000000..6713944 --- /dev/null +++ b/src/CabalHelper/Compiletime/Wrapper.hs @@ -0,0 +1,164 @@ +-- 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.Monad +import Data.Char +import Data.List +import Data.Maybe +import Data.String +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 Prelude + +import Distribution.System (buildPlatform) +import Distribution.Text (display) +import Distribution.Verbosity (silent, deafening) +import Distribution.PackageDescription.Parse (readPackageDescription) +import Distribution.Package (packageName, packageVersion) + +import Paths_cabal_helper (version) +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 + +usage :: IO () +usage = do + prog <- getProgName + hPutStr stderr $ "Usage: " ++ prog ++ " " ++ usageMsg + where + usageMsg = "\ +\( print-appcachedir\n\ +\| print-build-platform\n\ +\| [--verbose]\n\ +\ [--with-ghc=GHC_PATH]\n\ +\ [--with-ghc-pkg=GHC_PKG_PATH]\n\ +\ [--with-cabal=CABAL_PATH]\n\ +\ [--with-cabal-version=VERSION]\n\ +\ [--with-cabal-pkg-db=PKG_DB]\n\ +\ PROJ_DIR DIST_DIR ( print-exe | package-id | [CABAL_HELPER_ARGS...] ) )\n" + +globalArgSpec :: [OptDescr (Options -> Options)] +globalArgSpec = + [ option "" ["verbose"] "Be more verbose" $ + NoArg $ \o -> o { verbose = True } + + , 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 } + + , option "" ["with-cabal-version"] "Cabal library version to use" $ + reqArg "VERSION" $ \p o -> o { cabalVersion = Just $ parseVer p } + + , option "" ["with-cabal-pkg-db"] "package database to look for Cabal library in" $ + reqArg "PKG_DB" $ \p o -> o { cabalPkgDb = Just (PackageDbDir 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 RequireOrder globalArgSpec argv of + (o,r,[]) -> (foldr id opts o, r) + (_,_,errs) -> + panic $ "Parsing command options failed:\n" ++ 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 + +overrideVerbosityEnvVar :: Options -> IO Options +overrideVerbosityEnvVar opts = do + x <- lookup "CABAL_HELPER_DEBUG" <$> getEnvironment + return $ case x of + Just _ -> opts { verbose = True } + Nothing -> opts + +main :: IO () +main = handlePanic $ do + (opts', args) <- parseCommandArgs defaultOptions <$> getArgs + opts <- overrideVerbosityEnvVar =<< guessProgramPaths opts' + case args of + [] -> usage + "help":[] -> usage + "version":[] -> putStrLn $ showVersion version + "print-appdatadir":[] -> putStrLn =<< appCacheDir + "print-appcachedir":[] -> putStrLn =<< appCacheDir + "print-build-platform":[] -> putStrLn $ display buildPlatform + + projdir:_distdir:"package-id":[] -> do + let v | verbose opts = deafening + | otherwise = silent + -- ghc-mod will catch multiple cabal files existing before we get here + [cfile] <- filter isCabalFile <$> getDirectoryContents projdir + gpd <- readPackageDescription v (projdir </> cfile) + putStrLn $ show $ + [Just $ ChResponseVersion (display (packageName gpd)) (toDataVersion $ packageVersion gpd)] + + projdir: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, _) -> do + case cabalVersion opts of + Just ver | hdrCabalVersion /= ver -> panic $ printf "\ +\Cabal version %s was requested but setup configuration was\n\ +\written by version %s" (showVersion ver) (showVersion hdrCabalVersion) + _ -> do + eexe <- compileHelper opts hdrCabalVersion projdir 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 + _ -> error "invalid command line" |