A few fixes and add --verbose

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 ()