aboutsummaryrefslogtreecommitdiff
path: root/CabalHelper/Wrapper.hs
diff options
context:
space:
mode:
Diffstat (limited to 'CabalHelper/Wrapper.hs')
-rw-r--r--CabalHelper/Wrapper.hs122
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 ()