{-# LANGUAGE CPP #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- | Dealing with Cabal.

module Stack.Package
  (readDotBuildinfo
  ,resolvePackage
  ,packageFromPackageDescription
  ,Package(..)
  ,PackageDescriptionPair(..)
  ,GetPackageFiles(..)
  ,GetPackageOpts(..)
  ,PackageConfig(..)
  ,buildLogPath
  ,PackageException (..)
  ,resolvePackageDescription
  ,packageDependencies
  ,applyForceCustomBuild
  ) where

import           Data.List (find, isPrefixOf, unzip)
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import           Distribution.Compiler
import           Distribution.ModuleName (ModuleName)
import qualified Distribution.ModuleName as Cabal
import qualified Distribution.Package as D
import           Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
import qualified Distribution.PackageDescription as D
import           Distribution.PackageDescription hiding (FlagName)
import           Distribution.PackageDescription.Parsec
import           Distribution.Pretty (prettyShow)
import           Distribution.Simple.Glob (matchDirFileGlob)
import           Distribution.System (OS (..), Arch, Platform (..))
import qualified Distribution.Text as D
import qualified Distribution.Types.CondTree as Cabal
import qualified Distribution.Types.ExeDependency as Cabal
import           Distribution.Types.ForeignLib
import qualified Distribution.Types.LegacyExeDependency as Cabal
import           Distribution.Types.LibraryName (libraryNameString, maybeToLibraryName)
import           Distribution.Types.MungedPackageName
import qualified Distribution.Types.UnqualComponentName as Cabal
import qualified Distribution.Verbosity as D
import           Distribution.Version (mkVersion, orLaterVersion, anyVersion)
import qualified HiFileParser as Iface
#if MIN_VERSION_path(0,7,0)
import           Path as FL hiding (replaceExtension)
#else
import           Path as FL
#endif
import           Path.Extra
import           Path.IO hiding (findFiles)
import           Stack.Build.Installed
import           Stack.Constants
import           Stack.Constants.Config
import           Stack.Prelude hiding (Display (..))
import           Stack.Types.Compiler
import           Stack.Types.Config
import           Stack.Types.GhcPkgId
import           Stack.Types.NamedComponent
import           Stack.Types.Package
import           Stack.Types.Version
import qualified System.Directory as D
import           System.FilePath (replaceExtension)
import qualified System.FilePath as FilePath
import           System.IO.Error
import           RIO.Process
import           RIO.PrettyPrint
import qualified RIO.PrettyPrint as PP (Style (Module))

data Ctx = Ctx { Ctx -> Path Abs File
ctxFile :: !(Path Abs File)
               , Ctx -> Path Abs Dir
ctxDistDir :: !(Path Abs Dir)
               , Ctx -> BuildConfig
ctxBuildConfig :: !BuildConfig
               , Ctx -> Version
ctxCabalVer :: !Version
               }

instance HasPlatform Ctx
instance HasGHCVariant Ctx
instance HasLogFunc Ctx where
    logFuncL :: (LogFunc -> f LogFunc) -> Ctx -> f Ctx
logFuncL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((LogFunc -> f LogFunc) -> Config -> f Config)
-> (LogFunc -> f LogFunc)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LogFunc -> f LogFunc) -> Config -> f Config
forall env. HasLogFunc env => Lens' env LogFunc
logFuncL
instance HasRunner Ctx where
    runnerL :: (Runner -> f Runner) -> Ctx -> f Ctx
runnerL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((Runner -> f Runner) -> Config -> f Config)
-> (Runner -> f Runner)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Runner -> f Runner) -> Config -> f Config
forall env. HasRunner env => Lens' env Runner
runnerL
instance HasStylesUpdate Ctx where
  stylesUpdateL :: (StylesUpdate -> f StylesUpdate) -> Ctx -> f Ctx
stylesUpdateL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((StylesUpdate -> f StylesUpdate) -> Runner -> f Runner)
-> (StylesUpdate -> f StylesUpdate)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StylesUpdate -> f StylesUpdate) -> Runner -> f Runner
forall env. HasStylesUpdate env => Lens' env StylesUpdate
stylesUpdateL
instance HasTerm Ctx where
  useColorL :: (Bool -> f Bool) -> Ctx -> f Ctx
useColorL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Bool -> f Bool) -> Runner -> f Runner)
-> (Bool -> f Bool)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> f Bool) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Bool
useColorL
  termWidthL :: (Int -> f Int) -> Ctx -> f Ctx
termWidthL = (Runner -> f Runner) -> Ctx -> f Ctx
forall env. HasRunner env => Lens' env Runner
runnerL((Runner -> f Runner) -> Ctx -> f Ctx)
-> ((Int -> f Int) -> Runner -> f Runner)
-> (Int -> f Int)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> f Int) -> Runner -> f Runner
forall env. HasTerm env => Lens' env Int
termWidthL
instance HasConfig Ctx
instance HasPantryConfig Ctx where
    pantryConfigL :: (PantryConfig -> f PantryConfig) -> Ctx -> f Ctx
pantryConfigL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((PantryConfig -> f PantryConfig) -> Config -> f Config)
-> (PantryConfig -> f PantryConfig)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(PantryConfig -> f PantryConfig) -> Config -> f Config
forall env. HasPantryConfig env => Lens' env PantryConfig
pantryConfigL
instance HasProcessContext Ctx where
    processContextL :: (ProcessContext -> f ProcessContext) -> Ctx -> f Ctx
processContextL = (Config -> f Config) -> Ctx -> f Ctx
forall env. HasConfig env => Lens' env Config
configL((Config -> f Config) -> Ctx -> f Ctx)
-> ((ProcessContext -> f ProcessContext) -> Config -> f Config)
-> (ProcessContext -> f ProcessContext)
-> Ctx
-> f Ctx
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ProcessContext -> f ProcessContext) -> Config -> f Config
forall env. HasProcessContext env => Lens' env ProcessContext
processContextL
instance HasBuildConfig Ctx where
    buildConfigL :: (BuildConfig -> f BuildConfig) -> Ctx -> f Ctx
buildConfigL = (Ctx -> BuildConfig)
-> (Ctx -> BuildConfig -> Ctx) -> Lens' Ctx BuildConfig
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Ctx -> BuildConfig
ctxBuildConfig (\Ctx
x BuildConfig
y -> Ctx
x { ctxBuildConfig :: BuildConfig
ctxBuildConfig = BuildConfig
y })

-- | Read @<package>.buildinfo@ ancillary files produced by some Setup.hs hooks.
-- The file includes Cabal file syntax to be merged into the package description
-- derived from the package's .cabal file.
--
-- NOTE: not to be confused with BuildInfo, an Stack-internal datatype.
readDotBuildinfo :: MonadIO m
                 => Path Abs File
                 -> m HookedBuildInfo
readDotBuildinfo :: Path Abs File -> m HookedBuildInfo
readDotBuildinfo Path Abs File
buildinfofp =
    IO HookedBuildInfo -> m HookedBuildInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO HookedBuildInfo -> m HookedBuildInfo)
-> IO HookedBuildInfo -> m HookedBuildInfo
forall a b. (a -> b) -> a -> b
$ Verbosity -> FilePath -> IO HookedBuildInfo
readHookedBuildInfo Verbosity
D.silent (Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs File
buildinfofp)

-- | Resolve a parsed cabal file into a 'Package', which contains all of
-- the info needed for stack to build the 'Package' given the current
-- configuration.
resolvePackage :: PackageConfig
               -> GenericPackageDescription
               -> Package
resolvePackage :: PackageConfig -> GenericPackageDescription -> Package
resolvePackage PackageConfig
packageConfig GenericPackageDescription
gpkg =
    PackageConfig -> [Flag] -> PackageDescriptionPair -> Package
packageFromPackageDescription
        PackageConfig
packageConfig
        (GenericPackageDescription -> [Flag]
genPackageFlags GenericPackageDescription
gpkg)
        (PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig GenericPackageDescription
gpkg)

packageFromPackageDescription :: PackageConfig
                              -> [D.Flag]
                              -> PackageDescriptionPair
                              -> Package
packageFromPackageDescription :: PackageConfig -> [Flag] -> PackageDescriptionPair -> Package
packageFromPackageDescription PackageConfig
packageConfig [Flag]
pkgFlags (PackageDescriptionPair PackageDescription
pkgNoMod PackageDescription
pkg) =
    Package :: PackageName
-> Version
-> Either License License
-> GetPackageFiles
-> Map PackageName DepValue
-> Set ExeName
-> Set PackageName
-> [Text]
-> [Text]
-> Map FlagName Bool
-> Map FlagName Bool
-> PackageLibraries
-> Set Text
-> Map Text TestSuiteInterface
-> Set Text
-> Set Text
-> GetPackageOpts
-> Bool
-> BuildType
-> Maybe (Map PackageName VersionRange)
-> VersionRange
-> Package
Package
    { packageName :: PackageName
packageName = PackageName
name
    , packageVersion :: Version
packageVersion = PackageIdentifier -> Version
pkgVersion PackageIdentifier
pkgId
    , packageLicense :: Either License License
packageLicense = PackageDescription -> Either License License
licenseRaw PackageDescription
pkg
    , packageDeps :: Map PackageName DepValue
packageDeps = Map PackageName DepValue
deps
    , packageFiles :: GetPackageFiles
packageFiles = GetPackageFiles
pkgFiles
    , packageUnknownTools :: Set ExeName
packageUnknownTools = Set ExeName
unknownTools
    , packageGhcOptions :: [Text]
packageGhcOptions = PackageConfig -> [Text]
packageConfigGhcOptions PackageConfig
packageConfig
    , packageCabalConfigOpts :: [Text]
packageCabalConfigOpts = PackageConfig -> [Text]
packageConfigCabalConfigOpts PackageConfig
packageConfig
    , packageFlags :: Map FlagName Bool
packageFlags = PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig
    , packageDefaultFlags :: Map FlagName Bool
packageDefaultFlags = [(FlagName, Bool)] -> Map FlagName Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(Flag -> FlagName
flagName Flag
flag, Flag -> Bool
flagDefault Flag
flag) | Flag
flag <- [Flag]
pkgFlags]
    , packageAllDeps :: Set PackageName
packageAllDeps = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList (Map PackageName DepValue -> [PackageName]
forall k a. Map k a -> [k]
M.keys Map PackageName DepValue
deps)
    , packageLibraries :: PackageLibraries
packageLibraries =
        let mlib :: Maybe Library
mlib = do
              Library
lib <- PackageDescription -> Maybe Library
library PackageDescription
pkg
              Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ BuildInfo -> Bool
buildable (BuildInfo -> Bool) -> BuildInfo -> Bool
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
              Library -> Maybe Library
forall a. a -> Maybe a
Just Library
lib
         in
          case Maybe Library
mlib of
            Maybe Library
Nothing -> PackageLibraries
NoLibraries
            Just Library
_ -> Set Text -> PackageLibraries
HasLibraries Set Text
foreignLibNames
    , packageInternalLibraries :: Set Text
packageInternalLibraries = Set Text
subLibNames
    , packageTests :: Map Text TestSuiteInterface
packageTests = [(Text, TestSuiteInterface)] -> Map Text TestSuiteInterface
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
      [(FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ TestSuite -> UnqualComponentName
testName TestSuite
t), TestSuite -> TestSuiteInterface
testInterface TestSuite
t)
          | TestSuite
t <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkgNoMod
          , BuildInfo -> Bool
buildable (TestSuite -> BuildInfo
testBuildInfo TestSuite
t)
      ]
    , packageBenchmarks :: Set Text
packageBenchmarks = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      [FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Benchmark -> UnqualComponentName
benchmarkName Benchmark
b)
          | Benchmark
b <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkgNoMod
          , BuildInfo -> Bool
buildable (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b)
      ]
        -- Same comment about buildable applies here too.
    , packageExes :: Set Text
packageExes = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      [FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> UnqualComponentName -> FilePath
forall a b. (a -> b) -> a -> b
$ Executable -> UnqualComponentName
exeName Executable
biBuildInfo)
        | Executable
biBuildInfo <- PackageDescription -> [Executable]
executables PackageDescription
pkg
                                    , BuildInfo -> Bool
buildable (Executable -> BuildInfo
buildInfo Executable
biBuildInfo)]
    -- This is an action used to collect info needed for "stack ghci".
    -- This info isn't usually needed, so computation of it is deferred.
    , packageOpts :: GetPackageOpts
packageOpts = (forall env.
 HasEnvConfig env =>
 InstallMap
 -> InstalledMap
 -> [PackageName]
 -> [PackageName]
 -> Path Abs File
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath],
       Map NamedComponent BuildInfoOpts))
-> GetPackageOpts
GetPackageOpts ((forall env.
  HasEnvConfig env =>
  InstallMap
  -> InstalledMap
  -> [PackageName]
  -> [PackageName]
  -> Path Abs File
  -> RIO
       env
       (Map NamedComponent (Map ModuleName (Path Abs File)),
        Map NamedComponent [DotCabalPath],
        Map NamedComponent BuildInfoOpts))
 -> GetPackageOpts)
-> (forall env.
    HasEnvConfig env =>
    InstallMap
    -> InstalledMap
    -> [PackageName]
    -> [PackageName]
    -> Path Abs File
    -> RIO
         env
         (Map NamedComponent (Map ModuleName (Path Abs File)),
          Map NamedComponent [DotCabalPath],
          Map NamedComponent BuildInfoOpts))
-> GetPackageOpts
forall a b. (a -> b) -> a -> b
$
      \InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp ->
           do (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules,Map NamedComponent [DotCabalPath]
componentFiles,Set (Path Abs File)
_,[PackageWarning]
_) <- GetPackageFiles
-> Path Abs File
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
GetPackageFiles
-> forall env.
   HasEnvConfig env =>
   Path Abs File
   -> RIO
        env
        (Map NamedComponent (Map ModuleName (Path Abs File)),
         Map NamedComponent [DotCabalPath], Set (Path Abs File),
         [PackageWarning])
getPackageFiles GetPackageFiles
pkgFiles Path Abs File
cabalfp
              let internals :: [Text]
internals = Set Text -> [Text]
forall a. Set a -> [a]
S.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Set NamedComponent -> Set Text
internalLibComponents (Set NamedComponent -> Set Text) -> Set NamedComponent -> Set Text
forall a b. (a -> b) -> a -> b
$ Map NamedComponent (Map ModuleName (Path Abs File))
-> Set NamedComponent
forall k a. Map k a -> Set k
M.keysSet Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules
              [PackageName]
excludedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => FilePath -> m PackageName
parsePackageNameThrowing (FilePath -> RIO env PackageName)
-> (Text -> FilePath) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) [Text]
internals
              [PackageName]
mungedInternals <- (Text -> RIO env PackageName) -> [Text] -> RIO env [PackageName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath -> RIO env PackageName
forall (m :: * -> *). MonadThrow m => FilePath -> m PackageName
parsePackageNameThrowing (FilePath -> RIO env PackageName)
-> (Text -> FilePath) -> Text -> RIO env PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath) -> (Text -> Text) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                       Text -> Text
toInternalPackageMungedName) [Text]
internals
              Map NamedComponent BuildInfoOpts
componentsOpts <-
                  InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> RIO env (Map NamedComponent BuildInfoOpts)
forall env (m :: * -> *).
(HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m) =>
InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts InstallMap
installMap InstalledMap
installedMap
                  ([PackageName]
excludedInternals [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
omitPkgs) ([PackageName]
mungedInternals [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++ [PackageName]
addPkgs)
                  Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentFiles
              (Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath],
 Map NamedComponent BuildInfoOpts)
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath],
      Map NamedComponent BuildInfoOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
componentsModules,Map NamedComponent [DotCabalPath]
componentFiles,Map NamedComponent BuildInfoOpts
componentsOpts)
    , packageHasExposedModules :: Bool
packageHasExposedModules = Bool -> (Library -> Bool) -> Maybe Library -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Bool
False
          (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool)
-> (Library -> [ModuleName]) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> [ModuleName]
exposedModules)
          (PackageDescription -> Maybe Library
library PackageDescription
pkg)
    , packageBuildType :: BuildType
packageBuildType = PackageDescription -> BuildType
buildType PackageDescription
pkg
    , packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Maybe (Map PackageName VersionRange)
msetupDeps
    , packageCabalSpec :: VersionRange
packageCabalSpec = (Version -> VersionRange)
-> (VersionRange -> VersionRange)
-> Either Version VersionRange
-> VersionRange
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> VersionRange
orLaterVersion VersionRange -> VersionRange
forall a. a -> a
id (Either Version VersionRange -> VersionRange)
-> Either Version VersionRange -> VersionRange
forall a b. (a -> b) -> a -> b
$ PackageDescription -> Either Version VersionRange
specVersionRaw PackageDescription
pkg
    }
  where
    extraLibNames :: Set Text
extraLibNames = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
subLibNames Set Text
foreignLibNames

    subLibNames :: Set Text
subLibNames
      = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (UnqualComponentName -> Text) -> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (UnqualComponentName -> FilePath) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName)
      ([UnqualComponentName] -> [Text])
-> [UnqualComponentName] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Library -> Maybe UnqualComponentName)
-> [Library] -> [UnqualComponentName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) -- this is a design bug in the Cabal API: this should statically be known to exist
      ([Library] -> [UnqualComponentName])
-> [Library] -> [UnqualComponentName]
forall a b. (a -> b) -> a -> b
$ (Library -> Bool) -> [Library] -> [Library]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool) -> (Library -> BuildInfo) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
      ([Library] -> [Library]) -> [Library] -> [Library]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [Library]
subLibraries PackageDescription
pkg

    foreignLibNames :: Set Text
foreignLibNames
      = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList
      ([Text] -> Set Text) -> [Text] -> Set Text
forall a b. (a -> b) -> a -> b
$ (ForeignLib -> Text) -> [ForeignLib] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Text
T.pack (FilePath -> Text)
-> (ForeignLib -> FilePath) -> ForeignLib -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (ForeignLib -> UnqualComponentName) -> ForeignLib -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> UnqualComponentName
foreignLibName)
      ([ForeignLib] -> [Text]) -> [ForeignLib] -> [Text]
forall a b. (a -> b) -> a -> b
$ (ForeignLib -> Bool) -> [ForeignLib] -> [ForeignLib]
forall a. (a -> Bool) -> [a] -> [a]
filter (BuildInfo -> Bool
buildable (BuildInfo -> Bool)
-> (ForeignLib -> BuildInfo) -> ForeignLib -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignLib -> BuildInfo
foreignLibBuildInfo)
      ([ForeignLib] -> [ForeignLib]) -> [ForeignLib] -> [ForeignLib]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg

    toInternalPackageMungedName :: Text -> Text
toInternalPackageMungedName
      = FilePath -> Text
T.pack (FilePath -> Text) -> (Text -> FilePath) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MungedPackageName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow (MungedPackageName -> FilePath)
-> (Text -> MungedPackageName) -> Text -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> LibraryName -> MungedPackageName
MungedPackageName (PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId)
      (LibraryName -> MungedPackageName)
-> (Text -> LibraryName) -> Text -> MungedPackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe UnqualComponentName -> LibraryName
maybeToLibraryName (Maybe UnqualComponentName -> LibraryName)
-> (Text -> Maybe UnqualComponentName) -> Text -> LibraryName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> Maybe UnqualComponentName
forall a. a -> Maybe a
Just (UnqualComponentName -> Maybe UnqualComponentName)
-> (Text -> UnqualComponentName)
-> Text
-> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UnqualComponentName
Cabal.mkUnqualComponentName (FilePath -> UnqualComponentName)
-> (Text -> FilePath) -> Text -> UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack

    -- Gets all of the modules, files, build files, and data files that
    -- constitute the package. This is primarily used for dirtiness
    -- checking during build, as well as use by "stack ghci"
    pkgFiles :: GetPackageFiles
pkgFiles = (forall env.
 HasEnvConfig env =>
 Path Abs File
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], Set (Path Abs File),
       [PackageWarning]))
-> GetPackageFiles
GetPackageFiles ((forall env.
  HasEnvConfig env =>
  Path Abs File
  -> RIO
       env
       (Map NamedComponent (Map ModuleName (Path Abs File)),
        Map NamedComponent [DotCabalPath], Set (Path Abs File),
        [PackageWarning]))
 -> GetPackageFiles)
-> (forall env.
    HasEnvConfig env =>
    Path Abs File
    -> RIO
         env
         (Map NamedComponent (Map ModuleName (Path Abs File)),
          Map NamedComponent [DotCabalPath], Set (Path Abs File),
          [PackageWarning]))
-> GetPackageFiles
forall a b. (a -> b) -> a -> b
$
        \Path Abs File
cabalfp -> StyleDoc
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall env (m :: * -> *) a.
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m,
 MonadUnliftIO m) =>
StyleDoc -> m a -> m a
debugBracket (StyleDoc
"getPackageFiles" StyleDoc -> StyleDoc -> StyleDoc
<+> Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
cabalfp) (RIO
   env
   (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], Set (Path Abs File),
    [PackageWarning])
 -> RIO
      env
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], Set (Path Abs File),
       [PackageWarning]))
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall a b. (a -> b) -> a -> b
$ do
             let pkgDir :: Path Abs Dir
pkgDir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp
             Path Abs Dir
distDir <- Path Abs Dir -> RIO env (Path Abs Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
pkgDir
             BuildConfig
bc <- Getting BuildConfig env BuildConfig -> RIO env BuildConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting BuildConfig env BuildConfig
forall env. HasBuildConfig env => Lens' env BuildConfig
buildConfigL
             Version
cabalVer <- Getting Version env Version -> RIO env Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
             (Map NamedComponent (Map ModuleName (Path Abs File))
componentModules,Map NamedComponent [DotCabalPath]
componentFiles,Set (Path Abs File)
dataFiles',[PackageWarning]
warnings) <-
                 Ctx
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall (m :: * -> *) env a. MonadIO m => env -> RIO env a -> m a
runRIO
                     (Path Abs File -> Path Abs Dir -> BuildConfig -> Version -> Ctx
Ctx Path Abs File
cabalfp Path Abs Dir
distDir BuildConfig
bc Version
cabalVer)
                     (PackageDescription
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
packageDescModulesAndFiles PackageDescription
pkg)
             Set (Path Abs File)
setupFiles <-
                 if PackageDescription -> BuildType
buildType PackageDescription
pkg BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Custom
                 then do
                     let setupHsPath :: Path Abs File
setupHsPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupHs
                         setupLhsPath :: Path Abs File
setupLhsPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileSetupLhs
                     Bool
setupHsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupHsPath
                     if Bool
setupHsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupHsPath) else do
                         Bool
setupLhsExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
setupLhsPath
                         if Bool
setupLhsExists then Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
setupLhsPath) else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return Set (Path Abs File)
forall a. Set a
S.empty
                 else Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return Set (Path Abs File)
forall a. Set a
S.empty
             Set (Path Abs File)
buildFiles <- (Set (Path Abs File) -> Set (Path Abs File))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Path Abs File -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => a -> Set a -> Set a
S.insert Path Abs File
cabalfp (Set (Path Abs File) -> Set (Path Abs File))
-> (Set (Path Abs File) -> Set (Path Abs File))
-> Set (Path Abs File)
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Ord a => Set a -> Set a -> Set a
S.union Set (Path Abs File)
setupFiles) (RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File)))
-> RIO env (Set (Path Abs File)) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ do
                 let hpackPath :: Path Abs File
hpackPath = Path Abs Dir
pkgDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileHpackPackageConfig
                 Bool
hpackExists <- Path Abs File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
hpackPath
                 Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (Path Abs File) -> RIO env (Set (Path Abs File)))
-> Set (Path Abs File) -> RIO env (Set (Path Abs File))
forall a b. (a -> b) -> a -> b
$ if Bool
hpackExists then Path Abs File -> Set (Path Abs File)
forall a. a -> Set a
S.singleton Path Abs File
hpackPath else Set (Path Abs File)
forall a. Set a
S.empty
             (Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath], Set (Path Abs File),
 [PackageWarning])
-> RIO
     env
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
componentModules, Map NamedComponent [DotCabalPath]
componentFiles, Set (Path Abs File)
buildFiles Set (Path Abs File) -> Set (Path Abs File) -> Set (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> Set (Path Abs File)
dataFiles', [PackageWarning]
warnings)
    pkgId :: PackageIdentifier
pkgId = PackageDescription -> PackageIdentifier
package PackageDescription
pkg
    name :: PackageName
name = PackageIdentifier -> PackageName
pkgName PackageIdentifier
pkgId

    (Set ExeName
unknownTools, Map PackageName DepValue
knownTools) = PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pkg

    deps :: Map PackageName DepValue
deps = (PackageName -> DepValue -> Bool)
-> Map PackageName DepValue -> Map PackageName DepValue
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (Bool -> DepValue -> Bool
forall a b. a -> b -> a
const (Bool -> DepValue -> Bool)
-> (PackageName -> Bool) -> PackageName -> DepValue -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (PackageName -> Bool) -> PackageName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> Bool
isMe) ((DepValue -> DepValue -> DepValue)
-> [Map PackageName DepValue] -> Map PackageName DepValue
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>)
        [ VersionRange -> DepValue
asLibrary (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
packageConfig PackageDescription
pkg
        -- We include all custom-setup deps - if present - in the
        -- package deps themselves. Stack always works with the
        -- invariant that there will be a single installed package
        -- relating to a package name, and this applies at the setup
        -- dependency level as well.
        , VersionRange -> DepValue
asLibrary (VersionRange -> DepValue)
-> Map PackageName VersionRange -> Map PackageName DepValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
-> Map PackageName VersionRange
forall a. a -> Maybe a -> a
fromMaybe Map PackageName VersionRange
forall k a. Map k a
M.empty Maybe (Map PackageName VersionRange)
msetupDeps
        , Map PackageName DepValue
knownTools
        ])
    msetupDeps :: Maybe (Map PackageName VersionRange)
msetupDeps = (SetupBuildInfo -> Map PackageName VersionRange)
-> Maybe SetupBuildInfo -> Maybe (Map PackageName VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        ([(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> (SetupBuildInfo -> [(PackageName, VersionRange)])
-> SetupBuildInfo
-> Map PackageName VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> (SetupBuildInfo -> [Dependency])
-> SetupBuildInfo
-> [(PackageName, VersionRange)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SetupBuildInfo -> [Dependency]
setupDepends)
        (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)

    asLibrary :: VersionRange -> DepValue
asLibrary VersionRange
range = DepValue :: VersionRange -> DepType -> DepValue
DepValue
      { dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
      , dvType :: DepType
dvType = DepType
AsLibrary
      }

    -- Is the package dependency mentioned here me: either the package
    -- name itself, or the name of one of the sub libraries
    isMe :: PackageName -> Bool
isMe PackageName
name' = PackageName
name' PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
name Bool -> Bool -> Bool
|| FilePath -> Text
forall a. IsString a => FilePath -> a
fromString (PackageName -> FilePath
packageNameString PackageName
name') Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Text
extraLibNames

-- | Generate GHC options for the package's components, and a list of
-- options which apply generally to the package, not one specific
-- component.
generatePkgDescOpts
    :: (HasEnvConfig env, MonadThrow m, MonadReader env m, MonadIO m)
    => InstallMap
    -> InstalledMap
    -> [PackageName] -- ^ Packages to omit from the "-package" / "-package-id" flags
    -> [PackageName] -- ^ Packages to add to the "-package" flags
    -> Path Abs File
    -> PackageDescription
    -> Map NamedComponent [DotCabalPath]
    -> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts :: InstallMap
-> InstalledMap
-> [PackageName]
-> [PackageName]
-> Path Abs File
-> PackageDescription
-> Map NamedComponent [DotCabalPath]
-> m (Map NamedComponent BuildInfoOpts)
generatePkgDescOpts InstallMap
installMap InstalledMap
installedMap [PackageName]
omitPkgs [PackageName]
addPkgs Path Abs File
cabalfp PackageDescription
pkg Map NamedComponent [DotCabalPath]
componentPaths = do
    Config
config <- Getting Config env Config -> m Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
configL
    Version
cabalVer <- Getting Version env Version -> m Version
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Version env Version
forall env. HasCompiler env => SimpleGetter env Version
cabalVersionL
    Path Abs Dir
distDir <- Path Abs Dir -> m (Path Abs Dir)
forall (m :: * -> *) env.
(MonadThrow m, MonadReader env m, HasEnvConfig env) =>
Path Abs Dir -> m (Path Abs Dir)
distDirFromDir Path Abs Dir
cabalDir
    let generate :: NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
namedComponent BuildInfo
binfo =
            ( NamedComponent
namedComponent
            , BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput :: InstallMap
-> InstalledMap
-> Path Abs Dir
-> Path Abs Dir
-> [PackageName]
-> [PackageName]
-> BuildInfo
-> [DotCabalPath]
-> [FilePath]
-> [FilePath]
-> NamedComponent
-> Version
-> BioInput
BioInput
                { biInstallMap :: InstallMap
biInstallMap = InstallMap
installMap
                , biInstalledMap :: InstalledMap
biInstalledMap = InstalledMap
installedMap
                , biCabalDir :: Path Abs Dir
biCabalDir = Path Abs Dir
cabalDir
                , biDistDir :: Path Abs Dir
biDistDir = Path Abs Dir
distDir
                , biOmitPackages :: [PackageName]
biOmitPackages = [PackageName]
omitPkgs
                , biAddPackages :: [PackageName]
biAddPackages = [PackageName]
addPkgs
                , biBuildInfo :: BuildInfo
biBuildInfo = BuildInfo
binfo
                , biDotCabalPaths :: [DotCabalPath]
biDotCabalPaths = [DotCabalPath] -> Maybe [DotCabalPath] -> [DotCabalPath]
forall a. a -> Maybe a -> a
fromMaybe [] (NamedComponent
-> Map NamedComponent [DotCabalPath] -> Maybe [DotCabalPath]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup NamedComponent
namedComponent Map NamedComponent [DotCabalPath]
componentPaths)
                , biConfigLibDirs :: [FilePath]
biConfigLibDirs = Config -> [FilePath]
configExtraLibDirs Config
config
                , biConfigIncludeDirs :: [FilePath]
biConfigIncludeDirs = Config -> [FilePath]
configExtraIncludeDirs Config
config
                , biComponentName :: NamedComponent
biComponentName = NamedComponent
namedComponent
                , biCabalVersion :: Version
biCabalVersion = Version
cabalVer
                }
            )
    Map NamedComponent BuildInfoOpts
-> m (Map NamedComponent BuildInfoOpts)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [(NamedComponent, BuildInfoOpts)]
-> Map NamedComponent BuildInfoOpts
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              ([[(NamedComponent, BuildInfoOpts)]]
-> [(NamedComponent, BuildInfoOpts)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                   [ [(NamedComponent, BuildInfoOpts)]
-> (Library -> [(NamedComponent, BuildInfoOpts)])
-> Maybe Library
-> [(NamedComponent, BuildInfoOpts)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                         []
                         ((NamedComponent, BuildInfoOpts)
-> [(NamedComponent, BuildInfoOpts)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedComponent, BuildInfoOpts)
 -> [(NamedComponent, BuildInfoOpts)])
-> (Library -> (NamedComponent, BuildInfoOpts))
-> Library
-> [(NamedComponent, BuildInfoOpts)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate NamedComponent
CLib (BuildInfo -> (NamedComponent, BuildInfoOpts))
-> (Library -> BuildInfo)
-> Library
-> (NamedComponent, BuildInfoOpts)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo)
                         (PackageDescription -> Maybe Library
library PackageDescription
pkg)
                   , (Library -> Maybe (NamedComponent, BuildInfoOpts))
-> [Library] -> [(NamedComponent, BuildInfoOpts)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                         (\Library
sublib -> do
                            let maybeLib :: Maybe NamedComponent
maybeLib = Text -> NamedComponent
CInternalLib (Text -> NamedComponent)
-> (UnqualComponentName -> Text)
-> UnqualComponentName
-> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (UnqualComponentName -> FilePath) -> UnqualComponentName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> NamedComponent)
-> Maybe UnqualComponentName -> Maybe NamedComponent
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName) Library
sublib
                            (NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts))
-> BuildInfo -> NamedComponent -> (NamedComponent, BuildInfoOpts)
forall a b c. (a -> b -> c) -> b -> a -> c
flip NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate  (Library -> BuildInfo
libBuildInfo Library
sublib) (NamedComponent -> (NamedComponent, BuildInfoOpts))
-> Maybe NamedComponent -> Maybe (NamedComponent, BuildInfoOpts)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NamedComponent
maybeLib
                          )
                         (PackageDescription -> [Library]
subLibraries PackageDescription
pkg)
                   , (Executable -> (NamedComponent, BuildInfoOpts))
-> [Executable] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                         (\Executable
exe ->
                               NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                                    (Text -> NamedComponent
CExe (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Executable -> UnqualComponentName
exeName Executable
exe))))
                                    (Executable -> BuildInfo
buildInfo Executable
exe))
                         (PackageDescription -> [Executable]
executables PackageDescription
pkg)
                   , (Benchmark -> (NamedComponent, BuildInfoOpts))
-> [Benchmark] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                         (\Benchmark
bench ->
                               NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                                    (Text -> NamedComponent
CBench (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Benchmark -> UnqualComponentName
benchmarkName Benchmark
bench))))
                                    (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench))
                         (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg)
                   , (TestSuite -> (NamedComponent, BuildInfoOpts))
-> [TestSuite] -> [(NamedComponent, BuildInfoOpts)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                         (\TestSuite
test ->
                               NamedComponent -> BuildInfo -> (NamedComponent, BuildInfoOpts)
generate
                                    (Text -> NamedComponent
CTest (FilePath -> Text
T.pack (UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (TestSuite -> UnqualComponentName
testName TestSuite
test))))
                                    (TestSuite -> BuildInfo
testBuildInfo TestSuite
test))
                         (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg)]))
  where
    cabalDir :: Path Abs Dir
cabalDir = Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
cabalfp

-- | Input to 'generateBuildInfoOpts'
data BioInput = BioInput
    { BioInput -> InstallMap
biInstallMap :: !InstallMap
    , BioInput -> InstalledMap
biInstalledMap :: !InstalledMap
    , BioInput -> Path Abs Dir
biCabalDir :: !(Path Abs Dir)
    , BioInput -> Path Abs Dir
biDistDir :: !(Path Abs Dir)
    , BioInput -> [PackageName]
biOmitPackages :: ![PackageName]
    , BioInput -> [PackageName]
biAddPackages :: ![PackageName]
    , BioInput -> BuildInfo
biBuildInfo :: !BuildInfo
    , BioInput -> [DotCabalPath]
biDotCabalPaths :: ![DotCabalPath]
    , BioInput -> [FilePath]
biConfigLibDirs :: ![FilePath]
    , BioInput -> [FilePath]
biConfigIncludeDirs :: ![FilePath]
    , BioInput -> NamedComponent
biComponentName :: !NamedComponent
    , BioInput -> Version
biCabalVersion :: !Version
    }

-- | Generate GHC options for the target. Since Cabal also figures out
-- these options, currently this is only used for invoking GHCI (via
-- stack ghci).
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts :: BioInput -> BuildInfoOpts
generateBuildInfoOpts BioInput {[FilePath]
[PackageName]
[DotCabalPath]
BuildInfo
Version
InstallMap
InstalledMap
Path Abs Dir
NamedComponent
biCabalVersion :: Version
biComponentName :: NamedComponent
biConfigIncludeDirs :: [FilePath]
biConfigLibDirs :: [FilePath]
biDotCabalPaths :: [DotCabalPath]
biBuildInfo :: BuildInfo
biAddPackages :: [PackageName]
biOmitPackages :: [PackageName]
biDistDir :: Path Abs Dir
biCabalDir :: Path Abs Dir
biInstalledMap :: InstalledMap
biInstallMap :: InstallMap
biCabalVersion :: BioInput -> Version
biComponentName :: BioInput -> NamedComponent
biConfigIncludeDirs :: BioInput -> [FilePath]
biConfigLibDirs :: BioInput -> [FilePath]
biDotCabalPaths :: BioInput -> [DotCabalPath]
biBuildInfo :: BioInput -> BuildInfo
biAddPackages :: BioInput -> [PackageName]
biOmitPackages :: BioInput -> [PackageName]
biDistDir :: BioInput -> Path Abs Dir
biCabalDir :: BioInput -> Path Abs Dir
biInstalledMap :: BioInput -> InstalledMap
biInstallMap :: BioInput -> InstallMap
..} =
    BuildInfoOpts :: [FilePath]
-> [FilePath] -> [FilePath] -> Path Abs File -> BuildInfoOpts
BuildInfoOpts
        { bioOpts :: [FilePath]
bioOpts = [FilePath]
ghcOpts [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [FilePath]
cppOptions BuildInfo
biBuildInfo
        -- NOTE for future changes: Due to this use of nubOrd (and other uses
        -- downstream), these generated options must not rely on multiple
        -- argument sequences.  For example, ["--main-is", "Foo.hs", "--main-
        -- is", "Bar.hs"] would potentially break due to the duplicate
        -- "--main-is" being removed.
        --
        -- See https://github.com/commercialhaskell/stack/issues/1255
        , bioOneWordOpts :: [FilePath]
bioOneWordOpts = [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
nubOrd ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [[FilePath]
extOpts, [FilePath]
srcOpts, [FilePath]
includeOpts, [FilePath]
libOpts, [FilePath]
fworks, [FilePath]
cObjectFiles]
        , bioPackageFlags :: [FilePath]
bioPackageFlags = [FilePath]
deps
        , bioCabalMacros :: Path Abs File
bioCabalMacros = Path Abs Dir
componentAutogen Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileCabalMacrosH
        }
  where
    cObjectFiles :: [FilePath]
cObjectFiles =
        (Path Abs File -> Maybe FilePath) -> [Path Abs File] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Path Abs File -> FilePath)
-> Maybe (Path Abs File) -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Path Abs File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Maybe (Path Abs File) -> Maybe FilePath)
-> (Path Abs File -> Maybe (Path Abs File))
-> Path Abs File
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> Maybe (Path Abs File)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
biCabalDir NamedComponent
biComponentName Path Abs Dir
biDistDir)
                 [Path Abs File]
cfiles
    cfiles :: [Path Abs File]
cfiles = (DotCabalPath -> Maybe (Path Abs File))
-> [DotCabalPath] -> [Path Abs File]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalPath -> Maybe (Path Abs File)
dotCabalCFilePath [DotCabalPath]
biDotCabalPaths
    installVersion :: (a, b) -> b
installVersion = (a, b) -> b
forall a b. (a, b) -> b
snd
    -- Generates: -package=base -package=base16-bytestring-0.1.1.6 ...
    deps :: [FilePath]
deps =
        [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ case PackageName -> InstalledMap -> Maybe (InstallLocation, Installed)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstalledMap
biInstalledMap of
                Just (InstallLocation
_, Stack.Types.Package.Library PackageIdentifier
_ident GhcPkgId
ipid Maybe (Either License License)
_) -> [FilePath
"-package-id=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> GhcPkgId -> FilePath
ghcPkgIdString GhcPkgId
ipid]
                Maybe (InstallLocation, Installed)
_ -> [FilePath
"-package=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> PackageName -> FilePath
packageNameString PackageName
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>
                 FilePath
-> ((InstallLocation, Version) -> FilePath)
-> Maybe (InstallLocation, Version)
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" -- This empty case applies to e.g. base.
                     (((FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Version -> FilePath) -> Version -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> FilePath
versionString) (Version -> FilePath)
-> ((InstallLocation, Version) -> Version)
-> (InstallLocation, Version)
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstallLocation, Version) -> Version
forall a b. (a, b) -> b
installVersion)
                     (PackageName -> InstallMap -> Maybe (InstallLocation, Version)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PackageName
name InstallMap
biInstallMap)]
            | PackageName
name <- [PackageName]
pkgs]
    pkgs :: [PackageName]
pkgs =
        [PackageName]
biAddPackages [PackageName] -> [PackageName] -> [PackageName]
forall a. [a] -> [a] -> [a]
++
        [ PackageName
name
        | Dependency PackageName
name VersionRange
_ Set LibraryName
_ <- BuildInfo -> [Dependency]
targetBuildDepends BuildInfo
biBuildInfo -- TODO: cabal 3 introduced multiple public libraries in a single dependency
        , PackageName
name PackageName -> [PackageName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [PackageName]
biOmitPackages]
    PerCompilerFlavor [FilePath]
ghcOpts [FilePath]
_ = BuildInfo -> PerCompilerFlavor [FilePath]
options BuildInfo
biBuildInfo
    extOpts :: [FilePath]
extOpts = (Extension -> FilePath) -> [Extension] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-X" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (Extension -> FilePath) -> Extension -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
forall a. Pretty a => a -> FilePath
D.display) (BuildInfo -> [Extension]
usedExtensions BuildInfo
biBuildInfo)
    srcOpts :: [FilePath]
srcOpts =
        (Path Abs Dir -> FilePath) -> [Path Abs Dir] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((FilePath
"-i" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (FilePath -> FilePath)
-> (Path Abs Dir -> FilePath) -> Path Abs Dir -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep)
            ([[Path Abs Dir]] -> [Path Abs Dir]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
              [ [ Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir ]
              , [ Path Abs Dir
biCabalDir
                | [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
biBuildInfo)
                ]
              , (FilePath -> Maybe (Path Abs Dir)) -> [FilePath] -> [Path Abs Dir]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe FilePath -> Maybe (Path Abs Dir)
toIncludeDir (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
biBuildInfo)
              , [ Path Abs Dir
componentAutogen ]
              , Maybe (Path Abs Dir) -> [Path Abs Dir]
forall a. Maybe a -> [a]
maybeToList (Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
biCabalVersion Path Abs Dir
biDistDir)
              , [ NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
biComponentName Path Abs Dir
biDistDir ]
              ]) [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++
        [ FilePath
"-stubdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep (Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
biDistDir) ]
    componentAutogen :: Path Abs Dir
componentAutogen = Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
biCabalVersion NamedComponent
biComponentName Path Abs Dir
biDistDir
    toIncludeDir :: FilePath -> Maybe (Path Abs Dir)
toIncludeDir FilePath
"." = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just Path Abs Dir
biCabalDir
    toIncludeDir FilePath
relDir = Path Abs Dir -> FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
concatAndColapseAbsDir Path Abs Dir
biCabalDir FilePath
relDir
    includeOpts :: [FilePath]
includeOpts =
        (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-I" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) ([FilePath]
biConfigIncludeDirs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
pkgIncludeOpts)
    pkgIncludeOpts :: [FilePath]
pkgIncludeOpts =
        [ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
absDir
        | FilePath
dir <- BuildInfo -> [FilePath]
includeDirs BuildInfo
biBuildInfo
        , Path Abs Dir
absDir <- FilePath -> [Path Abs Dir]
handleDir FilePath
dir
        ]
    libOpts :: [FilePath]
libOpts =
        (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-l" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) (BuildInfo -> [FilePath]
extraLibs BuildInfo
biBuildInfo) [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<>
        (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"-L" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<>) ([FilePath]
biConfigLibDirs [FilePath] -> [FilePath] -> [FilePath]
forall a. Semigroup a => a -> a -> a
<> [FilePath]
pkgLibDirs)
    pkgLibDirs :: [FilePath]
pkgLibDirs =
        [ Path Abs Dir -> FilePath
forall loc. Path loc Dir -> FilePath
toFilePathNoTrailingSep Path Abs Dir
absDir
        | FilePath
dir <- BuildInfo -> [FilePath]
extraLibDirs BuildInfo
biBuildInfo
        , Path Abs Dir
absDir <- FilePath -> [Path Abs Dir]
handleDir FilePath
dir
        ]
    handleDir :: FilePath -> [Path Abs Dir]
handleDir FilePath
dir = case (FilePath -> Maybe (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs Dir)
parseAbsDir FilePath
dir, FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir FilePath
dir) of
       (Just Path Abs Dir
ab, Maybe (Path Rel Dir)
_       ) -> [Path Abs Dir
ab]
       (Maybe (Path Abs Dir)
_      , Just Path Rel Dir
rel) -> [Path Abs Dir
biCabalDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
rel]
       (Maybe (Path Abs Dir)
Nothing, Maybe (Path Rel Dir)
Nothing ) -> []
    fworks :: [FilePath]
fworks = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\FilePath
fwk -> FilePath
"-framework=" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fwk) (BuildInfo -> [FilePath]
frameworks BuildInfo
biBuildInfo)

-- | Make the .o path from the .c file path for a component. Example:
--
-- @
-- executable FOO
--   c-sources:        cbits/text_search.c
-- @
--
-- Produces
--
-- <dist-dir>/build/FOO/FOO-tmp/cbits/text_search.o
--
-- Example:
--
-- λ> makeObjectFilePathFromC
--     $(mkAbsDir "/Users/chris/Repos/hoogle")
--     CLib
--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/cbits/text_search.o"
-- λ> makeObjectFilePathFromC
--     $(mkAbsDir "/Users/chris/Repos/hoogle")
--     (CExe "hoogle")
--     $(mkAbsDir "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist")
--     $(mkAbsFile "/Users/chris/Repos/hoogle/cbits/text_search.c")
-- Just "/Users/chris/Repos/hoogle/.stack-work/Cabal-x.x.x/dist/build/hoogle/hoogle-tmp/cbits/text_search.o"
-- λ>
makeObjectFilePathFromC
    :: MonadThrow m
    => Path Abs Dir          -- ^ The cabal directory.
    -> NamedComponent        -- ^ The name of the component.
    -> Path Abs Dir          -- ^ Dist directory.
    -> Path Abs File         -- ^ The path to the .c file.
    -> m (Path Abs File) -- ^ The path to the .o file for the component.
makeObjectFilePathFromC :: Path Abs Dir
-> NamedComponent
-> Path Abs Dir
-> Path Abs File
-> m (Path Abs File)
makeObjectFilePathFromC Path Abs Dir
cabalDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs File
cFilePath = do
    Path Rel File
relCFilePath <- Path Abs Dir -> Path Abs File -> m (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
cabalDir Path Abs File
cFilePath
    Path Rel File
relOFilePath <-
        FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> FilePath -> FilePath
replaceExtension (Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Rel File
relCFilePath) FilePath
"o")
    Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relOFilePath)

-- | Make the global autogen dir if Cabal version is new enough.
packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
    | Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = Maybe (Path Abs Dir)
forall a. Maybe a
Nothing
    | Bool
otherwise = Path Abs Dir -> Maybe (Path Abs Dir)
forall a. a -> Maybe a
Just (Path Abs Dir -> Maybe (Path Abs Dir))
-> Path Abs Dir -> Maybe (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirGlobalAutogen

-- | Make the autogen dir.
componentAutogenDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir =
    Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirAutogen

-- | See 'Distribution.Simple.LocalBuildInfo.componentBuildDir'
componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir
    | Version
cabalVer Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
    | Bool
otherwise =
        case NamedComponent
component of
            NamedComponent
CLib -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
            CInternalLib Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
            CExe Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
            CTest Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
            CBench Text
name -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name

-- | The directory where generated files are put like .o or .hs (from .x files).
componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
namedComponent Path Abs Dir
distDir =
    case NamedComponent
namedComponent of
        NamedComponent
CLib -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
        CInternalLib Text
name -> Text -> Path Abs Dir
makeTmp Text
name
        CExe Text
name -> Text -> Path Abs Dir
makeTmp Text
name
        CTest Text
name -> Text -> Path Abs Dir
makeTmp Text
name
        CBench Text
name -> Text -> Path Abs Dir
makeTmp Text
name
  where
    makeTmp :: Text -> Path Abs Dir
makeTmp Text
name =
      Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-tmp")

-- | Make the build dir. Note that Cabal >= 2.0 uses the
-- 'componentBuildDir' above for some things.
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir = Path Abs Dir
distDir Path Abs Dir -> Path Rel Dir -> Path Abs Dir
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBuild

-- NOTE: don't export this, only use it for valid paths based on
-- component names.
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir Text
name =
  Path Rel Dir -> Maybe (Path Rel Dir) -> Path Rel Dir
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Path Rel Dir
forall a. HasCallStack => FilePath -> a
error FilePath
"Invariant violated: component names should always parse as directory names")
            (FilePath -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel Dir)
parseRelDir (Text -> FilePath
T.unpack Text
name))

-- | Get all dependencies of the package (buildable targets only).
--
-- Note that for Cabal versions 1.22 and earlier, there is a bug where
-- Cabal requires dependencies for non-buildable components to be
-- present. We're going to use GHC version as a proxy for Cabal
-- library version in this case for simplicity, so we'll check for GHC
-- being 7.10 or earlier. This obviously makes our function a lot more
-- fun to write...
packageDependencies
  :: PackageConfig
  -> PackageDescription
  -> Map PackageName VersionRange
packageDependencies :: PackageConfig -> PackageDescription -> Map PackageName VersionRange
packageDependencies PackageConfig
pkgConfig PackageDescription
pkg' =
  (VersionRange -> VersionRange -> VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith VersionRange -> VersionRange -> VersionRange
intersectVersionRanges ([(PackageName, VersionRange)] -> Map PackageName VersionRange)
-> [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall a b. (a -> b) -> a -> b
$
  (Dependency -> (PackageName, VersionRange))
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> PackageName
depPkgName (Dependency -> PackageName)
-> (Dependency -> VersionRange)
-> Dependency
-> (PackageName, VersionRange)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
depVerRange) ([Dependency] -> [(PackageName, VersionRange)])
-> [Dependency] -> [(PackageName, VersionRange)]
forall a b. (a -> b) -> a -> b
$
  (BuildInfo -> [Dependency]) -> [BuildInfo] -> [Dependency]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Dependency]
targetBuildDepends (PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg) [Dependency] -> [Dependency] -> [Dependency]
forall a. [a] -> [a] -> [a]
++
  [Dependency]
-> (SetupBuildInfo -> [Dependency])
-> Maybe SetupBuildInfo
-> [Dependency]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] SetupBuildInfo -> [Dependency]
setupDepends (PackageDescription -> Maybe SetupBuildInfo
setupBuildInfo PackageDescription
pkg)
  where
    pkg :: PackageDescription
pkg
      | ActualCompiler -> Version
getGhcVersion (PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
pkgConfig) Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
0] = PackageDescription
pkg'
      -- Set all components to buildable. Only need to worry about
      -- library, exe, test, and bench, since others didn't exist in
      -- older Cabal versions
      | Bool
otherwise = PackageDescription
pkg'
        { library :: Maybe Library
library = (\Library
c -> Library
c { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo -> BuildInfo
go (Library -> BuildInfo
libBuildInfo Library
c) }) (Library -> Library) -> Maybe Library -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> Maybe Library
library PackageDescription
pkg'
        , executables :: [Executable]
executables = (\Executable
c -> Executable
c { buildInfo :: BuildInfo
buildInfo = BuildInfo -> BuildInfo
go (Executable -> BuildInfo
buildInfo Executable
c) }) (Executable -> Executable) -> [Executable] -> [Executable]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Executable]
executables PackageDescription
pkg'
        , testSuites :: [TestSuite]
testSuites =
            if PackageConfig -> Bool
packageConfigEnableTests PackageConfig
pkgConfig
              then (\TestSuite
c -> TestSuite
c { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo -> BuildInfo
go (TestSuite -> BuildInfo
testBuildInfo TestSuite
c) }) (TestSuite -> TestSuite) -> [TestSuite] -> [TestSuite]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
              else PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg'
        , benchmarks :: [Benchmark]
benchmarks =
            if PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
pkgConfig
              then (\Benchmark
c -> Benchmark
c { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo -> BuildInfo
go (Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
c) }) (Benchmark -> Benchmark) -> [Benchmark] -> [Benchmark]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
              else PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg'
        }

    go :: BuildInfo -> BuildInfo
go BuildInfo
bi = BuildInfo
bi { buildable :: Bool
buildable = Bool
True }

-- | Get all dependencies of the package (buildable targets only).
--
-- This uses both the new 'buildToolDepends' and old 'buildTools'
-- information.
packageDescTools
  :: PackageDescription
  -> (Set ExeName, Map PackageName DepValue)
packageDescTools :: PackageDescription -> (Set ExeName, Map PackageName DepValue)
packageDescTools PackageDescription
pd =
    ([ExeName] -> Set ExeName
forall a. Ord a => [a] -> Set a
S.fromList ([ExeName] -> Set ExeName) -> [ExeName] -> Set ExeName
forall a b. (a -> b) -> a -> b
$ [[ExeName]] -> [ExeName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExeName]]
unknowns, (DepValue -> DepValue -> DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) ([(PackageName, DepValue)] -> Map PackageName DepValue)
-> [(PackageName, DepValue)] -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ [[(PackageName, DepValue)]] -> [(PackageName, DepValue)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(PackageName, DepValue)]]
knowns)
  where
    ([[ExeName]]
unknowns, [[(PackageName, DepValue)]]
knowns) = [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([([ExeName], [(PackageName, DepValue)])]
 -> ([[ExeName]], [[(PackageName, DepValue)]]))
-> [([ExeName], [(PackageName, DepValue)])]
-> ([[ExeName]], [[(PackageName, DepValue)]])
forall a b. (a -> b) -> a -> b
$ (BuildInfo -> ([ExeName], [(PackageName, DepValue)]))
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI ([BuildInfo] -> [([ExeName], [(PackageName, DepValue)])])
-> [BuildInfo] -> [([ExeName], [(PackageName, DepValue)])]
forall a b. (a -> b) -> a -> b
$ PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pd

    perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
    perBI :: BuildInfo -> ([ExeName], [(PackageName, DepValue)])
perBI BuildInfo
bi =
        ([ExeName]
unknownTools, [(PackageName, DepValue)]
tools)
      where
        ([ExeName]
unknownTools, [ExeDependency]
knownTools) = [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either ExeName ExeDependency] -> ([ExeName], [ExeDependency]))
-> [Either ExeName ExeDependency] -> ([ExeName], [ExeDependency])
forall a b. (a -> b) -> a -> b
$ (LegacyExeDependency -> Either ExeName ExeDependency)
-> [LegacyExeDependency] -> [Either ExeName ExeDependency]
forall a b. (a -> b) -> [a] -> [b]
map LegacyExeDependency -> Either ExeName ExeDependency
go1 (BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi)

        tools :: [(PackageName, DepValue)]
tools = (ExeDependency -> Maybe (PackageName, DepValue))
-> [ExeDependency] -> [(PackageName, DepValue)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ExeDependency -> Maybe (PackageName, DepValue)
go2 ([ExeDependency]
knownTools [ExeDependency] -> [ExeDependency] -> [ExeDependency]
forall a. [a] -> [a] -> [a]
++ BuildInfo -> [ExeDependency]
buildToolDepends BuildInfo
bi)

        -- This is similar to desugarBuildTool from Cabal, however it
        -- uses our own hard-coded map which drops tools shipped with
        -- GHC (like hsc2hs), and includes some tools from Stackage.
        go1 :: Cabal.LegacyExeDependency -> Either ExeName Cabal.ExeDependency
        go1 :: LegacyExeDependency -> Either ExeName ExeDependency
go1 (Cabal.LegacyExeDependency FilePath
name VersionRange
range) =
          case FilePath -> Map FilePath PackageName -> Maybe PackageName
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FilePath
name Map FilePath PackageName
hardCodedMap of
            Just PackageName
pkgName -> ExeDependency -> Either ExeName ExeDependency
forall a b. b -> Either a b
Right (ExeDependency -> Either ExeName ExeDependency)
-> ExeDependency -> Either ExeName ExeDependency
forall a b. (a -> b) -> a -> b
$ PackageName -> UnqualComponentName -> VersionRange -> ExeDependency
Cabal.ExeDependency PackageName
pkgName (FilePath -> UnqualComponentName
Cabal.mkUnqualComponentName FilePath
name) VersionRange
range
            Maybe PackageName
Nothing -> ExeName -> Either ExeName ExeDependency
forall a b. a -> Either a b
Left (ExeName -> Either ExeName ExeDependency)
-> ExeName -> Either ExeName ExeDependency
forall a b. (a -> b) -> a -> b
$ Text -> ExeName
ExeName (Text -> ExeName) -> Text -> ExeName
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
name

        go2 :: Cabal.ExeDependency -> Maybe (PackageName, DepValue)
        go2 :: ExeDependency -> Maybe (PackageName, DepValue)
go2 (Cabal.ExeDependency PackageName
pkg UnqualComponentName
_name VersionRange
range)
          | PackageName
pkg PackageName -> Set PackageName -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set PackageName
preInstalledPackages = Maybe (PackageName, DepValue)
forall a. Maybe a
Nothing
          | Bool
otherwise = (PackageName, DepValue) -> Maybe (PackageName, DepValue)
forall a. a -> Maybe a
Just
              ( PackageName
pkg
              , DepValue :: VersionRange -> DepType -> DepValue
DepValue
                  { dvVersionRange :: VersionRange
dvVersionRange = VersionRange
range
                  , dvType :: DepType
dvType = DepType
AsBuildTool
                  }
              )

-- | A hard-coded map for tool dependencies
hardCodedMap :: Map String D.PackageName
hardCodedMap :: Map FilePath PackageName
hardCodedMap = [(FilePath, PackageName)] -> Map FilePath PackageName
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
  [ (FilePath
"alex", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"alex")
  , (FilePath
"happy", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"happy")
  , (FilePath
"cpphs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"cpphs")
  , (FilePath
"greencard", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"greencard")
  , (FilePath
"c2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"c2hs")
  , (FilePath
"hscolour", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hscolour")
  , (FilePath
"hspec-discover", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hspec-discover")
  , (FilePath
"hsx2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"hsx2hs")
  , (FilePath
"gtk2hsC2hs", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
  , (FilePath
"gtk2hsHookGenerator", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
  , (FilePath
"gtk2hsTypeGen", FilePath -> PackageName
Distribution.Package.mkPackageName FilePath
"gtk2hs-buildtools")
  ]

-- | Executable-only packages which come pre-installed with GHC and do
-- not need to be built. Without this exception, we would either end
-- up unnecessarily rebuilding these packages, or failing because the
-- packages do not appear in the Stackage snapshot.
preInstalledPackages :: Set D.PackageName
preInstalledPackages :: Set PackageName
preInstalledPackages = [PackageName] -> Set PackageName
forall a. Ord a => [a] -> Set a
S.fromList
  [ FilePath -> PackageName
D.mkPackageName FilePath
"hsc2hs"
  , FilePath -> PackageName
D.mkPackageName FilePath
"haddock"
  ]

-- | Variant of 'allBuildInfo' from Cabal that, like versions before
-- 2.2, only includes buildable components.
allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' :: PackageDescription -> [BuildInfo]
allBuildInfo' PackageDescription
pkg_descr = [ BuildInfo
bi | Library
lib <- PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Library -> BuildInfo
libBuildInfo Library
lib
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | ForeignLib
flib <- PackageDescription -> [ForeignLib]
foreignLibs PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
flib
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Executable
exe <- PackageDescription -> [Executable]
executables PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Executable -> BuildInfo
buildInfo Executable
exe
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | TestSuite
tst <- PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
tst
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]
                       [BuildInfo] -> [BuildInfo] -> [BuildInfo]
forall a. [a] -> [a] -> [a]
++ [ BuildInfo
bi | Benchmark
tst <- PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr
                               , let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
tst
                               , BuildInfo -> Bool
buildable BuildInfo
bi ]

-- | Get all files referenced by the package.
packageDescModulesAndFiles
    :: PackageDescription
    -> RIO Ctx (Map NamedComponent (Map ModuleName (Path Abs File)), Map NamedComponent [DotCabalPath], Set (Path Abs File), [PackageWarning])
packageDescModulesAndFiles :: PackageDescription
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
packageDescModulesAndFiles PackageDescription
pkg = do
    (Map NamedComponent (Map ModuleName (Path Abs File))
libraryMods,Map NamedComponent [DotCabalPath]
libDotCabalFiles,[PackageWarning]
libWarnings) <-
        RIO
  Ctx
  (Map NamedComponent (Map ModuleName (Path Abs File)),
   Map NamedComponent [DotCabalPath], [PackageWarning])
-> (Library
    -> RIO
         Ctx
         (Map NamedComponent (Map ModuleName (Path Abs File)),
          Map NamedComponent [DotCabalPath], [PackageWarning]))
-> Maybe Library
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ((Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath], [PackageWarning])
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
forall k a. Map k a
M.empty, Map NamedComponent [DotCabalPath]
forall k a. Map k a
M.empty, []))
            ((Library -> NamedComponent)
-> (NamedComponent
    -> Library
    -> RIO
         Ctx
         (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Library
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) t k a a c.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Library -> NamedComponent
forall b. b -> NamedComponent
libComponent NamedComponent
-> Library
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles)
            (PackageDescription -> Maybe Library
library PackageDescription
pkg)
    (Map NamedComponent (Map ModuleName (Path Abs File))
subLibrariesMods,Map NamedComponent [DotCabalPath]
subLibDotCabalFiles,[PackageWarning]
subLibWarnings) <-
        ([(Map NamedComponent (Map ModuleName (Path Abs File)),
   Map NamedComponent [DotCabalPath], [PackageWarning])]
 -> (Map NamedComponent (Map ModuleName (Path Abs File)),
     Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
            [(Map NamedComponent (Map ModuleName (Path Abs File)),
  Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
            ((Library
 -> RIO
      Ctx
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Library]
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                 ((Library -> NamedComponent)
-> (NamedComponent
    -> Library
    -> RIO
         Ctx
         (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Library
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) t k a a c.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Library -> NamedComponent
internalLibComponent NamedComponent
-> Library
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles)
                 (PackageDescription -> [Library]
subLibraries PackageDescription
pkg))
    (Map NamedComponent (Map ModuleName (Path Abs File))
executableMods,Map NamedComponent [DotCabalPath]
exeDotCabalFiles,[PackageWarning]
exeWarnings) <-
        ([(Map NamedComponent (Map ModuleName (Path Abs File)),
   Map NamedComponent [DotCabalPath], [PackageWarning])]
 -> (Map NamedComponent (Map ModuleName (Path Abs File)),
     Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
            [(Map NamedComponent (Map ModuleName (Path Abs File)),
  Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
            ((Executable
 -> RIO
      Ctx
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Executable]
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                 ((Executable -> NamedComponent)
-> (NamedComponent
    -> Executable
    -> RIO
         Ctx
         (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Executable
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) t k a a c.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Executable -> NamedComponent
exeComponent NamedComponent
-> Executable
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles)
                 (PackageDescription -> [Executable]
executables PackageDescription
pkg))
    (Map NamedComponent (Map ModuleName (Path Abs File))
testMods,Map NamedComponent [DotCabalPath]
testDotCabalFiles,[PackageWarning]
testWarnings) <-
        ([(Map NamedComponent (Map ModuleName (Path Abs File)),
   Map NamedComponent [DotCabalPath], [PackageWarning])]
 -> (Map NamedComponent (Map ModuleName (Path Abs File)),
     Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
            [(Map NamedComponent (Map ModuleName (Path Abs File)),
  Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
            ((TestSuite
 -> RIO
      Ctx
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [TestSuite]
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((TestSuite -> NamedComponent)
-> (NamedComponent
    -> TestSuite
    -> RIO
         Ctx
         (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> TestSuite
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) t k a a c.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap TestSuite -> NamedComponent
testComponent NamedComponent
-> TestSuite
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles) (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg))
    (Map NamedComponent (Map ModuleName (Path Abs File))
benchModules,Map NamedComponent [DotCabalPath]
benchDotCabalPaths,[PackageWarning]
benchWarnings) <-
        ([(Map NamedComponent (Map ModuleName (Path Abs File)),
   Map NamedComponent [DotCabalPath], [PackageWarning])]
 -> (Map NamedComponent (Map ModuleName (Path Abs File)),
     Map NamedComponent [DotCabalPath], [PackageWarning]))
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
            [(Map NamedComponent (Map ModuleName (Path Abs File)),
  Map NamedComponent [DotCabalPath], [PackageWarning])]
-> (Map NamedComponent (Map ModuleName (Path Abs File)),
    Map NamedComponent [DotCabalPath], [PackageWarning])
forall a a a.
[(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples
            ((Benchmark
 -> RIO
      Ctx
      (Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning]))
-> [Benchmark]
-> RIO
     Ctx
     [(Map NamedComponent (Map ModuleName (Path Abs File)),
       Map NamedComponent [DotCabalPath], [PackageWarning])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
                 ((Benchmark -> NamedComponent)
-> (NamedComponent
    -> Benchmark
    -> RIO
         Ctx
         (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning]))
-> Benchmark
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], [PackageWarning])
forall (m :: * -> *) t k a a c.
Monad m =>
(t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap Benchmark -> NamedComponent
benchComponent NamedComponent
-> Benchmark
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles)
                 (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg))
    Set (Path Abs File)
dfiles <- Version -> [FilePath] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles (PackageDescription -> Version
specVersion PackageDescription
pkg)
                    (PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
pkg
                        [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (PackageDescription -> FilePath
dataDir PackageDescription
pkg FilePath -> FilePath -> FilePath
FilePath.</>) (PackageDescription -> [FilePath]
dataFiles PackageDescription
pkg))
    let modules :: Map NamedComponent (Map ModuleName (Path Abs File))
modules = Map NamedComponent (Map ModuleName (Path Abs File))
libraryMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
subLibrariesMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
executableMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
testMods Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
-> Map NamedComponent (Map ModuleName (Path Abs File))
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent (Map ModuleName (Path Abs File))
benchModules
        files :: Map NamedComponent [DotCabalPath]
files =
            Map NamedComponent [DotCabalPath]
libDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
subLibDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
exeDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> Map NamedComponent [DotCabalPath]
testDotCabalFiles Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
-> Map NamedComponent [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<>
            Map NamedComponent [DotCabalPath]
benchDotCabalPaths
        warnings :: [PackageWarning]
warnings = [PackageWarning]
libWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
subLibWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
exeWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
testWarnings [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. Semigroup a => a -> a -> a
<> [PackageWarning]
benchWarnings
    (Map NamedComponent (Map ModuleName (Path Abs File)),
 Map NamedComponent [DotCabalPath], Set (Path Abs File),
 [PackageWarning])
-> RIO
     Ctx
     (Map NamedComponent (Map ModuleName (Path Abs File)),
      Map NamedComponent [DotCabalPath], Set (Path Abs File),
      [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map NamedComponent (Map ModuleName (Path Abs File))
modules, Map NamedComponent [DotCabalPath]
files, Set (Path Abs File)
dfiles, [PackageWarning]
warnings)
  where
    libComponent :: b -> NamedComponent
libComponent = NamedComponent -> b -> NamedComponent
forall a b. a -> b -> a
const NamedComponent
CLib
    internalLibComponent :: Library -> NamedComponent
internalLibComponent = Text -> NamedComponent
CInternalLib (Text -> NamedComponent)
-> (Library -> Text) -> Library -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Library -> FilePath) -> Library -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> (UnqualComponentName -> FilePath)
-> Maybe UnqualComponentName
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (Maybe UnqualComponentName -> FilePath)
-> (Library -> Maybe UnqualComponentName) -> Library -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LibraryName -> Maybe UnqualComponentName
libraryNameString (LibraryName -> Maybe UnqualComponentName)
-> (Library -> LibraryName) -> Library -> Maybe UnqualComponentName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> LibraryName
libName
    exeComponent :: Executable -> NamedComponent
exeComponent = Text -> NamedComponent
CExe (Text -> NamedComponent)
-> (Executable -> Text) -> Executable -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text)
-> (Executable -> FilePath) -> Executable -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (Executable -> UnqualComponentName) -> Executable -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> UnqualComponentName
exeName
    testComponent :: TestSuite -> NamedComponent
testComponent = Text -> NamedComponent
CTest (Text -> NamedComponent)
-> (TestSuite -> Text) -> TestSuite -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (TestSuite -> FilePath) -> TestSuite -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (TestSuite -> UnqualComponentName) -> TestSuite -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> UnqualComponentName
testName
    benchComponent :: Benchmark -> NamedComponent
benchComponent = Text -> NamedComponent
CBench (Text -> NamedComponent)
-> (Benchmark -> Text) -> Benchmark -> NamedComponent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (Benchmark -> FilePath) -> Benchmark -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnqualComponentName -> FilePath
Cabal.unUnqualComponentName (UnqualComponentName -> FilePath)
-> (Benchmark -> UnqualComponentName) -> Benchmark -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> UnqualComponentName
benchmarkName
    asModuleAndFileMap :: (t -> k) -> (k -> t -> m (a, a, c)) -> t -> m (Map k a, Map k a, c)
asModuleAndFileMap t -> k
label k -> t -> m (a, a, c)
f t
lib = do
        (a
a,a
b,c
c) <- k -> t -> m (a, a, c)
f (t -> k
label t
lib) t
lib
        (Map k a, Map k a, c) -> m (Map k a, Map k a, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton (t -> k
label t
lib) a
a, k -> a -> Map k a
forall k a. k -> a -> Map k a
M.singleton (t -> k
label t
lib) a
b, c
c)
    foldTuples :: [(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
foldTuples = ((Map NamedComponent a, Map NamedComponent a, [a])
 -> (Map NamedComponent a, Map NamedComponent a, [a])
 -> (Map NamedComponent a, Map NamedComponent a, [a]))
-> (Map NamedComponent a, Map NamedComponent a, [a])
-> [(Map NamedComponent a, Map NamedComponent a, [a])]
-> (Map NamedComponent a, Map NamedComponent a, [a])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a])
-> (Map NamedComponent a, Map NamedComponent a, [a])
forall a. Semigroup a => a -> a -> a
(<>) (Map NamedComponent a
forall k a. Map k a
M.empty, Map NamedComponent a
forall k a. Map k a
M.empty, [])

-- | Resolve globbing of files (e.g. data files) to absolute paths.
resolveGlobFiles
  :: Version -- ^ cabal file version
  -> [String]
  -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles :: Version -> [FilePath] -> RIO Ctx (Set (Path Abs File))
resolveGlobFiles Version
cabalFileVersion =
    ([[Maybe (Path Abs File)]] -> Set (Path Abs File))
-> RIO Ctx [[Maybe (Path Abs File)]]
-> RIO Ctx (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Path Abs File] -> Set (Path Abs File)
forall a. Ord a => [a] -> Set a
S.fromList ([Path Abs File] -> Set (Path Abs File))
-> ([[Maybe (Path Abs File)]] -> [Path Abs File])
-> [[Maybe (Path Abs File)]]
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> ([[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)])
-> [[Maybe (Path Abs File)]]
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (RIO Ctx [[Maybe (Path Abs File)]]
 -> RIO Ctx (Set (Path Abs File)))
-> ([FilePath] -> RIO Ctx [[Maybe (Path Abs File)]])
-> [FilePath]
-> RIO Ctx (Set (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (FilePath -> RIO Ctx [Maybe (Path Abs File)])
-> [FilePath] -> RIO Ctx [[Maybe (Path Abs File)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO Ctx [Maybe (Path Abs File)]
resolve
  where
    resolve :: FilePath -> RIO Ctx [Maybe (Path Abs File)]
resolve FilePath
name =
        if Char
'*' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
name
            then FilePath -> RIO Ctx [Maybe (Path Abs File)]
explode FilePath
name
            else (Maybe (Path Abs File) -> [Maybe (Path Abs File)])
-> RIO Ctx (Maybe (Path Abs File))
-> RIO Ctx [Maybe (Path Abs File)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe (Path Abs File) -> [Maybe (Path Abs File)]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn FilePath
name)
    explode :: FilePath -> RIO Ctx [Maybe (Path Abs File)]
explode FilePath
name = do
        Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
        [FilePath]
names <-
            FilePath -> FilePath -> RIO Ctx [FilePath]
forall (m :: * -> *) env.
(MonadUnliftIO m, HasTerm env, MonadReader env m) =>
FilePath -> FilePath -> m [FilePath]
matchDirFileGlob'
                (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
FL.toFilePath Path Abs Dir
dir)
                FilePath
name
        (FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> [FilePath] -> RIO Ctx [Maybe (Path Abs File)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn [FilePath]
names
    matchDirFileGlob' :: FilePath -> FilePath -> m [FilePath]
matchDirFileGlob' FilePath
dir FilePath
glob =
        m [FilePath] -> (IOException -> m [FilePath]) -> m [FilePath]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
            (IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity -> Version -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
forall a. Bounded a => a
minBound Version
cabalFileVersion FilePath
dir FilePath
glob))
            (\(IOException
e :: IOException) ->
                  if IOException -> Bool
isUserError IOException
e
                      then do
                          [StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
                              [ FilePath -> StyleDoc
flow FilePath
"Wildcard does not match any files:"
                              , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
glob
                              , StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> StyleDoc
flow FilePath
"in directory:"
                              , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
dir
                              ]
                          [FilePath] -> m [FilePath]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                      else IOException -> m [FilePath]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e)

-- | Get all files referenced by the benchmark.
benchmarkFiles
    :: NamedComponent
    -> Benchmark
    -> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles :: NamedComponent
-> Benchmark
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles NamedComponent
component Benchmark
bench = do
    NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
  where
    names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
    exposed :: [DotCabalDescriptor]
exposed =
        case Benchmark -> BenchmarkInterface
benchmarkInterface Benchmark
bench of
            BenchmarkExeV10 Version
_ FilePath
fp -> [FilePath -> DotCabalDescriptor
DotCabalMain FilePath
fp]
            BenchmarkUnsupported BenchmarkType
_ -> []
    bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
    build :: BuildInfo
build = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench

-- | Get all files referenced by the test.
testFiles
    :: NamedComponent
    -> TestSuite
    -> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles :: NamedComponent
-> TestSuite
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles NamedComponent
component TestSuite
test = do
    NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
  where
    names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed
    exposed :: [DotCabalDescriptor]
exposed =
        case TestSuite -> TestSuiteInterface
testInterface TestSuite
test of
            TestSuiteExeV10 Version
_ FilePath
fp -> [FilePath -> DotCabalDescriptor
DotCabalMain FilePath
fp]
            TestSuiteLibV09 Version
_ ModuleName
mn -> [ModuleName -> DotCabalDescriptor
DotCabalModule ModuleName
mn]
            TestSuiteUnsupported TestType
_ -> []
    bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
    build :: BuildInfo
build = TestSuite -> BuildInfo
testBuildInfo TestSuite
test

-- | Get all files referenced by the executable.
executableFiles
    :: NamedComponent
    -> Executable
    -> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles :: NamedComponent
-> Executable
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles NamedComponent
component Executable
exe = do
    NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
  where
    build :: BuildInfo
build = Executable -> BuildInfo
buildInfo Executable
exe
    names :: [DotCabalDescriptor]
names =
        (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build) [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++
        [FilePath -> DotCabalDescriptor
DotCabalMain (Executable -> FilePath
modulePath Executable
exe)]

-- | Get all files referenced by the library.
libraryFiles
    :: NamedComponent
    -> Library
    -> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles :: NamedComponent
-> Library
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles NamedComponent
component Library
lib = do
    NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names
  where
    build :: BuildInfo
build = Library -> BuildInfo
libBuildInfo Library
lib
    names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++ [DotCabalDescriptor]
exposed
    exposed :: [DotCabalDescriptor]
exposed = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Library -> [ModuleName]
exposedModules Library
lib)
    bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)

-- | Get all files referenced by the component.
resolveComponentFiles
    :: NamedComponent
    -> BuildInfo
    -> [DotCabalDescriptor]
    -> RIO Ctx (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles :: NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names = do
    [Path Abs Dir]
dirs <- (FilePath -> RIO Ctx (Maybe (Path Abs Dir)))
-> [FilePath] -> RIO Ctx [Path Abs Dir]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM FilePath -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn (BuildInfo -> [FilePath]
hsSourceDirs BuildInfo
build)
    Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
    [Path Abs Dir]
agdirs <- RIO Ctx [Path Abs Dir]
autogenDirs
    (Map ModuleName (Path Abs File)
modules,[DotCabalPath]
files,[PackageWarning]
warnings) <-
        NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps
            NamedComponent
component
            ((if [Path Abs Dir] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
dirs then [Path Abs Dir
dir] else [Path Abs Dir]
dirs) [Path Abs Dir] -> [Path Abs Dir] -> [Path Abs Dir]
forall a. [a] -> [a] -> [a]
++ [Path Abs Dir]
agdirs)
            [DotCabalDescriptor]
names
    [DotCabalPath]
cfiles <- BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources BuildInfo
build
    (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ModuleName (Path Abs File)
modules, [DotCabalPath]
files [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
cfiles, [PackageWarning]
warnings)
  where
    autogenDirs :: RIO Ctx [Path Abs Dir]
autogenDirs = do
      Version
cabalVer <- (Ctx -> Version) -> RIO Ctx Version
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Version
ctxCabalVer
      Path Abs Dir
distDir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs Dir
ctxDistDir
      let compDir :: Path Abs Dir
compDir = Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir Version
cabalVer NamedComponent
component Path Abs Dir
distDir
          pkgDir :: [Path Abs Dir]
pkgDir = Maybe (Path Abs Dir) -> [Path Abs Dir]
forall a. Maybe a -> [a]
maybeToList (Maybe (Path Abs Dir) -> [Path Abs Dir])
-> Maybe (Path Abs Dir) -> [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
      (Path Abs Dir -> RIO Ctx Bool)
-> [Path Abs Dir] -> RIO Ctx [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path Abs Dir -> RIO Ctx Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist ([Path Abs Dir] -> RIO Ctx [Path Abs Dir])
-> [Path Abs Dir] -> RIO Ctx [Path Abs Dir]
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
compDir Path Abs Dir -> [Path Abs Dir] -> [Path Abs Dir]
forall a. a -> [a] -> [a]
: [Path Abs Dir]
pkgDir

-- | Get all C sources and extra source files in a build.
buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources :: BuildInfo -> RIO Ctx [DotCabalPath]
buildOtherSources BuildInfo
build = do
    Path Abs Dir
cwd <- IO (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
    Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
    Path Abs File
file <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
    let resolveDirFiles :: [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles [FilePath]
files Path Abs File -> b
toCabalPath =
            [FilePath] -> (FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [FilePath]
files ((FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b])
-> (FilePath -> RIO Ctx (Maybe b)) -> RIO Ctx [b]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
                Maybe (Path Abs File)
result <- Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir FilePath
fp
                case Maybe (Path Abs File)
result of
                    Maybe (Path Abs File)
Nothing -> do
                        Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
"File" Path Abs Dir
cwd FilePath
fp Path Abs File
file
                        Maybe b -> RIO Ctx (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
                    Just Path Abs File
p -> Maybe b -> RIO Ctx (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> RIO Ctx (Maybe b)) -> Maybe b -> RIO Ctx (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just (Path Abs File -> b
toCabalPath Path Abs File
p)
    [DotCabalPath]
csources <- [FilePath]
-> (Path Abs File -> DotCabalPath) -> RIO Ctx [DotCabalPath]
forall b. [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [FilePath]
cSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalCFilePath
    [DotCabalPath]
jsources <- [FilePath]
-> (Path Abs File -> DotCabalPath) -> RIO Ctx [DotCabalPath]
forall b. [FilePath] -> (Path Abs File -> b) -> RIO Ctx [b]
resolveDirFiles (BuildInfo -> [FilePath]
targetJsSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalFilePath
    [DotCabalPath] -> RIO Ctx [DotCabalPath]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DotCabalPath]
csources [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
jsources)

-- | Get the target's JS sources.
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources = BuildInfo -> [FilePath]
jsSources

-- | A pair of package descriptions: one which modified the buildable
-- values of test suites and benchmarks depending on whether they are
-- enabled, and one which does not.
--
-- Fields are intentionally lazy, we may only need one or the other
-- value.
--
-- MSS 2017-08-29: The very presence of this data type is terribly
-- ugly, it represents the fact that the Cabal 2.0 upgrade did _not_
-- go well. Specifically, we used to have a field to indicate whether
-- a component was enabled in addition to buildable, but that's gone
-- now, and this is an ugly proxy. We should at some point clean up
-- the mess of Package, LocalPackage, etc, and probably pull in the
-- definition of PackageDescription from Cabal with our additionally
-- needed metadata. But this is a good enough hack for the
-- moment. Odds are, you're reading this in the year 2024 and thinking
-- "wtf?"
data PackageDescriptionPair = PackageDescriptionPair
  { PackageDescriptionPair -> PackageDescription
pdpOrigBuildable :: PackageDescription
  , PackageDescriptionPair -> PackageDescription
pdpModifiedBuildable :: PackageDescription
  }

-- | Evaluates the conditions of a 'GenericPackageDescription', yielding
-- a resolved 'PackageDescription'.
resolvePackageDescription :: PackageConfig
                          -> GenericPackageDescription
                          -> PackageDescriptionPair
resolvePackageDescription :: PackageConfig
-> GenericPackageDescription -> PackageDescriptionPair
resolvePackageDescription PackageConfig
packageConfig (GenericPackageDescription PackageDescription
desc [Flag]
defaultFlags Maybe (CondTree ConfVar [Dependency] Library)
mlib [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs' [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches) =
    PackageDescriptionPair :: PackageDescription -> PackageDescription -> PackageDescriptionPair
PackageDescriptionPair
      { pdpOrigBuildable :: PackageDescription
pdpOrigBuildable = Bool -> PackageDescription
go Bool
False
      , pdpModifiedBuildable :: PackageDescription
pdpModifiedBuildable = Bool -> PackageDescription
go Bool
True
      }
  where
        go :: Bool -> PackageDescription
go Bool
modBuildable =
          PackageDescription
desc {library :: Maybe Library
library =
                  (CondTree ConfVar [Dependency] Library -> Library)
-> Maybe (CondTree ConfVar [Dependency] Library) -> Maybe Library
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps) Maybe (CondTree ConfVar [Dependency] Library)
mlib
               ,subLibraries :: [Library]
subLibraries =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Library)
 -> Library)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
-> [Library]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Library
v) -> (ResolveConditions
-> (Library -> [Dependency] -> Library)
-> CondTree ConfVar [Dependency] Library
-> Library
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Library -> [Dependency] -> Library
updateLibDeps CondTree ConfVar [Dependency] Library
v){libName :: LibraryName
libName=UnqualComponentName -> LibraryName
LSubLibName UnqualComponentName
n})
                      [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
subLibs
               ,foreignLibs :: [ForeignLib]
foreignLibs =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)
 -> ForeignLib)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
-> [ForeignLib]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] ForeignLib
v) -> (ResolveConditions
-> (ForeignLib -> [Dependency] -> ForeignLib)
-> CondTree ConfVar [Dependency] ForeignLib
-> ForeignLib
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps CondTree ConfVar [Dependency] ForeignLib
v){foreignLibName :: UnqualComponentName
foreignLibName=UnqualComponentName
n})
                      [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)]
foreignLibs'
               ,executables :: [Executable]
executables =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> Executable)
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [Executable]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n, CondTree ConfVar [Dependency] Executable
v) -> (ResolveConditions
-> (Executable -> [Dependency] -> Executable)
-> CondTree ConfVar [Dependency] Executable
-> Executable
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc Executable -> [Dependency] -> Executable
updateExeDeps CondTree ConfVar [Dependency] Executable
v){exeName :: UnqualComponentName
exeName=UnqualComponentName
n})
                      [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
exes
               ,testSuites :: [TestSuite]
testSuites =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> TestSuite)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [TestSuite]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] TestSuite
v) -> (ResolveConditions
-> (TestSuite -> [Dependency] -> TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
-> TestSuite
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable) CondTree ConfVar [Dependency] TestSuite
v){testName :: UnqualComponentName
testName=UnqualComponentName
n})
                      [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
tests
               ,benchmarks :: [Benchmark]
benchmarks =
                  ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> Benchmark)
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [Benchmark]
forall a b. (a -> b) -> [a] -> [b]
map (\(UnqualComponentName
n,CondTree ConfVar [Dependency] Benchmark
v) -> (ResolveConditions
-> (Benchmark -> [Dependency] -> Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
-> Benchmark
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc (Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable) CondTree ConfVar [Dependency] Benchmark
v){benchmarkName :: UnqualComponentName
benchmarkName=UnqualComponentName
n})
                      [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
benches}

        flags :: Map FlagName Bool
flags =
          Map FlagName Bool -> Map FlagName Bool -> Map FlagName Bool
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union (PackageConfig -> Map FlagName Bool
packageConfigFlags PackageConfig
packageConfig)
                  ([Flag] -> Map FlagName Bool
flagMap [Flag]
defaultFlags)

        rc :: ResolveConditions
rc = ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions
                (PackageConfig -> ActualCompiler
packageConfigCompilerVersion PackageConfig
packageConfig)
                (PackageConfig -> Platform
packageConfigPlatform PackageConfig
packageConfig)
                Map FlagName Bool
flags

        updateLibDeps :: Library -> [Dependency] -> Library
updateLibDeps Library
lib [Dependency]
deps =
          Library
lib {libBuildInfo :: BuildInfo
libBuildInfo =
                 (Library -> BuildInfo
libBuildInfo Library
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}
        updateForeignLibDeps :: ForeignLib -> [Dependency] -> ForeignLib
updateForeignLibDeps ForeignLib
lib [Dependency]
deps =
          ForeignLib
lib {foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo =
                 (ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
lib) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}
        updateExeDeps :: Executable -> [Dependency] -> Executable
updateExeDeps Executable
exe [Dependency]
deps =
          Executable
exe {buildInfo :: BuildInfo
buildInfo =
                 (Executable -> BuildInfo
buildInfo Executable
exe) {targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps}}

        -- Note that, prior to moving to Cabal 2.0, we would set
        -- testEnabled/benchmarkEnabled here. These fields no longer
        -- exist, so we modify buildable instead here.  The only
        -- wrinkle in the Cabal 2.0 story is
        -- https://github.com/haskell/cabal/issues/1725, where older
        -- versions of Cabal (which may be used for actually building
        -- code) don't properly exclude build-depends for
        -- non-buildable components. Testing indicates that everything
        -- is working fine, and that this comment can be completely
        -- ignored. I'm leaving the comment anyway in case something
        -- breaks and you, poor reader, are investigating.
        updateTestDeps :: Bool -> TestSuite -> [Dependency] -> TestSuite
updateTestDeps Bool
modBuildable TestSuite
test [Dependency]
deps =
          let bi :: BuildInfo
bi = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
              bi' :: BuildInfo
bi' = BuildInfo
bi
                { targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
                , buildable :: Bool
buildable = BuildInfo -> Bool
buildable BuildInfo
bi Bool -> Bool -> Bool
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableTests PackageConfig
packageConfig else Bool
True)
                }
           in TestSuite
test { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
bi' }
        updateBenchmarkDeps :: Bool -> Benchmark -> [Dependency] -> Benchmark
updateBenchmarkDeps Bool
modBuildable Benchmark
benchmark [Dependency]
deps =
          let bi :: BuildInfo
bi = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
benchmark
              bi' :: BuildInfo
bi' = BuildInfo
bi
                { targetBuildDepends :: [Dependency]
targetBuildDepends = [Dependency]
deps
                , buildable :: Bool
buildable = BuildInfo -> Bool
buildable BuildInfo
bi Bool -> Bool -> Bool
&& (if Bool
modBuildable then PackageConfig -> Bool
packageConfigEnableBenchmarks PackageConfig
packageConfig else Bool
True)
                }
           in Benchmark
benchmark { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo
bi' }

-- | Make a map from a list of flag specifications.
--
-- What is @flagManual@ for?
flagMap :: [Flag] -> Map FlagName Bool
flagMap :: [Flag] -> Map FlagName Bool
flagMap = [(FlagName, Bool)] -> Map FlagName Bool
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(FlagName, Bool)] -> Map FlagName Bool)
-> ([Flag] -> [(FlagName, Bool)]) -> [Flag] -> Map FlagName Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Flag -> (FlagName, Bool)) -> [Flag] -> [(FlagName, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map Flag -> (FlagName, Bool)
pair
  where pair :: Flag -> (FlagName, Bool)
        pair :: Flag -> (FlagName, Bool)
pair = Flag -> FlagName
flagName (Flag -> FlagName) -> (Flag -> Bool) -> Flag -> (FlagName, Bool)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Flag -> Bool
flagDefault

data ResolveConditions = ResolveConditions
    { ResolveConditions -> Map FlagName Bool
rcFlags :: Map FlagName Bool
    , ResolveConditions -> ActualCompiler
rcCompilerVersion :: ActualCompiler
    , ResolveConditions -> OS
rcOS :: OS
    , ResolveConditions -> Arch
rcArch :: Arch
    }

-- | Generic a @ResolveConditions@ using sensible defaults.
mkResolveConditions :: ActualCompiler -- ^ Compiler version
                    -> Platform -- ^ installation target platform
                    -> Map FlagName Bool -- ^ enabled flags
                    -> ResolveConditions
mkResolveConditions :: ActualCompiler
-> Platform -> Map FlagName Bool -> ResolveConditions
mkResolveConditions ActualCompiler
compilerVersion (Platform Arch
arch OS
os) Map FlagName Bool
flags = ResolveConditions :: Map FlagName Bool
-> ActualCompiler -> OS -> Arch -> ResolveConditions
ResolveConditions
    { rcFlags :: Map FlagName Bool
rcFlags = Map FlagName Bool
flags
    , rcCompilerVersion :: ActualCompiler
rcCompilerVersion = ActualCompiler
compilerVersion
    , rcOS :: OS
rcOS = OS
os
    , rcArch :: Arch
rcArch = Arch
arch
    }

-- | Resolve the condition tree for the library.
resolveConditions :: (Semigroup target,Monoid target,Show target)
                  => ResolveConditions
                  -> (target -> cs -> target)
                  -> CondTree ConfVar cs target
                  -> target
resolveConditions :: ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps (CondNode target
lib cs
deps [CondBranch ConfVar cs target]
cs) = target
basic target -> target -> target
forall a. Semigroup a => a -> a -> a
<> target
children
  where basic :: target
basic = target -> cs -> target
addDeps target
lib cs
deps
        children :: target
children = [target] -> target
forall a. Monoid a => [a] -> a
mconcat ((CondBranch ConfVar cs target -> target)
-> [CondBranch ConfVar cs target] -> [target]
forall a b. (a -> b) -> [a] -> [b]
map CondBranch ConfVar cs target -> target
apply [CondBranch ConfVar cs target]
cs)
          where apply :: CondBranch ConfVar cs target -> target
apply (Cabal.CondBranch Condition ConfVar
cond CondTree ConfVar cs target
node Maybe (CondTree ConfVar cs target)
mcs) =
                  if Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cond
                     then ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps CondTree ConfVar cs target
node
                     else target
-> (CondTree ConfVar cs target -> target)
-> Maybe (CondTree ConfVar cs target)
-> target
forall b a. b -> (a -> b) -> Maybe a -> b
maybe target
forall a. Monoid a => a
mempty (ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
forall target cs.
(Semigroup target, Monoid target, Show target) =>
ResolveConditions
-> (target -> cs -> target) -> CondTree ConfVar cs target -> target
resolveConditions ResolveConditions
rc target -> cs -> target
addDeps) Maybe (CondTree ConfVar cs target)
mcs
                condSatisfied :: Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c =
                  case Condition ConfVar
c of
                    Var ConfVar
v -> ConfVar -> Bool
varSatisifed ConfVar
v
                    Lit Bool
b -> Bool
b
                    CNot Condition ConfVar
c' ->
                      Bool -> Bool
not (Condition ConfVar -> Bool
condSatisfied Condition ConfVar
c')
                    COr Condition ConfVar
cx Condition ConfVar
cy ->
                      Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
|| Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
                    CAnd Condition ConfVar
cx Condition ConfVar
cy ->
                      Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cx Bool -> Bool -> Bool
&& Condition ConfVar -> Bool
condSatisfied Condition ConfVar
cy
                varSatisifed :: ConfVar -> Bool
varSatisifed ConfVar
v =
                  case ConfVar
v of
                    OS OS
os -> OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> OS
rcOS ResolveConditions
rc
                    Arch Arch
arch -> Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== ResolveConditions -> Arch
rcArch ResolveConditions
rc
                    Flag FlagName
flag ->
                      Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FlagName -> Map FlagName Bool -> Maybe Bool
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup FlagName
flag (ResolveConditions -> Map FlagName Bool
rcFlags ResolveConditions
rc)
                      -- NOTE:  ^^^^^ This should never happen, as all flags
                      -- which are used must be declared. Defaulting to
                      -- False.
                    Impl CompilerFlavor
flavor VersionRange
range ->
                      case (CompilerFlavor
flavor, ResolveConditions -> ActualCompiler
rcCompilerVersion ResolveConditions
rc) of
                        (CompilerFlavor
GHC, ACGhc Version
vghc) -> Version
vghc Version -> VersionRange -> Bool
`withinRange` VersionRange
range
                        (CompilerFlavor, ActualCompiler)
_ -> Bool
False

-- | Try to resolve the list of base names in the given directory by
-- looking for unique instances of base names applied with the given
-- extensions, plus find any of their module and TemplateHaskell
-- dependencies.
resolveFilesAndDeps
    :: NamedComponent       -- ^ Package component name
    -> [Path Abs Dir]       -- ^ Directories to look in.
    -> [DotCabalDescriptor] -- ^ Base names.
    -> RIO Ctx (Map ModuleName (Path Abs File),[DotCabalPath],[PackageWarning])
resolveFilesAndDeps :: NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps NamedComponent
component [Path Abs Dir]
dirs [DotCabalDescriptor]
names0 = do
    ([DotCabalPath]
dotCabalPaths, Map ModuleName (Path Abs File)
foundModules, [ModuleName]
missingModules) <- [DotCabalDescriptor]
-> Set ModuleName
-> RIO
     Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [DotCabalDescriptor]
names0 Set ModuleName
forall a. Set a
S.empty
    [PackageWarning]
warnings <- ([PackageWarning] -> [PackageWarning] -> [PackageWarning])
-> RIO Ctx [PackageWarning]
-> RIO Ctx [PackageWarning]
-> RIO Ctx [PackageWarning]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [PackageWarning] -> [PackageWarning] -> [PackageWarning]
forall a. [a] -> [a] -> [a]
(++) (Map ModuleName (Path Abs File) -> RIO Ctx [PackageWarning]
forall (m :: * -> *) b.
Monad m =>
Map ModuleName b -> m [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules) ([ModuleName] -> RIO Ctx [PackageWarning]
forall (m :: * -> *) p a. Monad m => p -> m [a]
warnMissing [ModuleName]
missingModules)
    (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
     Ctx
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
forall (m :: * -> *) a. Monad m => a -> m a
return (Map ModuleName (Path Abs File)
foundModules, [DotCabalPath]
dotCabalPaths, [PackageWarning]
warnings)
  where
    loop :: [DotCabalDescriptor]
-> Set ModuleName
-> RIO
     Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [] Set ModuleName
_ = ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
-> RIO
     Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Map ModuleName (Path Abs File)
forall k a. Map k a
M.empty, [])
    loop [DotCabalDescriptor]
names Set ModuleName
doneModules0 = do
        [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved <- [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names
        let foundFiles :: [DotCabalPath]
foundFiles = ((DotCabalDescriptor, Maybe DotCabalPath) -> Maybe DotCabalPath)
-> [(DotCabalDescriptor, Maybe DotCabalPath)] -> [DotCabalPath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe DotCabalPath
forall a b. (a, b) -> b
snd [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
            foundModules :: [(ModuleName, Path Abs File)]
foundModules = ((DotCabalDescriptor, Maybe DotCabalPath)
 -> Maybe (ModuleName, Path Abs File))
-> [(DotCabalDescriptor, Maybe DotCabalPath)]
-> [(ModuleName, Path Abs File)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File)
toResolvedModule [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
            missingModules :: [ModuleName]
missingModules = ((DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName)
-> [(DotCabalDescriptor, Maybe DotCabalPath)] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
        [(Set ModuleName, [Path Abs File])]
pairs <- (DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File]))
-> [DotCabalPath] -> RIO Ctx [(Set ModuleName, [Path Abs File])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs) [DotCabalPath]
foundFiles
        let doneModules :: Set ModuleName
doneModules =
                Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
S.union
                    Set ModuleName
doneModules0
                    ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
S.fromList ((DotCabalDescriptor -> Maybe ModuleName)
-> [DotCabalDescriptor] -> [ModuleName]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalDescriptor -> Maybe ModuleName
dotCabalModule [DotCabalDescriptor]
names))
            moduleDeps :: Set ModuleName
moduleDeps = [Set ModuleName] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (((Set ModuleName, [Path Abs File]) -> Set ModuleName)
-> [(Set ModuleName, [Path Abs File])] -> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Set ModuleName, [Path Abs File]) -> Set ModuleName
forall a b. (a, b) -> a
fst [(Set ModuleName, [Path Abs File])]
pairs)
            thDepFiles :: [Path Abs File]
thDepFiles = ((Set ModuleName, [Path Abs File]) -> [Path Abs File])
-> [(Set ModuleName, [Path Abs File])] -> [Path Abs File]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Set ModuleName, [Path Abs File]) -> [Path Abs File]
forall a b. (a, b) -> b
snd [(Set ModuleName, [Path Abs File])]
pairs
            modulesRemaining :: Set ModuleName
modulesRemaining = Set ModuleName -> Set ModuleName -> Set ModuleName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ModuleName
moduleDeps Set ModuleName
doneModules
        -- Ignore missing modules discovered as dependencies - they may
        -- have been deleted.
        ([DotCabalPath]
resolvedFiles, Map ModuleName (Path Abs File)
resolvedModules, [ModuleName]
_) <-
            [DotCabalDescriptor]
-> Set ModuleName
-> RIO
     Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop ((ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Set ModuleName -> [ModuleName]
forall a. Set a -> [a]
S.toList Set ModuleName
modulesRemaining)) Set ModuleName
doneModules
        ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
-> RIO
     Ctx ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
forall (m :: * -> *) a. Monad m => a -> m a
return
            ( [DotCabalPath] -> [DotCabalPath]
forall a. Ord a => [a] -> [a]
nubOrd ([DotCabalPath] -> [DotCabalPath])
-> [DotCabalPath] -> [DotCabalPath]
forall a b. (a -> b) -> a -> b
$ [DotCabalPath]
foundFiles [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> (Path Abs File -> DotCabalPath)
-> [Path Abs File] -> [DotCabalPath]
forall a b. (a -> b) -> [a] -> [b]
map Path Abs File -> DotCabalPath
DotCabalFilePath [Path Abs File]
thDepFiles [DotCabalPath] -> [DotCabalPath] -> [DotCabalPath]
forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
resolvedFiles
            , Map ModuleName (Path Abs File)
-> Map ModuleName (Path Abs File) -> Map ModuleName (Path Abs File)
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
                  ([(ModuleName, Path Abs File)] -> Map ModuleName (Path Abs File)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ModuleName, Path Abs File)]
foundModules)
                  Map ModuleName (Path Abs File)
resolvedModules
            , [ModuleName]
missingModules)
    warnUnlisted :: Map ModuleName b -> m [PackageWarning]
warnUnlisted Map ModuleName b
foundModules = do
        let unlistedModules :: Map ModuleName b
unlistedModules =
                Map ModuleName b
foundModules Map ModuleName b -> Map ModuleName () -> Map ModuleName b
forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference`
                [(ModuleName, ())] -> Map ModuleName ()
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ((DotCabalDescriptor -> Maybe (ModuleName, ()))
-> [DotCabalDescriptor] -> [(ModuleName, ())]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((ModuleName -> (ModuleName, ()))
-> Maybe ModuleName -> Maybe (ModuleName, ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) (Maybe ModuleName -> Maybe (ModuleName, ()))
-> (DotCabalDescriptor -> Maybe ModuleName)
-> DotCabalDescriptor
-> Maybe (ModuleName, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> Maybe ModuleName
dotCabalModule) [DotCabalDescriptor]
names0)
        [PackageWarning] -> m [PackageWarning]
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageWarning] -> m [PackageWarning])
-> [PackageWarning] -> m [PackageWarning]
forall a b. (a -> b) -> a -> b
$
            if Map ModuleName b -> Bool
forall k a. Map k a -> Bool
M.null Map ModuleName b
unlistedModules
                then []
                else [ NamedComponent -> [ModuleName] -> PackageWarning
UnlistedModulesWarning
                           NamedComponent
component
                           (((ModuleName, b) -> ModuleName)
-> [(ModuleName, b)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, b) -> ModuleName
forall a b. (a, b) -> a
fst (Map ModuleName b -> [(ModuleName, b)]
forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName b
unlistedModules))]
    warnMissing :: p -> m [a]
warnMissing p
_missingModules = do
        [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        -- TODO: bring this back - see
        -- https://github.com/commercialhaskell/stack/issues/2649
        {-
        cabalfp <- asks ctxFile
        return $
            if null missingModules
               then []
               else [ MissingModulesWarning
                           cabalfp
                           component
                           missingModules]
        -}
    -- TODO: In usages of toResolvedModule / toMissingModule, some sort
    -- of map + partition would probably be better.
    toResolvedModule
        :: (DotCabalDescriptor, Maybe DotCabalPath)
        -> Maybe (ModuleName, Path Abs File)
    toResolvedModule :: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe (ModuleName, Path Abs File)
toResolvedModule (DotCabalModule ModuleName
mn, Just (DotCabalModulePath Path Abs File
fp)) =
        (ModuleName, Path Abs File) -> Maybe (ModuleName, Path Abs File)
forall a. a -> Maybe a
Just (ModuleName
mn, Path Abs File
fp)
    toResolvedModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
        Maybe (ModuleName, Path Abs File)
forall a. Maybe a
Nothing
    toMissingModule
        :: (DotCabalDescriptor, Maybe DotCabalPath)
        -> Maybe ModuleName
    toMissingModule :: (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule (DotCabalModule ModuleName
mn, Maybe DotCabalPath
Nothing) =
        ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
mn
    toMissingModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
        Maybe ModuleName
forall a. Maybe a
Nothing

-- | Get the dependencies of a Haskell module file.
getDependencies
    :: NamedComponent -> [Path Abs Dir] -> DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies :: NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO Ctx (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs DotCabalPath
dotCabalPath =
    case DotCabalPath
dotCabalPath of
        DotCabalModulePath Path Abs File
resolvedFile -> Path Abs File -> RIO Ctx (Set ModuleName, [Path Abs File])
forall t. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
        DotCabalMainPath Path Abs File
resolvedFile -> Path Abs File -> RIO Ctx (Set ModuleName, [Path Abs File])
forall t. Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
        DotCabalFilePath{} -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
        DotCabalCFilePath{} -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
  where
    readResolvedHi :: Path Abs t -> RIO Ctx (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs t
resolvedFile = do
        Path Abs Dir
dumpHIDir <- NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
component (Path Abs Dir -> Path Abs Dir)
-> RIO Ctx (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs Dir
ctxDistDir
        Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
        let sourceDir :: Path Abs Dir
sourceDir = Path Abs Dir -> Maybe (Path Abs Dir) -> Path Abs Dir
forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
dir (Maybe (Path Abs Dir) -> Path Abs Dir)
-> Maybe (Path Abs Dir) -> Path Abs Dir
forall a b. (a -> b) -> a -> b
$ (Path Abs Dir -> Bool) -> [Path Abs Dir] -> Maybe (Path Abs Dir)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Path Abs Dir -> Path Abs t -> Bool
forall b t. Path b Dir -> Path b t -> Bool
`isProperPrefixOf` Path Abs t
resolvedFile) [Path Abs Dir]
dirs
            stripSourceDir :: Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
d = Path Abs Dir -> Path Abs t -> m (Path Rel t)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
d Path Abs t
resolvedFile
        case Path Abs Dir -> Maybe (Path Rel t)
forall (m :: * -> *).
MonadThrow m =>
Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
sourceDir of
            Maybe (Path Rel t)
Nothing -> (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])
            Just Path Rel t
fileRel -> do
                let hiPath :: FilePath
hiPath =
                        FilePath -> FilePath -> FilePath
FilePath.replaceExtension
                            (Path Abs t -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Abs Dir
dumpHIDir Path Abs Dir -> Path Rel t -> Path Abs t
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
fileRel))
                            FilePath
".hi"
                Bool
dumpHIExists <- IO Bool -> RIO Ctx Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO Ctx Bool) -> IO Bool -> RIO Ctx Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
D.doesFileExist FilePath
hiPath
                if Bool
dumpHIExists
                    then FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI FilePath
hiPath
                    else (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set ModuleName
forall a. Set a
S.empty, [])

-- | Parse a .hi file into a set of modules and files.
parseHI
    :: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI :: FilePath -> RIO Ctx (Set ModuleName, [Path Abs File])
parseHI FilePath
hiPath = do
  Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
  Either FilePath Interface
result <- IO (Either FilePath Interface)
-> RIO Ctx (Either FilePath Interface)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either FilePath Interface)
 -> RIO Ctx (Either FilePath Interface))
-> IO (Either FilePath Interface)
-> RIO Ctx (Either FilePath Interface)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Either FilePath Interface)
Iface.fromFile FilePath
hiPath
  case Either FilePath Interface
result of
    Left FilePath
msg -> do
      [StyleDoc] -> RIO Ctx ()
forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL
        [ FilePath -> StyleDoc
flow FilePath
"Failed to decode module interface:"
        , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
hiPath
        , FilePath -> StyleDoc
flow FilePath
"Decoding failure:"
        , Style -> StyleDoc -> StyleDoc
style Style
Error (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
msg
        ]
      (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, [])
    Right Interface
iface -> do
      let moduleNames :: Interface -> [ModuleName]
moduleNames = ((ByteString, Bool) -> ModuleName)
-> [(ByteString, Bool)] -> [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> ModuleName
forall a. IsString a => FilePath -> a
fromString (FilePath -> ModuleName)
-> ((ByteString, Bool) -> FilePath)
-> (ByteString, Bool)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> FilePath)
-> ((ByteString, Bool) -> Text) -> (ByteString, Bool) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient (ByteString -> Text)
-> ((ByteString, Bool) -> ByteString) -> (ByteString, Bool) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Bool) -> ByteString
forall a b. (a, b) -> a
fst) ([(ByteString, Bool)] -> [ModuleName])
-> (Interface -> [(ByteString, Bool)]) -> Interface -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                        List (ByteString, Bool) -> [(ByteString, Bool)]
forall a. List a -> [a]
Iface.unList (List (ByteString, Bool) -> [(ByteString, Bool)])
-> (Interface -> List (ByteString, Bool))
-> Interface
-> [(ByteString, Bool)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> List (ByteString, Bool)
Iface.dmods (Dependencies -> List (ByteString, Bool))
-> (Interface -> Dependencies)
-> Interface
-> List (ByteString, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Dependencies
Iface.deps
          resolveFileDependency :: FilePath -> m (Maybe (Path Abs File))
resolveFileDependency FilePath
file = do
            Maybe (Path Abs File)
resolved <- IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs File) -> IO (Maybe (Path Abs File))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
dir FilePath
file)) m (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Path Abs File) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Path Abs File)
resolved) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              [StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
              [ FilePath -> StyleDoc
flow FilePath
"Dependent file listed in:"
              , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
hiPath
              , FilePath -> StyleDoc
flow FilePath
"does not exist:"
              , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
file
              ]
            Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
resolved
          resolveUsages :: Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages = (Usage -> RIO Ctx (Maybe (Path Abs File)))
-> [Usage] -> RIO Ctx [Maybe (Path Abs File)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *) env.
(MonadIO m, HasTerm env, MonadReader env m) =>
FilePath -> m (Maybe (Path Abs File))
resolveFileDependency (FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> (Usage -> FilePath) -> Usage -> RIO Ctx (Maybe (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> FilePath
Iface.unUsage) ([Usage] -> RIO Ctx [Maybe (Path Abs File)])
-> (Interface -> [Usage])
-> Interface
-> RIO Ctx [Maybe (Path Abs File)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List Usage -> [Usage]
forall a. List a -> [a]
Iface.unList (List Usage -> [Usage])
-> (Interface -> List Usage) -> Interface -> [Usage]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> List Usage
Iface.usage
      [Path Abs File]
resolvedUsages <- [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> RIO Ctx [Maybe (Path Abs File)] -> RIO Ctx [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> RIO Ctx [Maybe (Path Abs File)]
resolveUsages Interface
iface
      (Set ModuleName, [Path Abs File])
-> RIO Ctx (Set ModuleName, [Path Abs File])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ModuleName] -> Set ModuleName
forall a. Ord a => [a] -> Set a
S.fromList ([ModuleName] -> Set ModuleName) -> [ModuleName] -> Set ModuleName
forall a b. (a -> b) -> a -> b
$ Interface -> [ModuleName]
moduleNames Interface
iface, [Path Abs File]
resolvedUsages)

-- | Try to resolve the list of base names in the given directory by
-- looking for unique instances of base names applied with the given
-- extensions.
resolveFiles
    :: [Path Abs Dir] -- ^ Directories to look in.
    -> [DotCabalDescriptor] -- ^ Base names.
    -> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles :: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names =
    [DotCabalDescriptor]
-> (DotCabalDescriptor
    -> RIO Ctx (DotCabalDescriptor, Maybe DotCabalPath))
-> RIO Ctx [(DotCabalDescriptor, Maybe DotCabalPath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DotCabalDescriptor]
names (\DotCabalDescriptor
name -> (Maybe DotCabalPath -> (DotCabalDescriptor, Maybe DotCabalPath))
-> RIO Ctx (Maybe DotCabalPath)
-> RIO Ctx (DotCabalDescriptor, Maybe DotCabalPath)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (DotCabalDescriptor
name, ) ([Path Abs Dir]
-> DotCabalDescriptor -> RIO Ctx (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name))

data CabalFileNameParseFail
  = CabalFileNameParseFail FilePath
  | CabalFileNameInvalidPackageName FilePath
  deriving (Typeable)

instance Exception CabalFileNameParseFail
instance Show CabalFileNameParseFail where
    show :: CabalFileNameParseFail -> FilePath
show (CabalFileNameParseFail FilePath
fp) = FilePath
"Invalid file path for cabal file, must have a .cabal extension: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp
    show (CabalFileNameInvalidPackageName FilePath
fp) = FilePath
"cabal file names must use valid package names followed by a .cabal extension, the following is invalid: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp

-- | Parse a package name from a file path.
parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName
parsePackageNameFromFilePath :: Path a File -> m PackageName
parsePackageNameFromFilePath Path a File
fp = do
    FilePath
base <- FilePath -> m FilePath
clean (FilePath -> m FilePath) -> FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath) -> Path Rel File -> FilePath
forall a b. (a -> b) -> a -> b
$ Path a File -> Path Rel File
forall b. Path b File -> Path Rel File
filename Path a File
fp
    case FilePath -> Maybe PackageName
parsePackageName FilePath
base of
        Maybe PackageName
Nothing -> CabalFileNameParseFail -> m PackageName
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (CabalFileNameParseFail -> m PackageName)
-> CabalFileNameParseFail -> m PackageName
forall a b. (a -> b) -> a -> b
$ FilePath -> CabalFileNameParseFail
CabalFileNameInvalidPackageName (FilePath -> CabalFileNameParseFail)
-> FilePath -> CabalFileNameParseFail
forall a b. (a -> b) -> a -> b
$ Path a File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path a File
fp
        Just PackageName
x -> PackageName -> m PackageName
forall (m :: * -> *) a. Monad m => a -> m a
return PackageName
x
  where clean :: FilePath -> m FilePath
clean = (FilePath -> FilePath) -> m FilePath -> m FilePath
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM FilePath -> FilePath
forall a. [a] -> [a]
reverse (m FilePath -> m FilePath)
-> (FilePath -> m FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m FilePath
forall (m :: * -> *). MonadThrow m => FilePath -> m FilePath
strip (FilePath -> m FilePath)
-> (FilePath -> FilePath) -> FilePath -> m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. [a] -> [a]
reverse
        strip :: FilePath -> m FilePath
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':FilePath
xs) = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
xs
        strip FilePath
_ = CabalFileNameParseFail -> m FilePath
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (FilePath -> CabalFileNameParseFail
CabalFileNameParseFail (Path a File -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path a File
fp))

-- | Find a candidate for the given module-or-filename from the list
-- of directories and given extensions.
findCandidate
    :: [Path Abs Dir]
    -> DotCabalDescriptor
    -> RIO Ctx (Maybe DotCabalPath)
findCandidate :: [Path Abs Dir]
-> DotCabalDescriptor -> RIO Ctx (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name = do
    PackageName
pkg <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile RIO Ctx (Path Abs File)
-> (Path Abs File -> RIO Ctx PackageName) -> RIO Ctx PackageName
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> RIO Ctx PackageName
forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath
    [Path Abs File]
candidates <- IO [Path Abs File] -> RIO Ctx [Path Abs File]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [Path Abs File]
makeNameCandidates
    case [Path Abs File]
candidates of
        [Path Abs File
candidate] -> Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DotCabalPath -> Maybe DotCabalPath
forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
        [] -> do
            case DotCabalDescriptor
name of
                DotCabalModule ModuleName
mn
                  | ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
mn FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName -> FilePath
paths_pkg PackageName
pkg -> [Path Abs Dir] -> ModuleName -> RIO Ctx ()
forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn
                DotCabalDescriptor
_ -> () -> RIO Ctx ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DotCabalPath
forall a. Maybe a
Nothing
        (Path Abs File
candidate:[Path Abs File]
rest) -> do
            DotCabalDescriptor
-> Path Abs File -> [Path Abs File] -> RIO Ctx ()
forall b t.
DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path Abs File
candidate [Path Abs File]
rest
            Maybe DotCabalPath -> RIO Ctx (Maybe DotCabalPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (DotCabalPath -> Maybe DotCabalPath
forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
  where
    cons :: Path Abs File -> DotCabalPath
cons =
        case DotCabalDescriptor
name of
            DotCabalModule{} -> Path Abs File -> DotCabalPath
DotCabalModulePath
            DotCabalMain{} -> Path Abs File -> DotCabalPath
DotCabalMainPath
            DotCabalFile{} -> Path Abs File -> DotCabalPath
DotCabalFilePath
            DotCabalCFile{} -> Path Abs File -> DotCabalPath
DotCabalCFilePath
    paths_pkg :: PackageName -> FilePath
paths_pkg PackageName
pkg = FilePath
"Paths_" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageName -> FilePath
packageNameString PackageName
pkg
    makeNameCandidates :: IO [Path Abs File]
makeNameCandidates =
        ([[Path Abs File]] -> [Path Abs File])
-> IO [[Path Abs File]] -> IO [Path Abs File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Path Abs File] -> [Path Abs File]
forall a. Ord a => [a] -> [a]
nubOrd ([Path Abs File] -> [Path Abs File])
-> ([[Path Abs File]] -> [Path Abs File])
-> [[Path Abs File]]
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ((Path Abs Dir -> IO [Path Abs File])
-> [Path Abs Dir] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Path Abs Dir]
dirs)
    makeDirCandidates :: Path Abs Dir
                      -> IO [Path Abs File]
    makeDirCandidates :: Path Abs Dir -> IO [Path Abs File]
makeDirCandidates Path Abs Dir
dir =
        case DotCabalDescriptor
name of
            DotCabalMain FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
            DotCabalFile FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
            DotCabalCFile FilePath
fp -> Path Abs Dir -> FilePath -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir FilePath
fp
            DotCabalModule ModuleName
mn -> do
              let perExt :: Text -> f [Path Abs File]
perExt Text
ext =
                     Path Abs Dir -> FilePath -> f [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir (ModuleName -> FilePath
Cabal.toFilePath ModuleName
mn FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Text -> FilePath
T.unpack Text
ext)
              [[Path Abs File]]
withHaskellExts <- (Text -> IO [Path Abs File]) -> [Text] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellFileExts
              [[Path Abs File]]
withPPExts <- (Text -> IO [Path Abs File]) -> [Text] -> IO [[Path Abs File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> IO [Path Abs File]
forall (f :: * -> *).
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellPreprocessorExts
              [Path Abs File] -> IO [Path Abs File]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Abs File] -> IO [Path Abs File])
-> [Path Abs File] -> IO [Path Abs File]
forall a b. (a -> b) -> a -> b
$
                case ([[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withHaskellExts, [[Path Abs File]] -> [Path Abs File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withPPExts) of
                  -- If we have exactly 1 Haskell extension and exactly
                  -- 1 preprocessor extension, assume the former file is
                  -- generated from the latter
                  --
                  -- See https://github.com/commercialhaskell/stack/issues/4076
                  ([Path Abs File
_], [Path Abs File
y]) -> [Path Abs File
y]

                  -- Otherwise, return everything
                  ([Path Abs File]
xs, [Path Abs File]
ys) -> [Path Abs File]
xs [Path Abs File] -> [Path Abs File] -> [Path Abs File]
forall a. [a] -> [a] -> [a]
++ [Path Abs File]
ys
    resolveCandidate :: Path Abs Dir -> FilePath -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir = (Maybe (Path Abs File) -> [Path Abs File])
-> f (Maybe (Path Abs File)) -> f [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Path Abs File) -> [Path Abs File]
forall a. Maybe a -> [a]
maybeToList (f (Maybe (Path Abs File)) -> f [Path Abs File])
-> (FilePath -> f (Maybe (Path Abs File)))
-> FilePath
-> f [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> FilePath -> f (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir

-- | Resolve file as a child of a specified directory, symlinks
-- don't get followed.
resolveDirFile
    :: (MonadIO m, MonadThrow m)
    => Path Abs Dir -> FilePath.FilePath -> m (Maybe (Path Abs File))
resolveDirFile :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
x FilePath
y = do
    -- The standard canonicalizePath does not work for this case
    Path Abs File
p <- FilePath -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Abs File)
parseCollapsedAbsFile (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
x FilePath -> FilePath -> FilePath
FilePath.</> FilePath
y)
    Bool
exists <- Path Abs File -> m Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p
    Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall a b. (a -> b) -> a -> b
$ if Bool
exists then Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just Path Abs File
p else Maybe (Path Abs File)
forall a. Maybe a
Nothing

-- | Warn the user that multiple candidates are available for an
-- entry, but that we picked one anyway and continued.
warnMultiple
    :: DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple :: DotCabalDescriptor -> Path b t -> [Path b t] -> RIO Ctx ()
warnMultiple DotCabalDescriptor
name Path b t
candidate [Path b t]
rest =
    -- TODO: figure out how to style 'name' and the dispOne stuff
    [StyleDoc] -> RIO Ctx ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ FilePath -> StyleDoc
flow FilePath
"There were multiple candidates for the Cabal entry"
        , FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc)
-> (DotCabalDescriptor -> FilePath)
-> DotCabalDescriptor
-> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> FilePath
showName (DotCabalDescriptor -> StyleDoc) -> DotCabalDescriptor -> StyleDoc
forall a b. (a -> b) -> a -> b
$ DotCabalDescriptor
name
        , StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((Path b t -> StyleDoc) -> [Path b t] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map Path b t -> StyleDoc
forall b t. Path b t -> StyleDoc
dispOne (Path b t
candidatePath b t -> [Path b t] -> [Path b t]
forall a. a -> [a] -> [a]
:[Path b t]
rest))
        , StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> StyleDoc
flow FilePath
"picking:"
        , Path b t -> StyleDoc
forall b t. Path b t -> StyleDoc
dispOne Path b t
candidate
        ]
  where showName :: DotCabalDescriptor -> FilePath
showName (DotCabalModule ModuleName
name') = ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
name'
        showName (DotCabalMain FilePath
fp) = FilePath
fp
        showName (DotCabalFile FilePath
fp) = FilePath
fp
        showName (DotCabalCFile FilePath
fp) = FilePath
fp
        dispOne :: Path b t -> StyleDoc
dispOne = FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc)
-> (Path b t -> FilePath) -> Path b t -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> FilePath
forall b t. Path b t -> FilePath
toFilePath
          -- TODO: figure out why dispOne can't be just `display`
          --       (remove the .hlint.yaml exception if it can be)

-- | Log that we couldn't find a candidate, but there are
-- possibilities for custom preprocessor extensions.
--
-- For example: .erb for a Ruby file might exist in one of the
-- directories.
logPossibilities
    :: HasTerm env
    => [Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities :: [Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn = do
    [Path Rel File]
possibilities <- ([[Path Rel File]] -> [Path Rel File])
-> RIO env [[Path Rel File]] -> RIO env [Path Rel File]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[Path Rel File]] -> [Path Rel File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ModuleName -> RIO env [[Path Rel File]]
forall (m :: * -> *) a.
(MonadIO m, Pretty a) =>
a -> m [[Path Rel File]]
makePossibilities ModuleName
mn)
    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Path Rel File] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel File]
possibilities) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ FilePath -> StyleDoc
flow FilePath
"Unable to find a known candidate for the Cabal entry"
        , (Style -> StyleDoc -> StyleDoc
style Style
PP.Module (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
D.display ModuleName
mn) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
        , FilePath -> StyleDoc
flow FilePath
"but did find:"
        , StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList ((Path Rel File -> StyleDoc) -> [Path Rel File] -> [StyleDoc]
forall a b. (a -> b) -> [a] -> [b]
map Path Rel File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty [Path Rel File]
possibilities)
        , FilePath -> StyleDoc
flow FilePath
"If you are using a custom preprocessor for this module"
        , FilePath -> StyleDoc
flow FilePath
"with its own file extension, consider adding the file(s)"
        , FilePath -> StyleDoc
flow FilePath
"to your .cabal under extra-source-files."
        ]
  where
    makePossibilities :: a -> m [[Path Rel File]]
makePossibilities a
name =
        (Path Abs Dir -> m [Path Rel File])
-> [Path Abs Dir] -> m [[Path Rel File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
            (\Path Abs Dir
dir ->
                  do ([Path Abs Dir]
_,[Path Abs File]
files) <- Path Abs Dir -> m ([Path Abs Dir], [Path Abs File])
forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
                     [Path Rel File] -> m [Path Rel File]
forall (m :: * -> *) a. Monad m => a -> m a
return
                         ((Path Abs File -> Path Rel File)
-> [Path Abs File] -> [Path Rel File]
forall a b. (a -> b) -> [a] -> [b]
map
                              Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename
                              ((Path Abs File -> Bool) -> [Path Abs File] -> [Path Abs File]
forall a. (a -> Bool) -> [a] -> [a]
filter
                                   (FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (a -> FilePath
forall a. Pretty a => a -> FilePath
D.display a
name) (FilePath -> Bool)
-> (Path Abs File -> FilePath) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                    Path Rel File -> FilePath
forall b t. Path b t -> FilePath
toFilePath (Path Rel File -> FilePath)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> Path Rel File
forall b. Path b File -> Path Rel File
filename)
                                   [Path Abs File]
files)))
            [Path Abs Dir]
dirs

-- | Path for the package's build log.
buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m)
             => Package -> Maybe String -> m (Path Abs File)
buildLogPath :: Package -> Maybe FilePath -> m (Path Abs File)
buildLogPath Package
package' Maybe FilePath
msuffix = do
  env
env <- m env
forall r (m :: * -> *). MonadReader r m => m r
ask
  let stack :: Path Abs Dir
stack = env -> Path Abs Dir
forall env (m :: * -> *).
(HasBuildConfig env, MonadReader env m) =>
m (Path Abs Dir)
getProjectWorkDir env
env
  Path Rel File
fp <- FilePath -> m (Path Rel File)
forall (m :: * -> *). MonadThrow m => FilePath -> m (Path Rel File)
parseRelFile (FilePath -> m (Path Rel File)) -> FilePath -> m (Path Rel File)
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$
    PackageIdentifier -> FilePath
packageIdentifierString (Package -> PackageIdentifier
packageIdentifier Package
package') FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
    ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath] -> [FilePath])
-> Maybe FilePath
-> [FilePath]
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [FilePath] -> [FilePath]
forall a. a -> a
id (\FilePath
suffix -> (FilePath
"-" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
suffix FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:)) Maybe FilePath
msuffix [FilePath
".log"]
  Path Abs File -> m (Path Abs File)
forall (m :: * -> *) a. Monad m => a -> m a
return (Path Abs File -> m (Path Abs File))
-> Path Abs File -> m (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Path Abs Dir
stack Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirLogs Path Rel Dir -> Path Rel File -> Path Rel File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fp

-- Internal helper to define resolveFileOrWarn and resolveDirOrWarn
resolveOrWarn :: Text
              -> (Path Abs Dir -> String -> RIO Ctx (Maybe a))
              -> FilePath.FilePath
              -> RIO Ctx (Maybe a)
resolveOrWarn :: Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
subject Path Abs Dir -> FilePath -> RIO Ctx (Maybe a)
resolver FilePath
path =
  do Path Abs Dir
cwd <- IO (Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
     Path Abs File
file <- (Ctx -> Path Abs File) -> RIO Ctx (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Ctx -> Path Abs File
ctxFile
     Path Abs Dir
dir <- (Ctx -> Path Abs Dir) -> RIO Ctx (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent (Path Abs File -> Path Abs Dir)
-> (Ctx -> Path Abs File) -> Ctx -> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Path Abs File
ctxFile)
     Maybe a
result <- Path Abs Dir -> FilePath -> RIO Ctx (Maybe a)
resolver Path Abs Dir
dir FilePath
path
     Bool -> RIO Ctx () -> RIO Ctx ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
result) (RIO Ctx () -> RIO Ctx ()) -> RIO Ctx () -> RIO Ctx ()
forall a b. (a -> b) -> a -> b
$ Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd FilePath
path Path Abs File
file
     Maybe a -> RIO Ctx (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
result

warnMissingFile :: Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile :: Text -> Path Abs Dir -> FilePath -> Path Abs File -> RIO Ctx ()
warnMissingFile Text
subject Path Abs Dir
cwd FilePath
path Path Abs File
fromFile =
    [StyleDoc] -> RIO Ctx ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
        [ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> (Text -> FilePath) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
subject -- TODO: needs style?
        , FilePath -> StyleDoc
flow FilePath
"listed in"
        , StyleDoc
-> (Path Rel File -> StyleDoc) -> Maybe (Path Rel File) -> StyleDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Path Abs File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fromFile) Path Rel File -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty (Path Abs Dir -> Path Abs File -> Maybe (Path Rel File)
forall (m :: * -> *) b t.
MonadThrow m =>
Path b Dir -> Path b t -> m (Path Rel t)
stripProperPrefix Path Abs Dir
cwd Path Abs File
fromFile)
        , FilePath -> StyleDoc
flow FilePath
"file does not exist:"
        , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath
path
        ]

-- | Resolve the file, if it can't be resolved, warn for the user
-- (purely to be helpful).
resolveFileOrWarn :: FilePath.FilePath
                  -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn :: FilePath -> RIO Ctx (Maybe (Path Abs File))
resolveFileOrWarn = Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File)))
-> FilePath
-> RIO Ctx (Maybe (Path Abs File))
forall a.
Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"File" Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f
  where f :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f Path Abs Dir
p FilePath
x = IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs File) -> IO (Maybe (Path Abs File))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs File)
resolveFile Path Abs Dir
p FilePath
x)) m (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File) -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile

-- | Resolve the directory, if it can't be resolved, warn for the user
-- (purely to be helpful).
resolveDirOrWarn :: FilePath.FilePath
                 -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn :: FilePath -> RIO Ctx (Maybe (Path Abs Dir))
resolveDirOrWarn = Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs Dir)))
-> FilePath
-> RIO Ctx (Maybe (Path Abs Dir))
forall a.
Text
-> (Path Abs Dir -> FilePath -> RIO Ctx (Maybe a))
-> FilePath
-> RIO Ctx (Maybe a)
resolveOrWarn Text
"Directory" Path Abs Dir -> FilePath -> RIO Ctx (Maybe (Path Abs Dir))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs Dir))
f
  where f :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs Dir))
f Path Abs Dir
p FilePath
x = IO (Maybe (Path Abs Dir)) -> m (Maybe (Path Abs Dir))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Abs Dir) -> IO (Maybe (Path Abs Dir))
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (Path Abs Dir -> FilePath -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> FilePath -> m (Path Abs Dir)
resolveDir Path Abs Dir
p FilePath
x)) m (Maybe (Path Abs Dir))
-> (Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir)))
-> m (Maybe (Path Abs Dir))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
rejectMissingDir

    {- FIXME
-- | Create a 'ProjectPackage' from a directory containing a package.
mkProjectPackage
  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => PrintWarnings
  -> ResolvedPath Dir
  -> RIO env ProjectPackage
mkProjectPackage printWarnings dir = do
  (gpd, name, cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
  return ProjectPackage
    { ppCabalFP = cabalfp
    , ppGPD' = gpd printWarnings
    , ppResolvedDir = dir
    , ppName = name
    }

-- | Create a 'DepPackage' from a 'PackageLocation'
mkDepPackage
  :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
  => PackageLocation
  -> RIO env DepPackage
mkDepPackage pl = do
  (name, gpdio) <-
    case pl of
      PLMutable dir -> do
        (gpdio, name, _cabalfp) <- loadCabalFilePath (resolvedAbsolute dir)
        pure (name, gpdio NoPrintWarnings)
      PLImmutable pli -> do
        PackageIdentifier name _ <- getPackageLocationIdent pli
        run <- askRunInIO
        pure (name, run $ loadCabalFileImmutable pli)
  return DepPackage
    { dpGPD' = gpdio
    , dpLocation = pl
    , dpName = name
    }

    -}

-- | Force a package to be treated as a custom build type, see
-- <https://github.com/commercialhaskell/stack/issues/4488>
applyForceCustomBuild
  :: Version -- ^ global Cabal version
  -> Package
  -> Package
applyForceCustomBuild :: Version -> Package -> Package
applyForceCustomBuild Version
cabalVersion Package
package
    | Bool
forceCustomBuild =
        Package
package
          { packageBuildType :: BuildType
packageBuildType = BuildType
Custom
          , packageDeps :: Map PackageName DepValue
packageDeps = (DepValue -> DepValue -> DepValue)
-> PackageName
-> DepValue
-> Map PackageName DepValue
-> Map PackageName DepValue
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith DepValue -> DepValue -> DepValue
forall a. Semigroup a => a -> a -> a
(<>) PackageName
"Cabal" (VersionRange -> DepType -> DepValue
DepValue VersionRange
cabalVersionRange DepType
AsLibrary)
                        (Map PackageName DepValue -> Map PackageName DepValue)
-> Map PackageName DepValue -> Map PackageName DepValue
forall a b. (a -> b) -> a -> b
$ Package -> Map PackageName DepValue
packageDeps Package
package
          , packageSetupDeps :: Maybe (Map PackageName VersionRange)
packageSetupDeps = Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a. a -> Maybe a
Just (Map PackageName VersionRange
 -> Maybe (Map PackageName VersionRange))
-> Map PackageName VersionRange
-> Maybe (Map PackageName VersionRange)
forall a b. (a -> b) -> a -> b
$ [(PackageName, VersionRange)] -> Map PackageName VersionRange
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ (PackageName
"Cabal", VersionRange
cabalVersionRange)
              , (PackageName
"base", VersionRange
anyVersion)
              ]
          }
    | Bool
otherwise = Package
package
  where
    cabalVersionRange :: VersionRange
cabalVersionRange = Package -> VersionRange
packageCabalSpec Package
package
    forceCustomBuild :: Bool
forceCustomBuild =
      Package -> BuildType
packageBuildType Package
package BuildType -> BuildType -> Bool
forall a. Eq a => a -> a -> Bool
== BuildType
Simple Bool -> Bool -> Bool
&&
      Bool -> Bool
not (Version
cabalVersion Version -> VersionRange -> Bool
`withinRange` VersionRange
cabalVersionRange)