Move package-id to wrapper

we need it before dist/setup-config exists so we can't run it as part of
the other queries anyways, might as well go in the wrapper.

3 files changed, 22 insertions, 15 deletions

diff --git a/CabalHelper/Common.hs b/CabalHelper/Common.hs
index 3a6d4b6..154441e 100644
--- a/CabalHelper/Common.hs
+++ b/CabalHelper/Common.hs
@@ -86,3 +86,12 @@ runReadP p i = case filter ((=="") . snd) $ readP_to_S p i of
 
 appDataDir :: IO FilePath
 appDataDir = (</> "cabal-helper") <$> getAppUserDataDirectory "ghc-mod"
+
+isCabalFile :: FilePath -> Bool
+isCabalFile f = takeExtension' f == ".cabal"
+
+takeExtension' :: FilePath -> String
+takeExtension' p =
+    if takeFileName p == takeExtension p
+      then "" -- just ".cabal" is not a valid cabal file
+      else takeExtension p
diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs
index 48a6ed4..59c3e91 100644
--- a/CabalHelper/Main.hs
+++ b/CabalHelper/Main.hs
@@ -145,7 +145,6 @@ main = do
          errMsg $ "distdir '"++distdir++"' does not exist"
          exitFailure
 
-  -- ghc-mod will catch multiple cabal files existing before we get here
   [cfile] <- filter isCabalFile <$> getDirectoryContents projdir
 
   v <- maybe silent (const deafening) . lookup  "GHC_MOD_DEBUG" <$> getEnvironment
@@ -180,10 +179,6 @@ main = do
 
   print =<< flip mapM cmds $$ \cmd -> do
   case cmd of
-    "package-id":[] ->
-      return $ Just $
-        ChResponseVersion (display (packageName pd)) (packageVersion pd)
-
     "flags":[] -> do
       return $ Just $ ChResponseFlags $ sort $
         map (flagName' &&& flagDefault) $ genPackageFlags gpd
@@ -441,12 +436,3 @@ renderGhcOptions' lbi v opts = do
 #else
   return $ renderGhcOptions (compiler lbi) opts
 #endif
-
-isCabalFile :: FilePath -> Bool
-isCabalFile f = takeExtension' f == ".cabal"
-
-takeExtension' :: FilePath -> String
-takeExtension' p =
-    if takeFileName p == takeExtension p
-      then "" -- just ".cabal" is not a valid cabal file
-      else takeExtension p
diff --git a/CabalHelper/Wrapper.hs b/CabalHelper/Wrapper.hs
index 5cd3ef8..1987e6c 100644
--- a/CabalHelper/Wrapper.hs
+++ b/CabalHelper/Wrapper.hs
@@ -35,6 +35,9 @@ 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.Common
@@ -56,7 +59,7 @@ usage = do
 \  [--with-cabal=CABAL_PATH]\n\
 \  [--with-cabal-version=VERSION]\n\
 \  [--with-cabal-pkg-db=PKG_DB]\n\
-\  PROJ_DIR DIST_DIR ( print-exe | [CABAL_HELPER_ARGS...] ) )\n"
+\  PROJ_DIR DIST_DIR ( print-exe | package-id | [CABAL_HELPER_ARGS...] ) )\n"
 
 globalArgSpec :: [OptDescr (Options -> Options)]
 globalArgSpec =
@@ -116,6 +119,15 @@ main = handlePanic $ do
     "version":[] -> putStrLn $ showVersion version
     "print-appdatadir":[] -> putStrLn =<< appDataDir
     "print-build-platform":[] -> putStrLn $ display buildPlatform
+
+    projdir:_distdir:"package-id":[] -> do
+      v <- maybe silent (const deafening) . lookup  "GHC_MOD_DEBUG" <$> getEnvironment
+      -- 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)) (packageVersion gpd)]
+
     projdir:distdir:args' -> do
       cfgf <- canonicalizePath (distdir </> "setup-config")
       mhdr <- getCabalConfigHeader cfgf