diff options
| -rw-r--r-- | cabal-helper.cabal | 1 | ||||
| -rw-r--r-- | lib/Distribution/Helper.hs | 2 | ||||
| -rw-r--r-- | lib/Distribution/Helper/Discover.hs | 70 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Cabal.hs | 17 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Compat/Directory.hs | 26 | ||||
| -rw-r--r-- | src/CabalHelper/Compiletime/Program/CabalInstall.hs | 2 |
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 |