Flesh out project discovery API

6 files changed, 63 insertions, 55 deletions

diff --git a/cabal-helper.cabal b/cabal-helper.cabal
index cb43f72..9cc7215 100644
--- a/cabal-helper.cabal
+++ b/cabal-helper.cabal
@@ -131,7 +131,6 @@ library c-h-internal
   import:             build-deps, extensions
   exposed-modules:
                        CabalHelper.Compiletime.Cabal
-                       CabalHelper.Compiletime.Compat.Directory
                        CabalHelper.Compiletime.Compat.Environment
                        CabalHelper.Compiletime.Compat.ProgramDb
                        CabalHelper.Compiletime.Compat.Version
diff --git a/lib/Distribution/Helper.hs b/lib/Distribution/Helper.hs
index c290d41..c7689f9 100644
--- a/lib/Distribution/Helper.hs
+++ b/lib/Distribution/Helper.hs
@@ -215,7 +215,7 @@ mkQueryEnv projloc distdir = do
 -- | Construct paths to project configuration files given where the project is.
 projConf :: ProjLoc pt -> IO (ProjConf pt)
 projConf (ProjLocV1Dir pkgdir) =
-  ProjConfV1 <$> findCabalFile pkgdir
+  ProjConfV1 <$> (complainIfNoCabalFile pkgdir =<< findCabalFile pkgdir)
 projConf (ProjLocV1CabalFile cabal_file _) = return $
   ProjConfV1 cabal_file
 projConf (ProjLocV2Dir projdir_path) =
diff --git a/lib/Distribution/Helper/Discover.hs b/lib/Distribution/Helper/Discover.hs
index b074261..9e6a7ca 100644
--- a/lib/Distribution/Helper/Discover.hs
+++ b/lib/Distribution/Helper/Discover.hs
@@ -14,7 +14,7 @@
 -- You should have received a copy of the GNU General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GADTs, TypeFamilies, DataKinds #-}
 
 {-|
 Module      : Distribution.Helper.Discover
@@ -28,23 +28,30 @@ Portability : portable
 
 module Distribution.Helper.Discover
   ( findProjects
-  , findDistDirs
-  , findDistDirsWithHints
+  , getDefaultDistDir
+  , isValidDistDir
   ) where
 
 import Control.Monad.Writer
-import Data.List
 import System.Directory
 import System.FilePath
 
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Cabal
-import CabalHelper.Compiletime.Compat.Directory
 
+-- | @findProjects dir@. Find available project instances in @dir@.
+--
+-- For example, if the given directory contains both a @cabal.project@ and
+-- a @stack.yaml@ file:
+--
+-- >>> findProjects "."
+-- [ Ex (ProjLocStackYaml "./stack.yaml"), Ex (ProjLocCabalV2File "./cabal.project") ]
+--
+-- Note that this function only looks for "default" project markers. If you
+-- want to for example support the common pattern of having multiple
+-- @stack-<GHC_VER>.yaml@ files simply fill out a 'ProjLoc' yourself. In
+-- this case 'ProjLocStackYaml'.
 findProjects :: FilePath -> IO [Ex ProjLoc]
-findDistDirs :: ProjLoc pt -> [DistDir pt]
-findDistDirsWithHints :: ProjLoc pt -> [FilePath] -> [DistDir pt]
-
 findProjects dir = execWriterT $ do
   let cabalProject = dir </> "cabal.project"
   whenM (liftIO $ doesFileExist cabalProject) $
@@ -53,23 +60,42 @@ findProjects dir = execWriterT $ do
   whenM (liftIO $ doesFileExist stackYaml) $
     tell [Ex $ ProjLocStackYaml stackYaml]
   join $ traverse (tell . pure . Ex . ProjLocV1Dir . takeDirectory) <$>
-    liftIO (findCabalFiles dir)
+    liftIO (findCabalFile dir)
 
-findDistDirs (ProjLocV1CabalFile cabal _) =
-  [DistDirCabal SCV1 $ replaceFileName cabal "dist/"]
-findDistDirs (ProjLocV1Dir dir) = [DistDirCabal SCV1 $ dir </> "dist/"]
-findDistDirs (ProjLocV2File cabal) =
-  [DistDirCabal SCV2 $ replaceFileName cabal "dist-newstyle/"]
-findDistDirs (ProjLocV2Dir dir) = [DistDirCabal SCV2 $ dir </> "dist-newstyle/"]
-findDistDirs (ProjLocStackYaml _) = [DistDirStack Nothing]
 
-findDistDirsWithHints = undefined
+-- | @getDefaultDistDir pl@. Get the default dist-dir for the given project.
+--
+-- Note that the path in the returned dist-dir might not exist yet if the
+-- build-tool has never been run for this project before. This is fine as
+-- far as @cabal-helper@ is concerned. It will simply invoke the build-tool
+-- as needed to answer the requested queries.
+getDefaultDistDir :: ProjLoc pt -> DistDir pt
+getDefaultDistDir (ProjLocV1CabalFile _cabal_file pkgdir) =
+  DistDirCabal SCV1 $ pkgdir </> "dist"
+getDefaultDistDir (ProjLocV1Dir pkgdir) =
+  DistDirCabal SCV1 $ pkgdir </> "dist"
+getDefaultDistDir (ProjLocV2File cabal_project) =
+  DistDirCabal SCV2 $ replaceFileName cabal_project "dist-newstyle"
+getDefaultDistDir (ProjLocV2Dir projdir) =
+  DistDirCabal SCV2 $ projdir </> "dist-newstyle"
+getDefaultDistDir (ProjLocStackYaml _) =
+  DistDirStack Nothing
+
+-- | @isValidDistDir distdir@. Check if @distdir@ looks like a valid
+-- build-dir for it's project type. We just check if characteristic marker
+-- files for the associated project type exist.
+--
+-- If the project type does not have a way to do this (for example
+-- 'DistDirStack') check we return 'Nothing'.
+isValidDistDir :: DistDir pt -> IO (Maybe Bool)
+isValidDistDir (DistDirCabal cpt dir) = do
+  fmap Just $ doesFileExist $ dir </> cabalProjTypeMarkerFile cpt
+isValidDistDir DistDirStack{} =
+  return Nothing
 
-findCabalFiles :: FilePath -> IO [FilePath]
-findCabalFiles dir = do
-  fs <- listDirectory dir
-  let cs = filter (".cabal" `isSuffixOf`) fs
-  filterM doesFileExist cs
+cabalProjTypeMarkerFile :: SCabalProjType pt -> FilePath
+cabalProjTypeMarkerFile SCV1 = "setup-config"
+cabalProjTypeMarkerFile SCV2 = "cache" </> "plan.json"
 
 whenM :: Monad m => m Bool -> m () -> m ()
 whenM p x = p >>= (`when` x)
diff --git a/src/CabalHelper/Compiletime/Cabal.hs b/src/CabalHelper/Compiletime/Cabal.hs
index 17f4d7f..85ab83c 100644
--- a/src/CabalHelper/Compiletime/Cabal.hs
+++ b/src/CabalHelper/Compiletime/Cabal.hs
@@ -43,7 +43,7 @@ import qualified Data.ByteString.Char8 as BS8
 
 import CabalHelper.Compiletime.Types
 import CabalHelper.Compiletime.Process
-import CabalHelper.Shared.Common (replace, parseVer, parseVerMay, parsePkgIdBS)
+import CabalHelper.Shared.Common (replace, parseVer, parseVerMay, parsePkgIdBS, panicIO)
 
 type UnpackedCabalVersion = CabalVersion' (CommitId, CabalSourceDir)
 type ResolvedCabalVersion = CabalVersion' CommitId
@@ -246,10 +246,14 @@ resolveCabalVersion (CabalHEAD ()) = do
   let commit = takeWhile isHexDigit out
   return $ CabalHEAD $ CommitId commit
 
-findCabalFile :: FilePath -> IO FilePath
+findCabalFile :: FilePath -> IO (Maybe FilePath)
 findCabalFile pkgdir = do
-    [cfile] <- filter isCabalFile <$> getDirectoryContents pkgdir
-    return $ pkgdir </> cfile
+    cfiles <- filter isCabalFile <$> getDirectoryContents pkgdir
+    case cfiles of
+      [] -> return Nothing
+      [cfile] -> return $ Just $ pkgdir </> cfile
+      _ -> panicIO $ "Multiple cabal-files found in directory '"
+             ++pkgdir++"': " ++ show cfiles
   where
     isCabalFile :: FilePath -> Bool
     isCabalFile f = takeExtension' f == ".cabal"
@@ -260,6 +264,11 @@ findCabalFile pkgdir = do
           then "" -- just ".cabal" is not a valid cabal file
           else takeExtension p
 
+complainIfNoCabalFile :: FilePath -> Maybe FilePath -> IO FilePath
+complainIfNoCabalFile _ (Just cabal_file) = return cabal_file
+complainIfNoCabalFile pkgdir Nothing =
+  panicIO $ "No cabal file found in package-dir: '"++pkgdir++"'"
+
 bultinCabalVersion :: Version
 bultinCabalVersion = parseVer VERSION_Cabal
 
diff --git a/src/CabalHelper/Compiletime/Compat/Directory.hs b/src/CabalHelper/Compiletime/Compat/Directory.hs
deleted file mode 100644
index 0a65164..0000000
--- a/src/CabalHelper/Compiletime/Compat/Directory.hs
+++ /dev/null
@@ -1,26 +0,0 @@
--- cabal-helper: Simple interface to Cabal's configuration state
--- Copyright (C) 2019  Daniel Gröber <cabal-helper@dxld.at>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU 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 General Public License for more details.
---
--- You should have received a copy of the GNU General Public License
--- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-{-# LANGUAGE CPP #-}
-module CabalHelper.Compiletime.Compat.Directory where
-
-import System.Directory (getDirectoryContents)
-
-#if !MIN_VERSION_directory(1,2,5)
-listDirectory :: FilePath -> IO [FilePath]
-listDirectory path =
-  filter (\f -> f /= "." && f /= "..") <$> getDirectoryContents path
-#endif
diff --git a/src/CabalHelper/Compiletime/Program/CabalInstall.hs b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
index b1c661c..4411bc3 100644
--- a/src/CabalHelper/Compiletime/Program/CabalInstall.hs
+++ b/src/CabalHelper/Compiletime/Program/CabalInstall.hs
@@ -261,7 +261,7 @@ planUnits plan = do
       , uComps=comps
       , uPId=CP.PkgId pkg_name _
       } = do
-        cabal_file <- Cabal.findCabalFile pkgdir
+        cabal_file <- Cabal.complainIfNoCabalFile pkgdir =<< Cabal.findCabalFile pkgdir
         let comp_names = Map.keys comps
         let uiV2Components =
               map (Text.unpack . CP.dispCompNameTarget pkg_name) $ Map.keys comps