diff options
| -rw-r--r-- | CabalHelper/Wrapper.hs | 122 |
1 files changed, 92 insertions, 30 deletions
diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs index e320f96..4dab55f 100644 --- a/CabalHelper/Wrapper.hs +++ b/CabalHelper/Wrapper.hs @@ -23,6 +23,7 @@ import Control.Exception as E import Control.Monad import Control.Monad.Trans.Maybe import Control.Monad.IO.Class +import Data.Traversable (traverse) import Data.Char import Data.List import Data.Maybe @@ -53,20 +54,28 @@ usage = do usageMsg = "\ \( print-appdatadir\n\ \| print-build-platform\n\ -\| DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n" +\| [--verbose]\n\ +\ [--with-ghc=GHC_PATH]\n\ +\ [--with-ghc-pkg=GHC_PKG_PATH]\n\ +\ [--with-cabal=CABAL_PATH]\n\ +\ DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n" data Options = Options { - ghcProgram :: FilePath + verbose :: Bool + , ghcProgram :: FilePath , ghcPkgProgram :: FilePath , cabalProgram :: FilePath } defaultOptions :: Options -defaultOptions = Options "ghc" "ghc-pkg" "cabal" +defaultOptions = Options False "ghc" "ghc-pkg" "cabal" globalArgSpec :: [OptDescr (Options -> Options)] globalArgSpec = - [ option "" ["with-ghc"] "GHC executable to use" $ + [ 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)" $ @@ -84,10 +93,10 @@ globalArgSpec = parseCommandArgs :: Options -> [String] -> (Options, [String]) parseCommandArgs opts argv - = case getOpt Permute globalArgSpec argv of + = case getOpt RequireOrder globalArgSpec argv of (o,r,[]) -> (foldr id opts o, r) (_,_,errs) -> - panic $ "Parsing command options failed: " ++ concat errs + panic $ "Parsing command options failed:\n" ++ concat errs guessProgramPaths :: Options -> IO Options guessProgramPaths opts = do @@ -135,16 +144,22 @@ 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) + run [ compileCabalSource chdir -- TODO: here ghc's caching fails and it always + -- recompiles, probably because we write the + -- sources to a tempdir and they always look + -- newer than the Cabal sources, not sure if we + -- can fix this + , Right <$> MaybeT (cachedExe cabalVer) , compileGlobal chdir , cachedCabalPkg chdir - , compileCabalSource chdir , MaybeT (Just <$> compileSandbox chdir) ] where run actions = fromJust <$> runMaybeT (msum actions) + logMsg = "compiling helper with Cabal from " + -- | Check if this version is globally available compileGlobal :: FilePath -> MaybeT IO (Either ExitCode FilePath) compileGlobal chdir = do @@ -152,6 +167,7 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do -- using a Cabal compiled from git! ver <- MaybeT $ find (sameMajorVersionAs cabalVer) . reverse . sort <$> listCabalVersions opts + vLog opts $ logMsg ++ "user/global package-db" liftIO $ compileWithPkg chdir Nothing ver -- | Check if we already compiled this version of cabal into a private @@ -164,6 +180,7 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do True -> do db <- liftIO $ cabalPkgDb opts cabalVer vers <- MaybeT $ find (sameMajorVersionAs cabalVer) . reverse . sort <$> listCabalVersions' opts (Just db) + vLog opts $ logMsg ++ "private package-db in " ++ db liftIO $ compileWithPkg chdir (Just db) vers -- | See if we're in a cabal source tree @@ -171,11 +188,20 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do compileCabalSource chdir = do let couldBeSrcDir = takeDirectory distdir cabalFile = couldBeSrcDir </> "Cabal.cabal" - cabal <- liftIO $ doesFileExist cabalFile - case cabal of + isCabalMagicVer = cabalVer == Version [1,9999] [] + cabalSrc <- liftIO $ doesFileExist cabalFile + + when isCabalMagicVer $ + vLog opts $ "cabal magic version (1.9999) found" + + when cabalSrc $ + vLog opts $ "directory above distdir looks like cabal source tree (Cabal.cabal exists)" + + case isCabalMagicVer || cabalSrc of False -> mzero True -> liftIO $ do ver <- cabalFileVersion <$> readFile cabalFile + vLog opts $ "compiling helper with local Cabal source tree" compileWithCabalTree chdir ver couldBeSrcDir -- | Compile the requested cabal version into an isolated package-db @@ -185,12 +211,11 @@ compileHelper opts cabalVer distdir = withHelperSources $ \chdir -> do \(SomeException _) -> errorInstallCabal cabalVer distdir compileWithPkg chdir (Just db) cabalVer - compileWithCabalTree chdir ver srcDir = - compile opts $ Compile chdir (Just srcDir) Nothing ver [] + compile distdir opts $ Compile chdir (Just srcDir) Nothing ver [] compileWithPkg chdir mdb ver = - compile opts $ Compile chdir Nothing mdb ver [cabalPkgId ver] + compile distdir opts $ Compile chdir Nothing mdb ver [cabalPkgId ver] cabalPkgId v = "Cabal-" ++ showVersion v @@ -238,11 +263,22 @@ data Compile = Compile { packageDeps :: [String] } -compile :: Options -> Compile -> IO (Either ExitCode FilePath) -compile Options {..} Compile {..} = do - outdir <- appDataDir - createDirectoryIfMissing True outdir - exe <- exePath cabalVersion +compile :: FilePath -> Options -> Compile -> IO (Either ExitCode FilePath) +compile distdir opts@Options {..} Compile {..} = do + cCabalSourceDir <- canonicalizePath `traverse` cabalSourceDir + appdir <- appDataDir + + let outdir' = maybe appdir (const $ distdir </> "cabal-helper") cCabalSourceDir + createDirectoryIfMissing True outdir' + outdir <- canonicalizePath outdir' + + let exedir' = maybe outdir (const distdir) cCabalSourceDir + createDirectoryIfMissing True exedir' + exedir <- canonicalizePath exedir' + exe <- exePath' cabalVersion <$> canonicalizePath exedir + + vLog opts $ "outdir: " ++ outdir + vLog opts $ "exedir: " ++ exedir let Version (mj:mi:_) _ = cabalVersion let ghc_opts = @@ -254,11 +290,24 @@ compile Options {..} Compile {..} = do , "-optP-DCABAL_MINOR=" ++ show mi ], maybeToList $ ("-package-conf="++) <$> packageDb, - map ("-i"++) $ ".":maybeToList cabalSourceDir, + map ("-i"++) $ nub $ ".":maybeToList cCabalSourceDir, + + if isNothing cCabalSourceDir + then [ "-hide-all-packages" + , "-package", "base" + , "-package", "directory" + , "-package", "filepath" + , "-package", "process" + , "-package", "bytestring" + ] + else [], + concatMap (\p -> ["-package", p]) packageDeps, [ "--make", "CabalHelper/Main.hs" ] ] + vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ ghcProgram:ghc_opts + -- TODO: touch exe after, ghc doesn't do that if the input files didn't -- actually change rv <- callProcessStderr' (Just cabalHelperSourceDir) ghcProgram ghc_opts @@ -268,9 +317,12 @@ compile Options {..} Compile {..} = do exePath :: Version -> IO FilePath exePath cabalVersion = do - outdir <- appDataDir - return $ outdir </> "cabal-helper-" ++ showVersion version -- our ver - ++ "-Cabal-" ++ showVersion (majorVer cabalVersion) + exePath' cabalVersion <$> appDataDir + +exePath' :: Version-> FilePath -> FilePath +exePath' cabalVersion outdir = + outdir </> "cabal-helper-" ++ showVersion version -- our ver + ++ "-Cabal-" ++ showVersion (majorVer cabalVersion) cachedExe :: Version -> IO (Maybe FilePath) cachedExe cabalVersion = do @@ -313,16 +365,15 @@ installCabal opts ver = do \version %s of Cabal manually (into your user or global package-db):\n\ \ $ cabal install Cabal --constraint \"Cabal == %s\"\n\ \\n\ -\Building Cabal %s...\n" appdir sdep sdep sdep +\Building Cabal %s ...\n" appdir sdep sdep sdep db <- createPkgDb opts ver - callProcessStderr (Just "/") (cabalProgram opts) $ concat + cabal_opts <- return $ concat [ [ "--package-db=clear" , "--package-db=global" , "--package-db=" ++ db , "--prefix=" ++ db </> "prefix" - , "-v0" , "--with-ghc=" ++ ghcProgram opts ] , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions @@ -331,6 +382,10 @@ installCabal opts ver = do , [ "install", "Cabal", "--constraint" , "Cabal == " ++ showVersion (majorVer ver) ++ ".*" ] ] + + vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ cabalProgram opts:cabal_opts + + callProcessStderr (Just "/") (cabalProgram opts) cabal_opts hPutStrLn stderr "done" return db @@ -340,7 +395,7 @@ ghcVersion Options {..} = do ghcPkgVersion :: Options -> IO Version ghcPkgVersion Options {..} = do - parseVer . trim <$> readProcess ghcPkgProgram ["--numeric-version"] "" + parseVer . trim . dropWhile (not . isDigit) <$> readProcess ghcPkgProgram ["--version"] "" trim :: String -> String trim = dropWhileEnd isSpace @@ -361,12 +416,14 @@ cabalPkgDb opts ver = do cabalPkgDbExists :: Options -> Version -> IO Bool cabalPkgDbExists opts ver = do db <- cabalPkgDb opts ver + print db dexists <- doesDirectoryExist db case dexists of False -> return False True -> do vers <- listCabalVersions' opts (Just db) - return $ ver `elem` vers + print vers + return $ isJust $ find (sameMajorVersionAs ver) $ reverse $ sort $ vers listCabalVersions :: Options -> IO [Version] listCabalVersions opts = listCabalVersions' opts Nothing @@ -382,8 +439,13 @@ listCabalVersions' Options {..} mdb = do -- | Find @version: XXX@ delcaration in a cabal file cabalFileVersion :: String -> Version -cabalFileVersion cabalFile = do - fromJust $ parseVer . extract <$> find ("version" `isPrefixOf`) ls +cabalFileVersion cabalFile = + fromJust $ parseVer . extract <$> find ("version:" `isPrefixOf`) ls where ls = map (map toLower) $ lines cabalFile - extract = dropWhile (/=':') >>> dropWhile isSpace >>> takeWhile (not . isSpace) + extract = dropWhile (/=':') >>> drop 1 >>> dropWhile isSpace >>> takeWhile (not . isSpace) + +vLog :: MonadIO m => Options -> String -> m () +vLog Options { verbose = True } msg = + liftIO $ hPutStrLn stderr msg +vLog _ _ = return () |