module Velma where

import qualified Data.Containers.ListUtils as ListUtils
import qualified Data.Foldable as Foldable
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Distribution.ModuleName as ModuleName
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Simple as Cabal
import qualified Distribution.Simple.Setup as Cabal
import qualified Distribution.Types.Benchmark as Benchmark
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.ForeignLib as ForeignLib
import qualified Distribution.Types.GenericPackageDescription as GenericPackageDescription
import qualified Distribution.Types.HookedBuildInfo as HookedBuildInfo
import qualified Distribution.Types.Library as Library
import qualified Distribution.Types.LocalBuildInfo as LocalBuildInfo
import qualified Distribution.Types.TestSuite as TestSuite
import qualified System.Directory as Directory
import qualified System.FilePath as FilePath
import qualified Velma.SymbolicPath as SymbolicPath

defaultMain :: IO ()
defaultMain :: IO ()
defaultMain = UserHooks -> IO ()
Cabal.defaultMainWithHooks UserHooks
userHooks

userHooks :: Cabal.UserHooks
userHooks :: UserHooks
userHooks = UserHooks
Cabal.simpleUserHooks { confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
Cabal.confHook = (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook }

confHook
    :: ( GenericPackageDescription.GenericPackageDescription
       , HookedBuildInfo.HookedBuildInfo
       )
    -> Cabal.ConfigFlags
    -> IO LocalBuildInfo.LocalBuildInfo
confHook :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
confHook (GenericPackageDescription
gpd1, HookedBuildInfo
hbi) ConfigFlags
cf = do
    GenericPackageDescription
gpd2 <- GenericPackageDescription -> IO GenericPackageDescription
discoverPackageModules GenericPackageDescription
gpd1
    UserHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
Cabal.confHook UserHooks
Cabal.simpleUserHooks (GenericPackageDescription
gpd2, HookedBuildInfo
hbi) ConfigFlags
cf

discoverPackageModules
    :: GenericPackageDescription.GenericPackageDescription
    -> IO GenericPackageDescription.GenericPackageDescription
discoverPackageModules :: GenericPackageDescription -> IO GenericPackageDescription
discoverPackageModules GenericPackageDescription
gpd = do
    let buildInfos :: [BuildInfo]
buildInfos = [[BuildInfo]] -> [BuildInfo]
forall a. Monoid a => [a] -> a
mconcat
            [ (CondTree ConfVar [Dependency] Library -> BuildInfo)
-> [CondTree ConfVar [Dependency] Library] -> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Library -> BuildInfo
Library.libBuildInfo (Library -> BuildInfo)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
CondTree.condTreeData)
            ([CondTree ConfVar [Dependency] Library] -> [BuildInfo])
-> (Maybe (CondTree ConfVar [Dependency] Library)
    -> [CondTree ConfVar [Dependency] Library])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [BuildInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall a. Maybe a -> [a]
Maybe.maybeToList
            (Maybe (CondTree ConfVar [Dependency] Library) -> [BuildInfo])
-> Maybe (CondTree ConfVar [Dependency] Library) -> [BuildInfo]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary GenericPackageDescription
gpd
            , Library -> BuildInfo
Library.libBuildInfo
            (Library -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
CondTree.condTreeData
            (CondTree ConfVar [Dependency] Library -> Library)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
    -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> Library
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)
 -> BuildInfo)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries GenericPackageDescription
gpd
            , ForeignLib -> BuildInfo
ForeignLib.foreignLibBuildInfo
            (ForeignLib -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] ForeignLib -> ForeignLib
forall v c a. CondTree v c a -> a
CondTree.condTreeData
            (CondTree ConfVar [Dependency] ForeignLib -> ForeignLib)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
    -> CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> ForeignLib
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
forall a b. (a, b) -> b
snd
            ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> BuildInfo)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
GenericPackageDescription.condForeignLibs GenericPackageDescription
gpd
            , Executable -> BuildInfo
Executable.buildInfo
            (Executable -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Executable -> Executable
forall v c a. CondTree v c a -> a
CondTree.condTreeData
            (CondTree ConfVar [Dependency] Executable -> Executable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Executable
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)
 -> BuildInfo)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables GenericPackageDescription
gpd
            , TestSuite -> BuildInfo
TestSuite.testBuildInfo
            (TestSuite -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] TestSuite -> TestSuite
forall v c a. CondTree v c a -> a
CondTree.condTreeData
            (CondTree ConfVar [Dependency] TestSuite -> TestSuite)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> TestSuite
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)
 -> BuildInfo)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites GenericPackageDescription
gpd
            , Benchmark -> BuildInfo
Benchmark.benchmarkBuildInfo
            (Benchmark -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Benchmark -> Benchmark
forall v c a. CondTree v c a -> a
CondTree.condTreeData
            (CondTree ConfVar [Dependency] Benchmark -> Benchmark)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Benchmark
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)
 -> BuildInfo)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [BuildInfo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks GenericPackageDescription
gpd
            ]
        hsSourceDirs :: [FilePath]
hsSourceDirs =
            Set FilePath -> [FilePath]
forall a. Set a -> [a]
Set.toList (Set FilePath -> [FilePath])
-> ([Set FilePath] -> Set FilePath) -> [Set FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Set FilePath] -> Set FilePath
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set FilePath] -> [FilePath]) -> [Set FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> Set FilePath) -> [BuildInfo] -> [Set FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuildInfo -> Set FilePath
getHsSourceDirs [BuildInfo]
buildInfos
        toMap :: FilePath -> IO (Map FilePath [FilePath])
toMap FilePath
directory =
            FilePath -> [FilePath] -> Map FilePath [FilePath]
forall k a. k -> a -> Map k a
Map.singleton FilePath
directory
                ([FilePath] -> Map FilePath [FilePath])
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> Map FilePath [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
FilePath.makeRelative FilePath
directory)
                ([FilePath] -> Map FilePath [FilePath])
-> IO [FilePath] -> IO (Map FilePath [FilePath])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
directory
    Map FilePath [FilePath]
directoryContents <- (FilePath -> IO (Map FilePath [FilePath]))
-> [FilePath] -> IO (Map FilePath [FilePath])
forall (m :: * -> *) b (t :: * -> *) a.
(Applicative m, Monoid b, Traversable t) =>
(a -> m b) -> t a -> m b
foldTraverse FilePath -> IO (Map FilePath [FilePath])
toMap [FilePath]
hsSourceDirs
    GenericPackageDescription -> IO GenericPackageDescription
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenericPackageDescription -> IO GenericPackageDescription)
-> GenericPackageDescription -> IO GenericPackageDescription
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
-> Map FilePath [FilePath] -> GenericPackageDescription
discoverPackageModulesWith GenericPackageDescription
gpd Map FilePath [FilePath]
directoryContents

discoverPackageModulesWith
    :: GenericPackageDescription.GenericPackageDescription
    -> Map.Map FilePath [FilePath]
    -> GenericPackageDescription.GenericPackageDescription
discoverPackageModulesWith :: GenericPackageDescription
-> Map FilePath [FilePath] -> GenericPackageDescription
discoverPackageModulesWith GenericPackageDescription
gpd Map FilePath [FilePath]
directoryContents = GenericPackageDescription
gpd
    { condLibrary :: Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary =
        (Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData (Map FilePath [FilePath] -> Library -> Library
discoverLibraryModules Map FilePath [FilePath]
directoryContents)
            (CondTree ConfVar [Dependency] Library
 -> CondTree ConfVar [Dependency] Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
-> Maybe (CondTree ConfVar [Dependency] Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
GenericPackageDescription.condLibrary GenericPackageDescription
gpd
    , condSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries =
        (CondTree ConfVar [Dependency] Library
 -> CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Library)
forall b c a. (b -> c) -> (a, b) -> (a, c)
overSnd
                ((Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData
                ((Library -> Library)
 -> CondTree ConfVar [Dependency] Library
 -> CondTree ConfVar [Dependency] Library)
-> (Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> CondTree ConfVar [Dependency] Library
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Library -> Library
discoverLibraryModules Map FilePath [FilePath]
directoryContents
                )
            ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Library))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
GenericPackageDescription.condSubLibraries GenericPackageDescription
gpd
    , condForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
GenericPackageDescription.condForeignLibs =
        (CondTree ConfVar [Dependency] ForeignLib
 -> CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
-> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
forall b c a. (b -> c) -> (a, b) -> (a, c)
overSnd
                ((ForeignLib -> ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> CondTree ConfVar [Dependency] ForeignLib
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData
                ((ForeignLib -> ForeignLib)
 -> CondTree ConfVar [Dependency] ForeignLib
 -> CondTree ConfVar [Dependency] ForeignLib)
-> (ForeignLib -> ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> CondTree ConfVar [Dependency] ForeignLib
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> ForeignLib -> ForeignLib
discoverForeignLibModules Map FilePath [FilePath]
directoryContents
                )
            ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> (UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
GenericPackageDescription.condForeignLibs GenericPackageDescription
gpd
    , condExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables =
        (CondTree ConfVar [Dependency] Executable
 -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
forall b c a. (b -> c) -> (a, b) -> (a, c)
overSnd
                ((Executable -> Executable)
-> CondTree ConfVar [Dependency] Executable
-> CondTree ConfVar [Dependency] Executable
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData
                ((Executable -> Executable)
 -> CondTree ConfVar [Dependency] Executable
 -> CondTree ConfVar [Dependency] Executable)
-> (Executable -> Executable)
-> CondTree ConfVar [Dependency] Executable
-> CondTree ConfVar [Dependency] Executable
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Executable -> Executable
discoverExecutableModules Map FilePath [FilePath]
directoryContents
                )
            ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable))
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
GenericPackageDescription.condExecutables GenericPackageDescription
gpd
    , condTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites =
        (CondTree ConfVar [Dependency] TestSuite
 -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
forall b c a. (b -> c) -> (a, b) -> (a, c)
overSnd
                ((TestSuite -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> CondTree ConfVar [Dependency] TestSuite
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData
                ((TestSuite -> TestSuite)
 -> CondTree ConfVar [Dependency] TestSuite
 -> CondTree ConfVar [Dependency] TestSuite)
-> (TestSuite -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> TestSuite -> TestSuite
discoverTestSuiteModules Map FilePath [FilePath]
directoryContents
                )
            ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
GenericPackageDescription.condTestSuites GenericPackageDescription
gpd
    , condBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks =
        (CondTree ConfVar [Dependency] Benchmark
 -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
forall b c a. (b -> c) -> (a, b) -> (a, c)
overSnd
                ((Benchmark -> Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> CondTree ConfVar [Dependency] Benchmark
forall a b v c. (a -> b) -> CondTree v c a -> CondTree v c b
CondTree.mapTreeData
                ((Benchmark -> Benchmark)
 -> CondTree ConfVar [Dependency] Benchmark
 -> CondTree ConfVar [Dependency] Benchmark)
-> (Benchmark -> Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Benchmark -> Benchmark
discoverBenchmarkModules Map FilePath [FilePath]
directoryContents
                )
            ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark))
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
GenericPackageDescription.condBenchmarks GenericPackageDescription
gpd
    }

overSnd :: (b -> c) -> (a, b) -> (a, c)
overSnd :: (b -> c) -> (a, b) -> (a, c)
overSnd b -> c
f (a
x, b
y) = (a
x, b -> c
f b
y)

discoverBenchmarkModules
    :: Map.Map FilePath [FilePath]
    -> Benchmark.Benchmark
    -> Benchmark.Benchmark
discoverBenchmarkModules :: Map FilePath [FilePath] -> Benchmark -> Benchmark
discoverBenchmarkModules Map FilePath [FilePath]
directoryContents Benchmark
benchmark =
    let
        oldBuildInfo :: BuildInfo
oldBuildInfo = Benchmark -> BuildInfo
Benchmark.benchmarkBuildInfo Benchmark
benchmark
        newBuildInfo :: BuildInfo
newBuildInfo = Map FilePath [FilePath] -> BuildInfo -> BuildInfo
discoverOtherModules Map FilePath [FilePath]
directoryContents BuildInfo
oldBuildInfo
    in Benchmark
benchmark { benchmarkBuildInfo :: BuildInfo
Benchmark.benchmarkBuildInfo = BuildInfo
newBuildInfo }

discoverTestSuiteModules
    :: Map.Map FilePath [FilePath]
    -> TestSuite.TestSuite
    -> TestSuite.TestSuite
discoverTestSuiteModules :: Map FilePath [FilePath] -> TestSuite -> TestSuite
discoverTestSuiteModules Map FilePath [FilePath]
directoryContents TestSuite
testSuite =
    let
        oldBuildInfo :: BuildInfo
oldBuildInfo = TestSuite -> BuildInfo
TestSuite.testBuildInfo TestSuite
testSuite
        newBuildInfo :: BuildInfo
newBuildInfo = Map FilePath [FilePath] -> BuildInfo -> BuildInfo
discoverOtherModules Map FilePath [FilePath]
directoryContents BuildInfo
oldBuildInfo
    in TestSuite
testSuite { testBuildInfo :: BuildInfo
TestSuite.testBuildInfo = BuildInfo
newBuildInfo }

discoverExecutableModules
    :: Map.Map FilePath [FilePath]
    -> Executable.Executable
    -> Executable.Executable
discoverExecutableModules :: Map FilePath [FilePath] -> Executable -> Executable
discoverExecutableModules Map FilePath [FilePath]
directoryContents Executable
executable =
    let
        oldBuildInfo :: BuildInfo
oldBuildInfo = Executable -> BuildInfo
Executable.buildInfo Executable
executable
        newBuildInfo :: BuildInfo
newBuildInfo = Map FilePath [FilePath] -> BuildInfo -> BuildInfo
discoverOtherModules Map FilePath [FilePath]
directoryContents BuildInfo
oldBuildInfo
    in Executable
executable { buildInfo :: BuildInfo
Executable.buildInfo = BuildInfo
newBuildInfo }

discoverForeignLibModules
    :: Map.Map FilePath [FilePath]
    -> ForeignLib.ForeignLib
    -> ForeignLib.ForeignLib
discoverForeignLibModules :: Map FilePath [FilePath] -> ForeignLib -> ForeignLib
discoverForeignLibModules Map FilePath [FilePath]
directoryContents ForeignLib
foreignLib =
    let
        oldBuildInfo :: BuildInfo
oldBuildInfo = ForeignLib -> BuildInfo
ForeignLib.foreignLibBuildInfo ForeignLib
foreignLib
        newBuildInfo :: BuildInfo
newBuildInfo = Map FilePath [FilePath] -> BuildInfo -> BuildInfo
discoverOtherModules Map FilePath [FilePath]
directoryContents BuildInfo
oldBuildInfo
    in ForeignLib
foreignLib { foreignLibBuildInfo :: BuildInfo
ForeignLib.foreignLibBuildInfo = BuildInfo
newBuildInfo }

discoverLibraryModules
    :: Map.Map FilePath [FilePath] -> Library.Library -> Library.Library
discoverLibraryModules :: Map FilePath [FilePath] -> Library -> Library
discoverLibraryModules Map FilePath [FilePath]
directoryContents =
    Map FilePath [FilePath] -> Library -> Library
discoverOtherLibraryModules Map FilePath [FilePath]
directoryContents
        (Library -> Library) -> (Library -> Library) -> Library -> Library
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath [FilePath] -> Library -> Library
discoverExposedLibraryModules Map FilePath [FilePath]
directoryContents

discoverExposedLibraryModules
    :: Map.Map FilePath [FilePath] -> Library.Library -> Library.Library
discoverExposedLibraryModules :: Map FilePath [FilePath] -> Library -> Library
discoverExposedLibraryModules Map FilePath [FilePath]
directoryContents Library
library =
    case ModuleName -> [ModuleName] -> Maybe [ModuleName]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove ModuleName
velmaDiscover ([ModuleName] -> Maybe [ModuleName])
-> [ModuleName] -> Maybe [ModuleName]
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
Library.exposedModules Library
library of
        Maybe [ModuleName]
Nothing -> Library
library
        Just [ModuleName]
exposedModules ->
            let
                directories :: Set FilePath
directories = BuildInfo -> Set FilePath
getHsSourceDirs (BuildInfo -> Set FilePath) -> BuildInfo -> Set FilePath
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
Library.libBuildInfo Library
library
                entries :: [FilePath]
entries = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> (Map FilePath [FilePath] -> [[FilePath]])
-> Map FilePath [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath [FilePath] -> [[FilePath]]
forall k a. Map k a -> [a]
Map.elems (Map FilePath [FilePath] -> [FilePath])
-> Map FilePath [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Set FilePath -> Map FilePath [FilePath]
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys
                    Map FilePath [FilePath]
directoryContents
                    Set FilePath
directories
                otherModules :: Set ModuleName
otherModules =
                    [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList
                        ([ModuleName] -> Set ModuleName)
-> (BuildInfo -> [ModuleName]) -> BuildInfo -> Set ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [ModuleName]
BuildInfo.otherModules
                        (BuildInfo -> Set ModuleName) -> BuildInfo -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
Library.libBuildInfo Library
library
                discovered :: [ModuleName]
discovered =
                    (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ModuleName
otherModules)
                        ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe FilePath -> Maybe ModuleName
filePathToModuleName [FilePath]
entries
                allModules :: [ModuleName]
allModules = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ListUtils.nubOrd ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
exposedModules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> [ModuleName]
discovered
            in Library
library { exposedModules :: [ModuleName]
Library.exposedModules = [ModuleName]
allModules }

discoverOtherLibraryModules
    :: Map.Map FilePath [FilePath] -> Library.Library -> Library.Library
discoverOtherLibraryModules :: Map FilePath [FilePath] -> Library -> Library
discoverOtherLibraryModules Map FilePath [FilePath]
directoryContents Library
library =
    let oldBuildInfo :: BuildInfo
oldBuildInfo = Library -> BuildInfo
Library.libBuildInfo Library
library
    in
        case ModuleName -> [ModuleName] -> Maybe [ModuleName]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove ModuleName
velmaDiscover ([ModuleName] -> Maybe [ModuleName])
-> [ModuleName] -> Maybe [ModuleName]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
BuildInfo.otherModules BuildInfo
oldBuildInfo of
            Maybe [ModuleName]
Nothing -> Library
library
            Just [ModuleName]
otherModules ->
                let
                    directories :: Set FilePath
directories = BuildInfo -> Set FilePath
getHsSourceDirs BuildInfo
oldBuildInfo
                    entries :: [FilePath]
entries = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> (Map FilePath [FilePath] -> [[FilePath]])
-> Map FilePath [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath [FilePath] -> [[FilePath]]
forall k a. Map k a -> [a]
Map.elems (Map FilePath [FilePath] -> [FilePath])
-> Map FilePath [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Set FilePath -> Map FilePath [FilePath]
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys
                        Map FilePath [FilePath]
directoryContents
                        Set FilePath
directories
                    exposedModules :: Set ModuleName
exposedModules =
                        [ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
Set.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ Library -> [ModuleName]
Library.exposedModules Library
library
                    discovered :: [ModuleName]
discovered =
                        (ModuleName -> Bool) -> [ModuleName] -> [ModuleName]
forall a. (a -> Bool) -> [a] -> [a]
filter (ModuleName -> Set ModuleName -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set ModuleName
exposedModules)
                            ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Maybe ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe FilePath -> Maybe ModuleName
filePathToModuleName [FilePath]
entries
                    allModules :: [ModuleName]
allModules = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ListUtils.nubOrd ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
otherModules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> [ModuleName]
discovered
                    newBuildInfo :: BuildInfo
newBuildInfo =
                        BuildInfo
oldBuildInfo { otherModules :: [ModuleName]
BuildInfo.otherModules = [ModuleName]
allModules }
                in Library
library { libBuildInfo :: BuildInfo
Library.libBuildInfo = BuildInfo
newBuildInfo }

discoverOtherModules
    :: Map.Map FilePath [FilePath]
    -> BuildInfo.BuildInfo
    -> BuildInfo.BuildInfo
discoverOtherModules :: Map FilePath [FilePath] -> BuildInfo -> BuildInfo
discoverOtherModules Map FilePath [FilePath]
directoryContents BuildInfo
buildInfo =
    case ModuleName -> [ModuleName] -> Maybe [ModuleName]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove ModuleName
velmaDiscover ([ModuleName] -> Maybe [ModuleName])
-> [ModuleName] -> Maybe [ModuleName]
forall a b. (a -> b) -> a -> b
$ BuildInfo -> [ModuleName]
BuildInfo.otherModules BuildInfo
buildInfo of
        Maybe [ModuleName]
Nothing -> BuildInfo
buildInfo
        Just [ModuleName]
otherModules ->
            let
                directories :: Set FilePath
directories = BuildInfo -> Set FilePath
getHsSourceDirs BuildInfo
buildInfo
                entries :: [FilePath]
entries = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> [FilePath])
-> (Map FilePath [FilePath] -> [[FilePath]])
-> Map FilePath [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map FilePath [FilePath] -> [[FilePath]]
forall k a. Map k a -> [a]
Map.elems (Map FilePath [FilePath] -> [FilePath])
-> Map FilePath [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map FilePath [FilePath] -> Set FilePath -> Map FilePath [FilePath]
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys
                    Map FilePath [FilePath]
directoryContents
                    Set FilePath
directories
                discovered :: [ModuleName]
discovered = (FilePath -> Maybe ModuleName) -> [FilePath] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe FilePath -> Maybe ModuleName
filePathToModuleName [FilePath]
entries
                allModules :: [ModuleName]
allModules = [ModuleName] -> [ModuleName]
forall a. Ord a => [a] -> [a]
ListUtils.nubOrd ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [ModuleName]
otherModules [ModuleName] -> [ModuleName] -> [ModuleName]
forall a. Semigroup a => a -> a -> a
<> [ModuleName]
discovered
            in BuildInfo
buildInfo { otherModules :: [ModuleName]
BuildInfo.otherModules = [ModuleName]
allModules }

getHsSourceDirs :: BuildInfo.BuildInfo -> Set.Set FilePath
getHsSourceDirs :: BuildInfo -> Set FilePath
getHsSourceDirs =
    [FilePath] -> Set FilePath
forall a. Ord a => [a] -> Set a
Set.fromList
        ([FilePath] -> Set FilePath)
-> (BuildInfo -> [FilePath]) -> BuildInfo -> Set FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t a -> t a -> t a
withDefault [FilePath
"."]
        ([FilePath] -> [FilePath])
-> (BuildInfo -> [FilePath]) -> BuildInfo -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SymbolicPath PackageDir SourceDir -> FilePath)
-> [SymbolicPath PackageDir SourceDir] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath PackageDir SourceDir -> FilePath
forall a b. SymbolicPath a b -> FilePath
SymbolicPath.toFilePath
        ([SymbolicPath PackageDir SourceDir] -> [FilePath])
-> (BuildInfo -> [SymbolicPath PackageDir SourceDir])
-> BuildInfo
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath PackageDir SourceDir]
BuildInfo.hsSourceDirs

maybeRemove :: Eq a => a -> [a] -> Maybe [a]
maybeRemove :: a -> [a] -> Maybe [a]
maybeRemove a
x [a]
ys = case [a]
ys of
    [] -> Maybe [a]
forall a. Maybe a
Nothing
    a
y : [a]
zs -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y then [a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
zs else (:) a
y ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a] -> Maybe [a]
forall a. Eq a => a -> [a] -> Maybe [a]
maybeRemove a
x [a]
zs

velmaDiscover :: ModuleName.ModuleName
velmaDiscover :: ModuleName
velmaDiscover = FilePath -> ModuleName
forall a. IsString a => FilePath -> a
ModuleName.fromString FilePath
"Velma.Discover"

filePathToModuleName :: FilePath -> Maybe ModuleName.ModuleName
filePathToModuleName :: FilePath -> Maybe ModuleName
filePathToModuleName FilePath
filePath = do
    FilePath
base <- FilePath -> FilePath -> Maybe FilePath
FilePath.stripExtension FilePath
"hs" FilePath
filePath
    FilePath -> Maybe ModuleName
forall a. Parsec a => FilePath -> Maybe a
Parsec.simpleParsec (FilePath -> Maybe ModuleName)
-> ([FilePath] -> FilePath) -> [FilePath] -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
"." ([FilePath] -> Maybe ModuleName) -> [FilePath] -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
FilePath.splitDirectories FilePath
base

withDefault :: Foldable t => t a -> t a -> t a
withDefault :: t a -> t a -> t a
withDefault t a
d t a
x = if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
x then t a
d else t a
x

listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively :: FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
directory = do
    [FilePath]
entries <- FilePath -> IO [FilePath]
listDirectory FilePath
directory
    (FilePath -> IO [FilePath]) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) b (t :: * -> *) a.
(Applicative m, Monoid b, Traversable t) =>
(a -> m b) -> t a -> m b
foldTraverse FilePath -> IO [FilePath]
listDirectoryHelper [FilePath]
entries

listDirectory :: FilePath -> IO [FilePath]
listDirectory :: FilePath -> IO [FilePath]
listDirectory FilePath
directory =
    (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
FilePath.combine FilePath
directory) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
Directory.listDirectory FilePath
directory

foldTraverse
    :: (Applicative m, Monoid b, Traversable t) => (a -> m b) -> t a -> m b
foldTraverse :: (a -> m b) -> t a -> m b
foldTraverse a -> m b
f = (t b -> b) -> m (t b) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap t b -> b
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold (m (t b) -> m b) -> (t a -> m (t b)) -> t a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> t a -> m (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m b
f

listDirectoryHelper :: FilePath -> IO [FilePath]
listDirectoryHelper :: FilePath -> IO [FilePath]
listDirectoryHelper FilePath
entry = do
    Bool
isDirectory <- FilePath -> IO Bool
Directory.doesDirectoryExist FilePath
entry
    if Bool
isDirectory then FilePath -> IO [FilePath]
listDirectoryRecursively FilePath
entry else [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [FilePath
entry]