-- |Description: Utilities for extracting cabal info to the canonical types in "Data.Prune.Types".
{-# LANGUAGE CPP #-}
module Data.Prune.Cabal where

import Prelude

import Cabal.Project (prjPackages, readProject)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (MonadLogger, logDebug)
import Data.Maybe (maybeToList)
import Data.Prune.File (listFilesRecursive)
import Data.Set (Set)
import Data.Text (Text, pack)
import Data.Traversable (for)
import Distribution.PackageDescription.Parsec (readGenericPackageDescription)
import Distribution.Types.Benchmark (Benchmark)
import Distribution.Types.BuildInfo (BuildInfo)
import Distribution.Types.CondTree (CondTree)
import Distribution.Types.Dependency (Dependency)
import Distribution.Types.Executable (Executable)
import Distribution.Types.Library (Library)
import Distribution.Types.TestSuite (TestSuite)
import Distribution.Types.UnqualComponentName (UnqualComponentName)
import System.Directory (listDirectory)
import System.FilePath.Posix ((</>), isExtensionOf, takeDirectory, takeFileName)
import qualified Data.Set as Set
import qualified Distribution.Types.Benchmark as Benchmark
import qualified Distribution.Types.BenchmarkInterface as BenchmarkInterface
import qualified Distribution.Types.BuildInfo as BuildInfo
import qualified Distribution.Types.CondTree as CondTree
import qualified Distribution.Types.Executable as Executable
import qualified Distribution.Types.GenericPackageDescription as GenericPackageDescription
import qualified Distribution.Types.Library as Library
import qualified Distribution.Types.PackageDescription as PackageDescription
import qualified Distribution.Types.PackageId as PackageId
import qualified Distribution.Types.PackageName as PackageName
import qualified Distribution.Types.TestSuite as TestSuite
import qualified Distribution.Types.TestSuiteInterface as TestSuiteInterface
import qualified Distribution.Types.UnqualComponentName as UnqualComponentName
#if MIN_VERSION_Cabal(3,6,0)
import qualified Distribution.Utils.Path as UtilsPath
#endif
import qualified Distribution.Verbosity as Verbosity

import qualified Data.Prune.Types as T

-- |Get the dependencies for a thing to compile.
getDependencyNames :: Set T.DependencyName -> [Dependency] -> Set T.DependencyName
getDependencyNames :: Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores = (Set DependencyName -> Set DependencyName -> Set DependencyName)
-> Set DependencyName -> Set DependencyName -> Set DependencyName
forall a b c. (a -> b -> c) -> b -> a -> c
flip Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Ord a => Set a -> Set a -> Set a
Set.difference Set DependencyName
ignores (Set DependencyName -> Set DependencyName)
-> ([Dependency] -> Set DependencyName)
-> [Dependency]
-> Set DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DependencyName] -> Set DependencyName
forall a. Ord a => [a] -> Set a
Set.fromList ([DependencyName] -> Set DependencyName)
-> ([Dependency] -> [DependencyName])
-> [Dependency]
-> Set DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> DependencyName) -> [Dependency] -> [DependencyName]
forall a b. (a -> b) -> [a] -> [b]
map Dependency -> DependencyName
T.mkDependencyName

-- |Get the Haskell source files to compile.
getSourceFiles :: FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles :: FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles FilePath
fp Maybe FilePath
mainMay BuildInfo
buildInfo = do
  let hsSourceDirs :: [SymbolicPath PackageDir SourceDir]
hsSourceDirs = BuildInfo -> [SymbolicPath PackageDir SourceDir]
BuildInfo.hsSourceDirs BuildInfo
buildInfo
  Set FilePath
allFiles <- case [SymbolicPath PackageDir SourceDir] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SymbolicPath PackageDir SourceDir]
hsSourceDirs of
    Bool
True -> (FilePath -> Bool) -> Set FilePath -> Set FilePath
forall a. (a -> Bool) -> Set a -> Set a
Set.filter ((FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (FilePath -> FilePath
takeFileName (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
mainMay) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName) (Set FilePath -> Set FilePath)
-> IO (Set FilePath) -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
fp
    Bool
False -> ([Set FilePath] -> Set FilePath)
-> IO [Set FilePath] -> IO (Set FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Set FilePath] -> Set FilePath
forall a. Monoid a => [a] -> a
mconcat (IO [Set FilePath] -> IO (Set FilePath))
-> ((SymbolicPath PackageDir SourceDir -> IO (Set FilePath))
    -> IO [Set FilePath])
-> (SymbolicPath PackageDir SourceDir -> IO (Set FilePath))
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SymbolicPath PackageDir SourceDir]
-> (SymbolicPath PackageDir SourceDir -> IO (Set FilePath))
-> IO [Set FilePath]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [SymbolicPath PackageDir SourceDir]
hsSourceDirs ((SymbolicPath PackageDir SourceDir -> IO (Set FilePath))
 -> IO (Set FilePath))
-> (SymbolicPath PackageDir SourceDir -> IO (Set FilePath))
-> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ \SymbolicPath PackageDir SourceDir
dir -> FilePath -> IO (Set FilePath)
listFilesRecursive (FilePath -> IO (Set FilePath)) -> FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> FilePath -> FilePath
</> SymbolicPath PackageDir SourceDir -> FilePath
forall from to. SymbolicPath from to -> FilePath
dirToPath SymbolicPath PackageDir SourceDir
dir
  Set FilePath -> IO (Set FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set FilePath -> IO (Set FilePath))
-> Set FilePath -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> Set FilePath -> Set FilePath
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (\FilePath
fp2 -> ((FilePath -> Bool) -> Bool) -> [FilePath -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((FilePath -> Bool) -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
fp2) [FilePath -> FilePath -> Bool
isExtensionOf FilePath
"hs", FilePath -> FilePath -> Bool
isExtensionOf FilePath
"lhs", FilePath -> FilePath -> Bool
isExtensionOf FilePath
"hs-boot"]) Set FilePath
allFiles
  where
#if MIN_VERSION_Cabal(3,6,0)
    dirToPath :: SymbolicPath from to -> FilePath
dirToPath = SymbolicPath from to -> FilePath
forall from to. SymbolicPath from to -> FilePath
UtilsPath.getSymbolicPath
#else
    dirToPath = id
#endif

-- |Parse a library to compile.
getLibraryCompilable :: FilePath -> Set T.DependencyName -> UnqualComponentName -> CondTree a [Dependency] Library -> IO T.Compilable
getLibraryCompilable :: FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable FilePath
fp Set DependencyName
ignores UnqualComponentName
name CondTree a [Dependency] Library
tree = do
  let compilableName :: CompilableName
compilableName = UnqualComponentName -> CompilableName
T.mkCompilableName UnqualComponentName
name
  Set FilePath
sourceFiles <- FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles FilePath
fp Maybe FilePath
forall a. Maybe a
Nothing (BuildInfo -> IO (Set FilePath))
-> (CondTree a [Dependency] Library -> BuildInfo)
-> CondTree a [Dependency] Library
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
Library.libBuildInfo (Library -> BuildInfo)
-> (CondTree a [Dependency] Library -> Library)
-> CondTree a [Dependency] Library
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree a [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
CondTree.condTreeData (CondTree a [Dependency] Library -> IO (Set FilePath))
-> CondTree a [Dependency] Library -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Library
tree
  Compilable -> IO Compilable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compilable -> IO Compilable) -> Compilable -> IO Compilable
forall a b. (a -> b) -> a -> b
$ CompilableName
-> CompilableType
-> Set DependencyName
-> Set FilePath
-> Compilable
T.Compilable CompilableName
compilableName CompilableType
T.CompilableTypeLibrary (Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores ([Dependency] -> Set DependencyName)
-> [Dependency] -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Library -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints CondTree a [Dependency] Library
tree) Set FilePath
sourceFiles

-- |Parse an executable to compile.
getExecutableCompilable :: FilePath -> Set T.DependencyName -> UnqualComponentName -> CondTree a [Dependency] Executable -> IO T.Compilable
getExecutableCompilable :: FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Executable
-> IO Compilable
getExecutableCompilable FilePath
fp Set DependencyName
ignores UnqualComponentName
name CondTree a [Dependency] Executable
tree = do
  let compilableName :: CompilableName
compilableName = UnqualComponentName -> CompilableName
T.mkCompilableName UnqualComponentName
name
      mainMay :: Maybe FilePath
mainMay = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (CondTree a [Dependency] Executable -> FilePath)
-> CondTree a [Dependency] Executable
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> FilePath
Executable.modulePath (Executable -> FilePath)
-> (CondTree a [Dependency] Executable -> Executable)
-> CondTree a [Dependency] Executable
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree a [Dependency] Executable -> Executable
forall v c a. CondTree v c a -> a
CondTree.condTreeData (CondTree a [Dependency] Executable -> Maybe FilePath)
-> CondTree a [Dependency] Executable -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Executable
tree
  Set FilePath
sourceFiles <- FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles FilePath
fp Maybe FilePath
mainMay (BuildInfo -> IO (Set FilePath))
-> (CondTree a [Dependency] Executable -> BuildInfo)
-> CondTree a [Dependency] Executable
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
Executable.buildInfo (Executable -> BuildInfo)
-> (CondTree a [Dependency] Executable -> Executable)
-> CondTree a [Dependency] Executable
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree a [Dependency] Executable -> Executable
forall v c a. CondTree v c a -> a
CondTree.condTreeData (CondTree a [Dependency] Executable -> IO (Set FilePath))
-> CondTree a [Dependency] Executable -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Executable
tree
  Compilable -> IO Compilable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compilable -> IO Compilable) -> Compilable -> IO Compilable
forall a b. (a -> b) -> a -> b
$ CompilableName
-> CompilableType
-> Set DependencyName
-> Set FilePath
-> Compilable
T.Compilable CompilableName
compilableName CompilableType
T.CompilableTypeExecutable (Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores ([Dependency] -> Set DependencyName)
-> [Dependency] -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Executable -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints CondTree a [Dependency] Executable
tree) Set FilePath
sourceFiles

-- |Parse a test to compile.
getTestCompilable :: FilePath -> Set T.DependencyName -> UnqualComponentName -> CondTree a [Dependency] TestSuite -> IO T.Compilable
getTestCompilable :: FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] TestSuite
-> IO Compilable
getTestCompilable FilePath
fp Set DependencyName
ignores UnqualComponentName
name CondTree a [Dependency] TestSuite
tree = do
  let compilableName :: CompilableName
compilableName = UnqualComponentName -> CompilableName
T.mkCompilableName UnqualComponentName
name
      mainMay :: Maybe FilePath
mainMay = case TestSuite -> TestSuiteInterface
TestSuite.testInterface (TestSuite -> TestSuiteInterface)
-> TestSuite -> TestSuiteInterface
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] TestSuite -> TestSuite
forall v c a. CondTree v c a -> a
CondTree.condTreeData CondTree a [Dependency] TestSuite
tree of
        TestSuiteInterface.TestSuiteExeV10 Version
_ FilePath
exe -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
exe
        TestSuiteInterface.TestSuiteLibV09 Version
_ ModuleName
_ -> Maybe FilePath
forall a. Maybe a
Nothing
        TestSuiteInterface.TestSuiteUnsupported TestType
_ -> Maybe FilePath
forall a. Maybe a
Nothing
  Set FilePath
sourceFiles <- FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles FilePath
fp Maybe FilePath
mainMay (BuildInfo -> IO (Set FilePath))
-> (CondTree a [Dependency] TestSuite -> BuildInfo)
-> CondTree a [Dependency] TestSuite
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
TestSuite.testBuildInfo (TestSuite -> BuildInfo)
-> (CondTree a [Dependency] TestSuite -> TestSuite)
-> CondTree a [Dependency] TestSuite
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree a [Dependency] TestSuite -> TestSuite
forall v c a. CondTree v c a -> a
CondTree.condTreeData (CondTree a [Dependency] TestSuite -> IO (Set FilePath))
-> CondTree a [Dependency] TestSuite -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] TestSuite
tree
  Compilable -> IO Compilable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compilable -> IO Compilable) -> Compilable -> IO Compilable
forall a b. (a -> b) -> a -> b
$ CompilableName
-> CompilableType
-> Set DependencyName
-> Set FilePath
-> Compilable
T.Compilable CompilableName
compilableName CompilableType
T.CompilableTypeTest (Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores ([Dependency] -> Set DependencyName)
-> [Dependency] -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] TestSuite -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints CondTree a [Dependency] TestSuite
tree) Set FilePath
sourceFiles

-- |Parse a benchmark to compile.
getBenchmarkCompilable :: FilePath -> Set T.DependencyName -> UnqualComponentName -> CondTree a [Dependency] Benchmark -> IO T.Compilable
getBenchmarkCompilable :: FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Benchmark
-> IO Compilable
getBenchmarkCompilable FilePath
fp Set DependencyName
ignores UnqualComponentName
name CondTree a [Dependency] Benchmark
tree = do
  let compilableName :: CompilableName
compilableName = UnqualComponentName -> CompilableName
T.mkCompilableName UnqualComponentName
name
      mainMay :: Maybe FilePath
mainMay = case Benchmark -> BenchmarkInterface
Benchmark.benchmarkInterface (Benchmark -> BenchmarkInterface)
-> Benchmark -> BenchmarkInterface
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Benchmark -> Benchmark
forall v c a. CondTree v c a -> a
CondTree.condTreeData CondTree a [Dependency] Benchmark
tree of
        BenchmarkInterface.BenchmarkExeV10 Version
_ FilePath
exe -> FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
exe
        BenchmarkInterface.BenchmarkUnsupported BenchmarkType
_ -> Maybe FilePath
forall a. Maybe a
Nothing
  Set FilePath
sourceFiles <- FilePath -> Maybe FilePath -> BuildInfo -> IO (Set FilePath)
getSourceFiles FilePath
fp Maybe FilePath
mainMay (BuildInfo -> IO (Set FilePath))
-> (CondTree a [Dependency] Benchmark -> BuildInfo)
-> CondTree a [Dependency] Benchmark
-> IO (Set FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
Benchmark.benchmarkBuildInfo (Benchmark -> BuildInfo)
-> (CondTree a [Dependency] Benchmark -> Benchmark)
-> CondTree a [Dependency] Benchmark
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree a [Dependency] Benchmark -> Benchmark
forall v c a. CondTree v c a -> a
CondTree.condTreeData (CondTree a [Dependency] Benchmark -> IO (Set FilePath))
-> CondTree a [Dependency] Benchmark -> IO (Set FilePath)
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Benchmark
tree
  Compilable -> IO Compilable
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Compilable -> IO Compilable) -> Compilable -> IO Compilable
forall a b. (a -> b) -> a -> b
$ CompilableName
-> CompilableType
-> Set DependencyName
-> Set FilePath
-> Compilable
T.Compilable CompilableName
compilableName CompilableType
T.CompilableTypeBenchmark (Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores ([Dependency] -> Set DependencyName)
-> [Dependency] -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Benchmark -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints CondTree a [Dependency] Benchmark
tree) Set FilePath
sourceFiles

-- |Parse a single cabal file.
parseCabalFile :: FilePath -> Set T.DependencyName -> IO T.Package
parseCabalFile :: FilePath -> Set DependencyName -> IO Package
parseCabalFile FilePath
fp Set DependencyName
ignores = do
  FilePath
cabalFile <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (FilePath -> IO FilePath
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"No .cabal file found in " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fp) FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> IO FilePath)
-> ([FilePath] -> Maybe FilePath) -> [FilePath] -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
T.headMay ([FilePath] -> Maybe FilePath)
-> ([FilePath] -> [FilePath]) -> [FilePath] -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
isExtensionOf FilePath
"cabal") ([FilePath] -> IO FilePath) -> IO [FilePath] -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO [FilePath]
listDirectory FilePath
fp
  GenericPackageDescription
genericPackageDescription <- Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Verbosity.silent (FilePath -> IO GenericPackageDescription)
-> FilePath -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
cabalFile
  let baseDependencies :: Set DependencyName
baseDependencies = case GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary GenericPackageDescription
genericPackageDescription of
        Just CondTree ConfVar [Dependency] Library
library -> Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores ([Dependency] -> Set DependencyName)
-> [Dependency] -> Set DependencyName
forall a b. (a -> b) -> a -> b
$ CondTree ConfVar [Dependency] Library -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints CondTree ConfVar [Dependency] Library
library
        -- if no library, use set intersection to figure out the common dependencies and use that as the base
        Maybe (CondTree ConfVar [Dependency] Library)
Nothing ->
          let allCabalDependencies :: [Set T.DependencyName]
              allCabalDependencies :: [Set DependencyName]
allCabalDependencies = ([Dependency] -> Set DependencyName)
-> [[Dependency]] -> [Set DependencyName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set DependencyName -> [Dependency] -> Set DependencyName
getDependencyNames Set DependencyName
ignores) ([[Dependency]] -> [Set DependencyName])
-> ([[[Dependency]]] -> [[Dependency]])
-> [[[Dependency]]]
-> [Set DependencyName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Dependency]]] -> [[Dependency]]
forall a. Monoid a => [a] -> a
mconcat ([[[Dependency]]] -> [Set DependencyName])
-> [[[Dependency]]] -> [Set DependencyName]
forall a b. (a -> b) -> a -> b
$
                [ CondTree ConfVar [Dependency] Library -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints (CondTree ConfVar [Dependency] Library -> [Dependency])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [[Dependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries GenericPackageDescription
genericPackageDescription
                , CondTree ConfVar [Dependency] Executable -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints (CondTree ConfVar [Dependency] Executable -> [Dependency])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> [Dependency])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [[Dependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables GenericPackageDescription
genericPackageDescription
                , CondTree ConfVar [Dependency] TestSuite -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints (CondTree ConfVar [Dependency] TestSuite -> [Dependency])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [[Dependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites GenericPackageDescription
genericPackageDescription
                , CondTree ConfVar [Dependency] Benchmark -> [Dependency]
forall v c a. CondTree v c a -> c
CondTree.condTreeConstraints (CondTree ConfVar [Dependency] Benchmark -> [Dependency])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> [Dependency])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [[Dependency]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks GenericPackageDescription
genericPackageDescription
                ]
          in case [Set DependencyName]
allCabalDependencies of
            [] -> Set DependencyName
forall a. Monoid a => a
mempty
            Set DependencyName
x:[Set DependencyName]
xs -> (Set DependencyName -> Set DependencyName -> Set DependencyName)
-> Set DependencyName -> [Set DependencyName] -> Set DependencyName
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set DependencyName
x [Set DependencyName]
xs
      packageDescription :: PackageDescription
packageDescription = GenericPackageDescription -> PackageDescription
GenericPackageDescription.packageDescription GenericPackageDescription
genericPackageDescription
      unqualComponentName :: UnqualComponentName
unqualComponentName = FilePath -> UnqualComponentName
UnqualComponentName.mkUnqualComponentName (FilePath -> UnqualComponentName)
-> (PackageDescription -> FilePath)
-> PackageDescription
-> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
PackageName.unPackageName (PackageName -> FilePath)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
PackageId.pkgName (PackageIdentifier -> PackageName)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
PackageDescription.package (PackageDescription -> UnqualComponentName)
-> PackageDescription -> UnqualComponentName
forall a b. (a -> b) -> a -> b
$ PackageDescription
packageDescription
      packageName :: Text
packageName = FilePath -> Text
pack (FilePath -> Text)
-> (PackageDescription -> FilePath) -> PackageDescription -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> FilePath
PackageName.unPackageName (PackageName -> FilePath)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
PackageId.pkgName (PackageIdentifier -> PackageName)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
PackageDescription.package (PackageDescription -> Text) -> PackageDescription -> Text
forall a b. (a -> b) -> a -> b
$ PackageDescription
packageDescription
  [Compilable]
libraries         <- (CondTree ConfVar [Dependency] Library -> IO Compilable)
-> [CondTree ConfVar [Dependency] Library] -> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall a.
FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable    FilePath
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) UnqualComponentName
unqualComponentName) ([CondTree ConfVar [Dependency] Library] -> IO [Compilable])
-> (GenericPackageDescription
    -> [CondTree ConfVar [Dependency] Library])
-> GenericPackageDescription
-> IO [Compilable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
maybeToList (Maybe (CondTree ConfVar [Dependency] Library)
 -> [CondTree ConfVar [Dependency] Library])
-> (GenericPackageDescription
    -> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> [CondTree ConfVar [Dependency] Library]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary (GenericPackageDescription -> IO [Compilable])
-> GenericPackageDescription -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
genericPackageDescription
  [Compilable]
internalLibraries <- ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> IO Compilable)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall a.
FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable    FilePath
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (UnqualComponentName
 -> CondTree ConfVar [Dependency] Library -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> CondTree ConfVar [Dependency] Library -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> IO Compilable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
 -> IO [Compilable])
-> (GenericPackageDescription
    -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)])
-> GenericPackageDescription
-> IO [Compilable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries (GenericPackageDescription -> IO [Compilable])
-> GenericPackageDescription -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
genericPackageDescription
  [Compilable]
executables       <- ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> IO Compilable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree ConfVar [Dependency] Executable
-> IO Compilable
forall a.
FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Executable
-> IO Compilable
getExecutableCompilable FilePath
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (UnqualComponentName
 -> CondTree ConfVar [Dependency] Executable -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> CondTree ConfVar [Dependency] Executable -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> IO Compilable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
 -> IO [Compilable])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription
-> IO [Compilable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables (GenericPackageDescription -> IO [Compilable])
-> GenericPackageDescription -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
genericPackageDescription
  [Compilable]
tests             <- ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> IO Compilable)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree ConfVar [Dependency] TestSuite
-> IO Compilable
forall a.
FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] TestSuite
-> IO Compilable
getTestCompilable       FilePath
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (UnqualComponentName
 -> CondTree ConfVar [Dependency] TestSuite -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> CondTree ConfVar [Dependency] TestSuite -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> IO Compilable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> IO [Compilable])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] TestSuite)])
-> GenericPackageDescription
-> IO [Compilable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites (GenericPackageDescription -> IO [Compilable])
-> GenericPackageDescription -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
genericPackageDescription
  [Compilable]
benchmarks        <- ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> IO Compilable)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> IO [Compilable]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree ConfVar [Dependency] Benchmark
-> IO Compilable
forall a.
FilePath
-> Set DependencyName
-> UnqualComponentName
-> CondTree a [Dependency] Benchmark
-> IO Compilable
getBenchmarkCompilable  FilePath
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (UnqualComponentName
 -> CondTree ConfVar [Dependency] Benchmark -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> UnqualComponentName
forall a b. (a, b) -> a
fst ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> CondTree ConfVar [Dependency] Benchmark -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> IO Compilable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> IO [Compilable])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Benchmark)])
-> GenericPackageDescription
-> IO [Compilable]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks (GenericPackageDescription -> IO [Compilable])
-> GenericPackageDescription -> IO [Compilable]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
genericPackageDescription
  Package -> IO Package
forall (f :: * -> *) a. Applicative f => a -> f a
pure Package :: Text
-> FilePath
-> GenericPackageDescription
-> Set DependencyName
-> [Compilable]
-> Package
T.Package
    { packageName :: Text
packageName = Text
packageName
    , packageFile :: FilePath
packageFile = FilePath
fp FilePath -> FilePath -> FilePath
</> FilePath
cabalFile
    , packageDescription :: GenericPackageDescription
packageDescription = GenericPackageDescription
genericPackageDescription
    , packageBaseDependencies :: Set DependencyName
packageBaseDependencies = Set DependencyName
baseDependencies
    , packageCompilables :: [Compilable]
packageCompilables = [Compilable]
libraries [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
internalLibraries [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
executables [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
tests [Compilable] -> [Compilable] -> [Compilable]
forall a. Semigroup a => a -> a -> a
<> [Compilable]
benchmarks
    }

-- |Parse cabal files by file path, filter by explicit package names (if provided), and return the parsed packages.
parseCabalFiles :: (MonadIO m, MonadLogger m) => [FilePath] -> Set T.DependencyName -> [Text] -> m [T.Package]
parseCabalFiles :: [FilePath] -> Set DependencyName -> [Text] -> m [Package]
parseCabalFiles [FilePath]
packageDirs Set DependencyName
ignores [Text]
packages = do
  [Package]
rawPackages <- IO [Package] -> m [Package]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Package] -> m [Package]) -> IO [Package] -> m [Package]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Package) -> [FilePath] -> IO [Package]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((FilePath -> Set DependencyName -> IO Package)
-> Set DependencyName -> FilePath -> IO Package
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Set DependencyName -> IO Package
parseCabalFile Set DependencyName
ignores) [FilePath]
packageDirs
  let toReturn :: [Package]
toReturn = if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
packages then [Package]
rawPackages else (Package -> Bool) -> [Package] -> [Package]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool) -> [Text] -> Text -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [Text]
packages (Text -> Bool) -> (Package -> Text) -> Package -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Package -> Text
T.packageName) [Package]
rawPackages
  Int
FilePath
LogLevel
FilePath -> Text
FilePath -> FilePath -> FilePath -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
pack :: FilePath -> Text
$logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Parsed packages " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
pack ([Package] -> FilePath
forall a. Show a => a -> FilePath
show [Package]
toReturn)
  [Package] -> m [Package]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Package]
toReturn

-- |Find cabal files under the project root.
findCabalFiles :: FilePath -> IO (T.BuildSystem, [FilePath])
findCabalFiles :: FilePath -> IO (BuildSystem, [FilePath])
findCabalFiles FilePath
projectRoot = do
  (BuildSystem
T.Cabal,) ([FilePath] -> (BuildSystem, [FilePath]))
-> (Set FilePath -> [FilePath])
-> Set FilePath
-> (BuildSystem, [FilePath])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
takeDirectory ([FilePath] -> [FilePath])
-> (Set FilePath -> [FilePath]) -> Set FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath -> FilePath -> Bool
isExtensionOf FilePath
"cabal") ([FilePath] -> [FilePath])
-> (Set FilePath -> [FilePath]) -> Set FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set FilePath -> [FilePath]
forall a. Set a -> [a]
Set.toList (Set FilePath -> (BuildSystem, [FilePath]))
-> IO (Set FilePath) -> IO (BuildSystem, [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Set FilePath)
listFilesRecursive FilePath
projectRoot

-- |Parse cabal.project file by file path.
parseCabalProjectFile :: FilePath -> IO (T.BuildSystem, [FilePath])
parseCabalProjectFile :: FilePath -> IO (BuildSystem, [FilePath])
parseCabalProjectFile FilePath
cabalProjectFile = do
  Project URI Void (FilePath, GenericPackageDescription)
project <- FilePath
-> IO (Project URI Void (FilePath, GenericPackageDescription))
readProject FilePath
cabalProjectFile
  (BuildSystem, [FilePath]) -> IO (BuildSystem, [FilePath])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BuildSystem
T.CabalProject, FilePath -> FilePath
takeDirectory (FilePath -> FilePath)
-> ((FilePath, GenericPackageDescription) -> FilePath)
-> (FilePath, GenericPackageDescription)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, GenericPackageDescription) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, GenericPackageDescription) -> FilePath)
-> [(FilePath, GenericPackageDescription)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Project URI Void (FilePath, GenericPackageDescription)
-> [(FilePath, GenericPackageDescription)]
forall uri opt pkg. Project uri opt pkg -> [pkg]
prjPackages Project URI Void (FilePath, GenericPackageDescription)
project)