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 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.Dependency as Dependency
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
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 (Text -> DependencyName
T.DependencyName (Text -> DependencyName)
-> (Dependency -> Text) -> Dependency -> DependencyName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack(String -> Text) -> (Dependency -> String) -> Dependency -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  PackageName -> String
PackageName.unPackageName (PackageName -> String)
-> (Dependency -> PackageName) -> Dependency -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
Dependency.depPkgName)

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

-- |Parse a library to compile.
getLibraryCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Library -> IO T.Compilable
getLibraryCompilable :: String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable String
fp Set DependencyName
ignores Text
name CondTree a [Dependency] Library
tree = do
  let compilableName :: CompilableName
compilableName = Text -> CompilableName
T.CompilableName Text
name
  Set String
sourceFiles <- String -> Maybe String -> BuildInfo -> IO (Set String)
getSourceFiles String
fp Maybe String
forall a. Maybe a
Nothing (BuildInfo -> IO (Set String))
-> (CondTree a [Dependency] Library -> BuildInfo)
-> CondTree a [Dependency] Library
-> IO (Set String)
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 String))
-> CondTree a [Dependency] Library -> IO (Set String)
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 String -> 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 String
sourceFiles

-- |Parse an executable to compile.
getExecutableCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Executable -> IO T.Compilable
getExecutableCompilable :: String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Executable
-> IO Compilable
getExecutableCompilable String
fp Set DependencyName
ignores Text
name CondTree a [Dependency] Executable
tree = do
  let compilableName :: CompilableName
compilableName = Text -> CompilableName
T.CompilableName Text
name
      mainMay :: Maybe String
mainMay = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (CondTree a [Dependency] Executable -> String)
-> CondTree a [Dependency] Executable
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> String
Executable.modulePath (Executable -> String)
-> (CondTree a [Dependency] Executable -> Executable)
-> CondTree a [Dependency] Executable
-> String
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 String)
-> CondTree a [Dependency] Executable -> Maybe String
forall a b. (a -> b) -> a -> b
$ CondTree a [Dependency] Executable
tree
  Set String
sourceFiles <- String -> Maybe String -> BuildInfo -> IO (Set String)
getSourceFiles String
fp Maybe String
mainMay (BuildInfo -> IO (Set String))
-> (CondTree a [Dependency] Executable -> BuildInfo)
-> CondTree a [Dependency] Executable
-> IO (Set String)
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 String))
-> CondTree a [Dependency] Executable -> IO (Set String)
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 String -> 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 String
sourceFiles

-- |Parse a test to compile.
getTestCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] TestSuite -> IO T.Compilable
getTestCompilable :: String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] TestSuite
-> IO Compilable
getTestCompilable String
fp Set DependencyName
ignores Text
name CondTree a [Dependency] TestSuite
tree = do
  let compilableName :: CompilableName
compilableName = Text -> CompilableName
T.CompilableName Text
name
      mainMay :: Maybe String
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
_ String
exe -> String -> Maybe String
forall a. a -> Maybe a
Just String
exe
        TestSuiteInterface.TestSuiteLibV09 Version
_ ModuleName
_ -> Maybe String
forall a. Maybe a
Nothing
        TestSuiteInterface.TestSuiteUnsupported TestType
_ -> Maybe String
forall a. Maybe a
Nothing
  Set String
sourceFiles <- String -> Maybe String -> BuildInfo -> IO (Set String)
getSourceFiles String
fp Maybe String
mainMay (BuildInfo -> IO (Set String))
-> (CondTree a [Dependency] TestSuite -> BuildInfo)
-> CondTree a [Dependency] TestSuite
-> IO (Set String)
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 String))
-> CondTree a [Dependency] TestSuite -> IO (Set String)
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 String -> 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 String
sourceFiles

-- |Parse a benchmark to compile.
getBenchmarkCompilable :: FilePath -> Set T.DependencyName -> Text -> CondTree a [Dependency] Benchmark -> IO T.Compilable
getBenchmarkCompilable :: String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Benchmark
-> IO Compilable
getBenchmarkCompilable String
fp Set DependencyName
ignores Text
name CondTree a [Dependency] Benchmark
tree = do
  let compilableName :: CompilableName
compilableName = Text -> CompilableName
T.CompilableName Text
name
      mainMay :: Maybe String
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
_ String
exe -> String -> Maybe String
forall a. a -> Maybe a
Just String
exe
        BenchmarkInterface.BenchmarkUnsupported BenchmarkType
_ -> Maybe String
forall a. Maybe a
Nothing
  Set String
sourceFiles <- String -> Maybe String -> BuildInfo -> IO (Set String)
getSourceFiles String
fp Maybe String
mainMay (BuildInfo -> IO (Set String))
-> (CondTree a [Dependency] Benchmark -> BuildInfo)
-> CondTree a [Dependency] Benchmark
-> IO (Set String)
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 String))
-> CondTree a [Dependency] Benchmark -> IO (Set String)
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 String -> 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 String
sourceFiles

-- |Parse a single cabal file.
parseCabalFile :: FilePath -> Set T.DependencyName -> IO T.Package
parseCabalFile :: String -> Set DependencyName -> IO Package
parseCabalFile String
fp Set DependencyName
ignores = do
  String
cabalFile <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"No .cabal file found in " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp) String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String)
-> ([String] -> Maybe String) -> [String] -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Maybe String
forall a. [a] -> Maybe a
T.headMay ([String] -> Maybe String)
-> ([String] -> [String]) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
isExtensionOf String
"cabal") ([String] -> IO String) -> IO [String] -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO [String]
listDirectory String
fp
  GenericPackageDescription
genericPackageDescription <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Verbosity.silent (String -> IO GenericPackageDescription)
-> String -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ String
fp String -> String -> String
</> String
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
      packageName :: Text
packageName = String -> Text
pack (String -> Text)
-> (PackageDescription -> String) -> PackageDescription -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
PackageName.unPackageName (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
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 (String
-> Set DependencyName
-> Text
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall a.
String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable    String
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) Text
packageName) ([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 (String
-> Set DependencyName
-> Text
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall a.
String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Library
-> IO Compilable
getLibraryCompilable    String
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (Text -> CondTree ConfVar [Dependency] Library -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> Text)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> CondTree ConfVar [Dependency] Library
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text
pack (String -> Text)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
UnqualComponentName.unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (String
-> Set DependencyName
-> Text
-> CondTree ConfVar [Dependency] Executable
-> IO Compilable
forall a.
String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Executable
-> IO Compilable
getExecutableCompilable String
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (Text -> CondTree ConfVar [Dependency] Executable -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Text)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text
pack (String -> Text)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
UnqualComponentName.unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (String
-> Set DependencyName
-> Text
-> CondTree ConfVar [Dependency] TestSuite
-> IO Compilable
forall a.
String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] TestSuite
-> IO Compilable
getTestCompilable       String
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (Text -> CondTree ConfVar [Dependency] TestSuite -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> Text)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text
pack (String -> Text)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
UnqualComponentName.unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 (String
-> Set DependencyName
-> Text
-> CondTree ConfVar [Dependency] Benchmark
-> IO Compilable
forall a.
String
-> Set DependencyName
-> Text
-> CondTree a [Dependency] Benchmark
-> IO Compilable
getBenchmarkCompilable  String
fp (Set DependencyName
ignores Set DependencyName -> Set DependencyName -> Set DependencyName
forall a. Semigroup a => a -> a -> a
<> Set DependencyName
baseDependencies) (Text -> CondTree ConfVar [Dependency] Benchmark -> IO Compilable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> Text)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> IO Compilable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Text
pack (String -> Text)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> String)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> String
UnqualComponentName.unUnqualComponentName (UnqualComponentName -> String)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> UnqualComponentName)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 -> Set DependencyName -> [Compilable] -> Package
T.Package
    { packageName :: Text
packageName = Text
packageName
    , 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 :: [String] -> Set DependencyName -> [Text] -> m [Package]
parseCabalFiles [String]
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
$ (String -> IO Package) -> [String] -> IO [Package]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((String -> Set DependencyName -> IO Package)
-> Set DependencyName -> String -> IO Package
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> Set DependencyName -> IO Package
parseCabalFile Set DependencyName
ignores) [String]
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
String
LogLevel
String -> Text
String -> String -> String -> 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 :: String -> 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
<> String -> Text
pack ([Package] -> String
forall a. Show a => a -> String
show [Package]
toReturn)
  [Package] -> m [Package]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Package]
toReturn

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

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