{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings   #-}

{-|
Module      : Stack.ComponentFile
License     : BSD-3-Clause

A module which exports all component-level file-gathering logic. It also
includes utility functions for handling paths and directories.
-}

module Stack.ComponentFile
  ( resolveOrWarn
  , componentOutputDir
  , componentBuildDir
  , packageAutogenDir
  , buildDir
  , componentAutogenDir
  , ComponentFile (..)
  , stackLibraryFiles
  , stackExecutableFiles
  , stackTestSuiteFiles
  , stackBenchmarkFiles
  ) where

import           Control.Exception ( throw )
import           Data.Foldable ( foldrM )
import           Data.List ( find, isPrefixOf )
import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import           Distribution.ModuleName ( ModuleName )
import qualified Distribution.ModuleName as Cabal
import           Distribution.PackageDescription
                   ( BenchmarkInterface (..), TestSuiteInterface (..) )
import           Distribution.Text ( display )
import           Distribution.Utils.Path
                   ( PackageDir, SourceDir, SymbolicPath, getSymbolicPath )
import qualified Distribution.Utils.Path as Cabal
import           GHC.Records ( HasField )
import qualified HiFileParser as Iface
import           Path
                   ( (</>), filename, isProperPrefixOf, parent, parseRelDir
                   , stripProperPrefix
                   )
import           Path.Extra
                   ( forgivingResolveDir, forgivingResolveFile
                   , parseCollapsedAbsFile, rejectMissingDir, rejectMissingFile
                   )
import           Path.IO
                   ( doesDirExist, doesFileExist, getCurrentDir, listDir )
import           Stack.Constants
                   ( haskellDefaultPreprocessorExts, haskellFileExts
                   , relDirAutogen, relDirBuild, relDirGlobalAutogen
                   )
import           Stack.Prelude hiding ( Display (..) )
import           Stack.Types.Component
                   ( StackBenchmark (..), StackBuildInfo (..)
                   , StackExecutable (..), StackLibrary (..)
                   , StackTestSuite (..), StackUnqualCompName (..)
                   )
import           Stack.Types.ComponentUtils
                   ( emptyCompName, unqualCompToString )
import           Stack.Types.Config
                   ( Config (..), HasConfig (..), prettyStackDevL )
import           Stack.Types.NamedComponent ( NamedComponent (..) )
import           Stack.Types.Package ( PackageException (..), dotCabalModule )
import           Stack.Types.PackageFile
                   ( GetPackageFileContext (..), DotCabalDescriptor (..)
                   , DotCabalPath (..), PackageWarning (..)
                   )
import qualified System.Directory as D ( doesFileExist )
import qualified System.FilePath as FilePath

data ComponentFile = ComponentFile
  { ComponentFile -> Map ModuleName (Path Abs File)
moduleFileMap :: !(Map ModuleName (Path Abs File))
  , ComponentFile -> [DotCabalPath]
otherFile :: ![DotCabalPath]
  , ComponentFile -> [PackageWarning]
packageWarning :: ![PackageWarning]
  }

-- | Get all files referenced by the benchmark.

stackBenchmarkFiles ::
     StackBenchmark
  -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackBenchmarkFiles :: StackBenchmark
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackBenchmarkFiles StackBenchmark
bench =
  NamedComponent
-> StackBuildInfo
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
forall rec.
(CAndJsSources rec,
 HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) =>
NamedComponent
-> rec
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles (StackUnqualCompName -> NamedComponent
CBench StackBenchmark
bench.name) StackBuildInfo
build [DotCabalDescriptor]
names
 where
  names :: [DotCabalDescriptor]
  names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed

  exposed :: [DotCabalDescriptor]
  exposed :: [DotCabalDescriptor]
exposed =
    case StackBenchmark
bench.interface of
      BenchmarkExeV10 Version
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
fp]
      BenchmarkUnsupported BenchmarkType
_ -> []

  bnames :: [DotCabalDescriptor]
  bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule StackBuildInfo
build.otherModules

  build :: StackBuildInfo
  build :: StackBuildInfo
build = StackBenchmark
bench.buildInfo

-- | Get all files referenced by the test.

stackTestSuiteFiles ::
     StackTestSuite
  -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackTestSuiteFiles :: StackTestSuite
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackTestSuiteFiles StackTestSuite
test =
  NamedComponent
-> StackBuildInfo
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
forall rec.
(CAndJsSources rec,
 HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) =>
NamedComponent
-> rec
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles (StackUnqualCompName -> NamedComponent
CTest StackTestSuite
test.name) StackBuildInfo
build [DotCabalDescriptor]
names
 where
  names :: [DotCabalDescriptor]
  names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. Semigroup a => a -> a -> a
<> [DotCabalDescriptor]
exposed

  exposed :: [DotCabalDescriptor]
  exposed :: [DotCabalDescriptor]
exposed =
    case StackTestSuite
test.interface of
      TestSuiteExeV10 Version
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
fp]
      TestSuiteLibV09 Version
_ ModuleName
mn -> [ModuleName -> DotCabalDescriptor
DotCabalModule ModuleName
mn]
      TestSuiteUnsupported TestType
_ -> []

  bnames :: [DotCabalDescriptor]
  bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule StackBuildInfo
build.otherModules

  build :: StackBuildInfo
  build :: StackBuildInfo
build = StackTestSuite
test.buildInfo

-- | Get all files referenced by the executable.

stackExecutableFiles ::
     StackExecutable
  -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackExecutableFiles :: StackExecutable
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackExecutableFiles StackExecutable
exe =
  NamedComponent
-> StackBuildInfo
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
forall rec.
(CAndJsSources rec,
 HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) =>
NamedComponent
-> rec
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles (StackUnqualCompName -> NamedComponent
CExe StackExecutable
exe.name) StackBuildInfo
build [DotCabalDescriptor]
names
 where
  build :: StackBuildInfo
  build :: StackBuildInfo
build = StackExecutable
exe.buildInfo

  names :: [DotCabalDescriptor]
  names :: [DotCabalDescriptor]
names =
    (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule StackBuildInfo
build.otherModules [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++ [String -> DotCabalDescriptor
DotCabalMain StackExecutable
exe.modulePath]

-- | Get all files referenced by the library. Handle all libraries (CLib and

-- SubLib), based on empty name or not.

stackLibraryFiles ::
     StackLibrary
  -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackLibraryFiles :: StackLibrary
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
stackLibraryFiles StackLibrary
lib =
  NamedComponent
-> StackBuildInfo
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
forall rec.
(CAndJsSources rec,
 HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) =>
NamedComponent
-> rec
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles NamedComponent
componentName StackBuildInfo
build [DotCabalDescriptor]
names
 where
  componentRawName :: StackUnqualCompName
  componentRawName :: StackUnqualCompName
componentRawName = StackLibrary
lib.name

  componentName :: NamedComponent
  componentName :: NamedComponent
componentName
    | StackUnqualCompName
componentRawName StackUnqualCompName -> StackUnqualCompName -> Bool
forall a. Eq a => a -> a -> Bool
== StackUnqualCompName
emptyCompName = NamedComponent
CLib
    | Bool
otherwise = StackUnqualCompName -> NamedComponent
CSubLib StackUnqualCompName
componentRawName

  build :: StackBuildInfo
  build :: StackBuildInfo
build = StackLibrary
lib.buildInfo

  names :: [DotCabalDescriptor]
  names :: [DotCabalDescriptor]
names = [DotCabalDescriptor]
bnames [DotCabalDescriptor]
-> [DotCabalDescriptor] -> [DotCabalDescriptor]
forall a. [a] -> [a] -> [a]
++ [DotCabalDescriptor]
exposed

  exposed :: [DotCabalDescriptor]
  exposed :: [DotCabalDescriptor]
exposed = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule StackLibrary
lib.exposedModules

  bnames :: [DotCabalDescriptor]
  bnames :: [DotCabalDescriptor]
bnames = (ModuleName -> DotCabalDescriptor)
-> [ModuleName] -> [DotCabalDescriptor]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule StackBuildInfo
build.otherModules

-- | Get all files referenced by the component.

resolveComponentFiles ::
     ( CAndJsSources rec
     , HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]
     )
  => NamedComponent
  -> rec
  -> [DotCabalDescriptor]
  -> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles :: forall rec.
(CAndJsSources rec,
 HasField "hsSourceDirs" rec [SymbolicPath PackageDir SourceDir]) =>
NamedComponent
-> rec
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext (NamedComponent, ComponentFile)
resolveComponentFiles NamedComponent
component rec
build [DotCabalDescriptor]
names = do
  dirs <- (SymbolicPath PackageDir SourceDir
 -> RIO GetPackageFileContext (Maybe (Path Abs Dir)))
-> [SymbolicPath PackageDir SourceDir]
-> RIO GetPackageFileContext [Path Abs Dir]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (String -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn (String -> RIO GetPackageFileContext (Maybe (Path Abs Dir)))
-> (SymbolicPath PackageDir SourceDir -> String)
-> SymbolicPath PackageDir SourceDir
-> RIO GetPackageFileContext (Maybe (Path Abs Dir))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPath PackageDir SourceDir -> String
forall from to. SymbolicPath from to -> String
getSymbolicPath) rec
build.hsSourceDirs
  dir <- asks (parent . (.file))
  agdirs <- autogenDirs
  (modules,files,warnings) <-
    resolveFilesAndDeps
      component
      ((if null dirs then [dir] else dirs) ++ agdirs)
      names
  cfiles <- buildOtherSources build
  pure (component, ComponentFile modules (files <> cfiles) warnings)
 where
  autogenDirs :: RIO GetPackageFileContext [Path Abs Dir]
  autogenDirs :: RIO GetPackageFileContext [Path Abs Dir]
autogenDirs = do
    distDir <- (GetPackageFileContext -> Path Abs Dir)
-> RIO GetPackageFileContext (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.distDir)
    let compDir = NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir NamedComponent
component Path Abs Dir
distDir
        pkgDir = [Path Abs Dir -> Path Abs Dir
packageAutogenDir Path Abs Dir
distDir]
    filterM doesDirExist $ compDir : pkgDir

-- | 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
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps :: NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps NamedComponent
component [Path Abs Dir]
dirs [DotCabalDescriptor]
names0 = do
  (dotCabalPaths, foundModules, missingModules, _) <- [DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map (ZonkAny 0) (ZonkAny 1))
forall k a.
[DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map k a)
loop [DotCabalDescriptor]
names0 Set ModuleName
forall a. Set a
S.empty Map String (Path Abs File)
forall k a. Map k a
M.empty
  warnings <-
    liftM2 (++) (warnUnlisted foundModules) (warnMissing missingModules)
  pure (foundModules, dotCabalPaths, warnings)
 where
  loop ::
       [DotCabalDescriptor]
    -> Set ModuleName
    -> Map FilePath (Path Abs File)
       -- ^ Known file usages, where the file path has already been resolved.

    -> RIO
         GetPackageFileContext
         ( [DotCabalPath]
         , Map ModuleName (Path Abs File)
         , [ModuleName]
         , Map k a
         )
  loop :: forall k a.
[DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map k a)
loop [] Set ModuleName
_ Map String (Path Abs File)
_ = ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
 Map k a)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map k a)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Map ModuleName (Path Abs File)
forall k a. Map k a
M.empty, [], Map k a
forall k a. Map k a
M.empty)
  loop [DotCabalDescriptor]
names Set ModuleName
doneModules0 Map String (Path Abs File)
knownUsages = do
    resolved <- [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names
    let 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 = ((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 = ((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
        getDependenciesFold DotCabalPath
c ([(Set ModuleName, Map String (Path Abs File))]
ps, Map String (Path Abs File)
ku) = do
          p <- Map String (Path Abs File)
-> NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
getDependencies Map String (Path Abs File)
ku NamedComponent
component [Path Abs Dir]
dirs DotCabalPath
c
          pure (p : ps, ku <> snd p)
    (pairs, foundUsages) <- foldrM getDependenciesFold ([], knownUsages) foundFiles
    let 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] -> Set ModuleName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (((Set ModuleName, Map String (Path Abs File)) -> Set ModuleName)
-> [(Set ModuleName, Map String (Path Abs File))]
-> [Set ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (Set ModuleName, Map String (Path Abs File)) -> Set ModuleName
forall a b. (a, b) -> a
fst [(Set ModuleName, Map String (Path Abs File))]
pairs)
        thDepFiles = ((Set ModuleName, Map String (Path Abs File)) -> [Path Abs File])
-> [(Set ModuleName, Map String (Path Abs File))]
-> [Path Abs File]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Map String (Path Abs File) -> [Path Abs File]
forall k a. Map k a -> [a]
M.elems (Map String (Path Abs File) -> [Path Abs File])
-> ((Set ModuleName, Map String (Path Abs File))
    -> Map String (Path Abs File))
-> (Set ModuleName, Map String (Path Abs File))
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set ModuleName, Map String (Path Abs File))
-> Map String (Path Abs File)
forall a b. (a, b) -> b
snd) [(Set ModuleName, Map String (Path Abs File))]
pairs
        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.

    (resolvedFiles, resolvedModules, _, foundUsages') <-
      loop (map DotCabalModule (S.toList modulesRemaining)) doneModules foundUsages
    pure
      ( nubOrd $ foundFiles <> map DotCabalFilePath thDepFiles <> resolvedFiles
      , M.union (M.fromList foundModules) resolvedModules
      , missingModules
      , foundUsages'
      )
  warnUnlisted :: Map ModuleName (Path Abs File)
-> RIO GetPackageFileContext [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules = do
    let unlistedModules :: Map ModuleName (Path Abs File)
unlistedModules =
          Map ModuleName (Path Abs File)
foundModules Map ModuleName (Path Abs File)
-> Map ModuleName () -> Map ModuleName (Path Abs File)
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 a b. (a -> b) -> Maybe a -> Maybe b
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] -> RIO GetPackageFileContext [PackageWarning]
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageWarning] -> RIO GetPackageFileContext [PackageWarning])
-> [PackageWarning] -> RIO GetPackageFileContext [PackageWarning]
forall a b. (a -> b) -> a -> b
$
      [ NamedComponent -> [ModuleName] -> PackageWarning
UnlistedModulesWarning
          NamedComponent
component
          (((ModuleName, Path Abs File) -> ModuleName)
-> [(ModuleName, Path Abs File)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
map (ModuleName, Path Abs File) -> ModuleName
forall a b. (a, b) -> a
fst (Map ModuleName (Path Abs File) -> [(ModuleName, Path Abs File)]
forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName (Path Abs File)
unlistedModules))
      | Bool -> Bool
not (Map ModuleName (Path Abs File) -> Bool
forall k a. Map k a -> Bool
M.null Map ModuleName (Path Abs File)
unlistedModules)
      ]
  warnMissing :: p -> f [a]
warnMissing p
_missingModules =
    [a] -> f [a]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      -- TODO: bring this back - see

      -- https://github.com/commercialhaskell/stack/issues/2649

      {-
      cabalfp <- asks ctxFile
      pure $
          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 ::
     Map FilePath (Path Abs File)
     -- ^ Known file usages, where the file path has already been resolved.

  -> NamedComponent
  -> [Path Abs Dir]
  -> DotCabalPath
  -> RIO GetPackageFileContext (Set ModuleName, Map FilePath (Path Abs File))
getDependencies :: Map String (Path Abs File)
-> NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
getDependencies Map String (Path Abs File)
knownUsages NamedComponent
component [Path Abs Dir]
dirs DotCabalPath
dotCabalPath =
  case DotCabalPath
dotCabalPath of
    DotCabalModulePath Path Abs File
resolvedFile -> Path Abs File
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
readResolvedHi Path Abs File
resolvedFile
    DotCabalMainPath Path Abs File
resolvedFile -> Path Abs File
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
readResolvedHi Path Abs File
resolvedFile
    DotCabalFilePath{} -> (Set ModuleName, Map String (Path Abs File))
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, Map String (Path Abs File)
forall k a. Map k a
M.empty)
    DotCabalCFilePath{} -> (Set ModuleName, Map String (Path Abs File))
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, Map String (Path Abs File)
forall k a. Map k a
M.empty)
 where
  readResolvedHi :: Path Abs File
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
readResolvedHi Path Abs File
resolvedFile = do
    dumpHIDir <- NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
component (Path Abs Dir -> Path Abs Dir)
-> RIO GetPackageFileContext (Path Abs Dir)
-> RIO GetPackageFileContext (Path Abs Dir)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GetPackageFileContext -> Path Abs Dir)
-> RIO GetPackageFileContext (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.distDir)
    dir <- asks (parent . (.file))
    let 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 File -> Bool
forall b t. Path b Dir -> Path b t -> Bool
`isProperPrefixOf` Path Abs File
resolvedFile) [Path Abs Dir]
dirs
        stripSourceDir Path Abs Dir
d = 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
d Path Abs File
resolvedFile
    case stripSourceDir sourceDir of
      Maybe (Path Rel File)
Nothing -> (Set ModuleName, Map String (Path Abs File))
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, Map String (Path Abs File)
forall k a. Map k a
M.empty)
      Just Path Rel File
fileRel -> do
        let hiPath :: String
hiPath = String -> String -> String
FilePath.replaceExtension
                       (Path Abs File -> String
forall b t. Path b t -> String
toFilePath (Path Abs Dir
dumpHIDir Path Abs Dir -> Path Rel File -> Path Abs File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
fileRel))
                       String
".hi"
        dumpHIExists <- IO Bool -> RIO GetPackageFileContext Bool
forall a. IO a -> RIO GetPackageFileContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO GetPackageFileContext Bool)
-> IO Bool -> RIO GetPackageFileContext Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
D.doesFileExist String
hiPath
        if dumpHIExists
          then parseHI knownUsages hiPath
          else pure (S.empty, M.empty)

-- | Parse a .hi file into a set of modules and files (a map from a given path

-- to a file to the resolved absolute path to the file).

parseHI ::
     Map FilePath (Path Abs File)
     -- ^ Known file usages, where the file path has already been resolved.

  -> FilePath
     -- ^ The path to the *.hi file to be parsed

  -> RIO GetPackageFileContext (Set ModuleName, Map FilePath (Path Abs File))
parseHI :: Map String (Path Abs File)
-> String
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
parseHI Map String (Path Abs File)
knownUsages String
hiPath = do
  dir <- (GetPackageFileContext -> Path Abs Dir)
-> RIO GetPackageFileContext (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)
-> (GetPackageFileContext -> Path Abs File)
-> GetPackageFileContext
-> Path Abs Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.file))
  result <-
    liftIO $ catchAnyDeep
      (Iface.fromFile hiPath)
      (pure . Left . displayException)
  case result of
    Left String
msg -> do
      [StyleDoc] -> RIO GetPackageFileContext ()
forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL
        [ String -> StyleDoc
flow String
"Failed to decode module interface:"
        , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
forall a. IsString a => String -> a
fromString String
hiPath
        , String -> StyleDoc
flow String
"Decoding failure:"
        , Style -> StyleDoc -> StyleDoc
style Style
Error (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
forall a. IsString a => String -> a
fromString String
msg
        ]
      (Set ModuleName, Map String (Path Abs File))
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set ModuleName
forall a. Set a
S.empty, Map String (Path Abs File)
forall k a. Map k a
M.empty)
    Right Interface
iface -> do
      let moduleNames :: Interface -> [ModuleName]
moduleNames = ((ByteString, Bool) -> ModuleName)
-> [(ByteString, Bool)] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ModuleName
forall a. IsString a => String -> a
fromString (String -> ModuleName)
-> ((ByteString, Bool) -> String)
-> (ByteString, Bool)
-> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> ((ByteString, Bool) -> Text) -> (ByteString, Bool) -> String
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 :: String -> RIO GetPackageFileContext (Maybe (String, Path Abs File))
resolveFileDependency String
file =
            case String -> Map String (Path Abs File) -> Maybe (Path Abs File)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
file Map String (Path Abs File)
knownUsages of
              Just Path Abs File
p ->
                Maybe (String, Path Abs File)
-> RIO GetPackageFileContext (Maybe (String, Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, Path Abs File)
 -> RIO GetPackageFileContext (Maybe (String, Path Abs File)))
-> Maybe (String, Path Abs File)
-> RIO GetPackageFileContext (Maybe (String, Path Abs File))
forall a b. (a -> b) -> a -> b
$ (String, Path Abs File) -> Maybe (String, Path Abs File)
forall a. a -> Maybe a
Just (String
file, Path Abs File
p)
              Maybe (Path Abs File)
Nothing -> do
                resolved <- Path Abs Dir
-> String -> RIO GetPackageFileContext (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
dir String
file RIO GetPackageFileContext (Maybe (Path Abs File))
-> (Maybe (Path Abs File)
    -> RIO GetPackageFileContext (Maybe (Path Abs File)))
-> RIO GetPackageFileContext (Maybe (Path Abs File))
forall a b.
RIO GetPackageFileContext a
-> (a -> RIO GetPackageFileContext b)
-> RIO GetPackageFileContext b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File)
-> RIO GetPackageFileContext (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
                when (isNothing resolved) $
                  prettyWarnL
                    [ flow "Dependent file listed in:"
                    , style File $ fromString hiPath
                    , flow "does not exist:"
                    , style File $ fromString file
                    ]
                pure $ (file,) <$> resolved
          resolveUsages :: Interface
-> RIO GetPackageFileContext [Maybe (String, Path Abs File)]
resolveUsages = (Usage
 -> RIO GetPackageFileContext (Maybe (String, Path Abs File)))
-> [Usage]
-> RIO GetPackageFileContext [Maybe (String, Path Abs File)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse
            (String -> RIO GetPackageFileContext (Maybe (String, Path Abs File))
resolveFileDependency (String
 -> RIO GetPackageFileContext (Maybe (String, Path Abs File)))
-> (Usage -> String)
-> Usage
-> RIO GetPackageFileContext (Maybe (String, Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> String
Iface.unUsage) ([Usage]
 -> RIO GetPackageFileContext [Maybe (String, Path Abs File)])
-> (Interface -> [Usage])
-> Interface
-> RIO GetPackageFileContext [Maybe (String, 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
      resolvedUsages <- [Maybe (String, Path Abs File)] -> [(String, Path Abs File)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, Path Abs File)] -> [(String, Path Abs File)])
-> RIO GetPackageFileContext [Maybe (String, Path Abs File)]
-> RIO GetPackageFileContext [(String, Path Abs File)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface
-> RIO GetPackageFileContext [Maybe (String, Path Abs File)]
resolveUsages Interface
iface
      pure (S.fromList $ moduleNames iface, M.fromList resolvedUsages)

-- | 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
    CSubLib StackUnqualCompName
name -> StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
name
    CFlib StackUnqualCompName
name -> StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
name
    CExe StackUnqualCompName
name -> StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
name
    CTest StackUnqualCompName
name -> StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
name
    CBench StackUnqualCompName
name -> StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
name
 where
  makeTmp :: StackUnqualCompName -> Path Abs Dir
makeTmp StackUnqualCompName
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
</> Bool -> StackUnqualCompName -> Path Rel Dir
componentNameToDirNormOrTmp Bool
True StackUnqualCompName
name

-- | 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 GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles :: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names =
  [DotCabalDescriptor]
-> (DotCabalDescriptor
    -> RIO
         GetPackageFileContext (DotCabalDescriptor, Maybe DotCabalPath))
-> RIO
     GetPackageFileContext [(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 GetPackageFileContext (Maybe DotCabalPath)
-> RIO
     GetPackageFileContext (DotCabalDescriptor, Maybe DotCabalPath)
forall a b.
(a -> b)
-> RIO GetPackageFileContext a -> RIO GetPackageFileContext b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DotCabalDescriptor
name, ) ([Path Abs Dir]
-> DotCabalDescriptor
-> RIO GetPackageFileContext (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name))

-- | Find a candidate for the given module-or-filename from the list

-- of directories and given extensions.

findCandidate ::
     [Path Abs Dir]
  -> DotCabalDescriptor
  -> RIO GetPackageFileContext (Maybe DotCabalPath)
findCandidate :: [Path Abs Dir]
-> DotCabalDescriptor
-> RIO GetPackageFileContext (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name = do
  pkg <- (GetPackageFileContext -> Path Abs File)
-> RIO GetPackageFileContext (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (.file) RIO GetPackageFileContext (Path Abs File)
-> (Path Abs File -> RIO GetPackageFileContext PackageName)
-> RIO GetPackageFileContext PackageName
forall a b.
RIO GetPackageFileContext a
-> (a -> RIO GetPackageFileContext b)
-> RIO GetPackageFileContext b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Path Abs File -> RIO GetPackageFileContext PackageName
forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath
  customPreprocessorExts <- view $ configL . to (.customPreprocessorExts)
  let haskellPreprocessorExts =
        [Text]
haskellDefaultPreprocessorExts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
customPreprocessorExts
  liftIO (makeNameCandidates haskellPreprocessorExts) >>= \case
    [Path Abs File
candidate] -> Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> String
forall a. Pretty a => a -> String
display ModuleName
mn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= PackageName -> String
paths_pkg PackageName
pkg -> [Path Abs Dir] -> ModuleName -> RIO GetPackageFileContext ()
forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn
        DotCabalDescriptor
_ -> () -> RIO GetPackageFileContext ()
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DotCabalPath
forall a. Maybe a
Nothing
    (Path Abs File
candidate:[Path Abs File]
rest) -> do
      DotCabalDescriptor
-> Path Abs File -> [Path Abs File] -> RIO GetPackageFileContext ()
forall b t.
DotCabalDescriptor
-> Path b t -> [Path b t] -> RIO GetPackageFileContext ()
warnMultiple DotCabalDescriptor
name Path Abs File
candidate [Path Abs File]
rest
      Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> String
paths_pkg PackageName
pkg = String
"Paths_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PackageName -> String
packageNameString PackageName
pkg
  makeNameCandidates :: [Text] -> IO [Path Abs File]
makeNameCandidates [Text]
haskellPreprocessorExts =
    ([[Path Abs File]] -> [Path Abs File])
-> IO [[Path Abs File]] -> IO [Path Abs File]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ([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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Text] -> Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Text]
haskellPreprocessorExts) [Path Abs Dir]
dirs)
  makeDirCandidates ::
       [Text]
    -> Path Abs Dir
    -> IO [Path Abs File]
  makeDirCandidates :: [Text] -> Path Abs Dir -> IO [Path Abs File]
makeDirCandidates [Text]
haskellPreprocessorExts Path Abs Dir
dir =
    case DotCabalDescriptor
name of
      DotCabalMain String
fp -> Path Abs Dir -> String -> IO [Path Abs File]
forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
      DotCabalFile String
fp -> Path Abs Dir -> String -> IO [Path Abs File]
forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
      DotCabalCFile String
fp -> Path Abs Dir -> String -> IO [Path Abs File]
forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
      DotCabalModule ModuleName
mn -> do
        let perExt :: Text -> IO [Path Abs File]
perExt Text
ext =
              Path Abs Dir -> String -> IO [Path Abs File]
forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate
                Path Abs Dir
dir (ModuleName -> String
Cabal.toFilePath ModuleName
mn String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
ext)
        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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> IO [Path Abs File]
perExt [Text]
haskellFileExts
        withPPExts <- mapM perExt haskellPreprocessorExts
        pure $
          case (concat withHaskellExts, concat 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 -> String -> 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 a b. (a -> b) -> f a -> f b
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])
-> (String -> f (Maybe (Path Abs File)))
-> String
-> f [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs Dir -> String -> f (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir

-- | 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 :: forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn = do
  possibilities <- ([[Path Rel File]] -> [Path Rel File])
-> RIO env [[Path Rel File]] -> RIO env [Path Rel File]
forall a b. (a -> b) -> RIO env a -> RIO env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Path Rel File]] -> [Path Rel File]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (ModuleName -> RIO env [[Path Rel File]]
makePossibilities ModuleName
mn)
  unless (null possibilities) $ prettyWarnL
    [ flow "Unable to find a known candidate for the Cabal entry"
    , (style Module . fromString $ display mn) <> ","
    , flow "but did find:"
    , line <> bulletedList (map pretty possibilities)
    , flow "If you are using a custom preprocessor for this module"
    , flow "with its own file extension, consider adding the extension"
    , flow "to the value of the"
    , style Shell "custom-preprocessor-extensions"
    , flow "key in Stack's project-level configuration file"
    , "(" <> style File "stack.yaml" <> ")."
    ]
 where
  makePossibilities :: ModuleName -> RIO env [[Path Rel File]]
makePossibilities ModuleName
name =
    (Path Abs Dir -> RIO env [Path Rel File])
-> [Path Abs Dir] -> RIO env [[Path Rel File]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
      ( \Path Abs Dir
dir -> do
           (_,files) <- Path Abs Dir -> RIO env ([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
           pure
             ( map
                 filename
                 ( filter
                     (isPrefixOf (display name) . toFilePath . filename)
                     files
                 )
             )
      )
      [Path Abs Dir]
dirs

type CAndJsSources rec =
  (HasField "cSources" rec [FilePath], HasField "jsSources" rec [FilePath])

-- | Get all C sources and extra source files in a build.

buildOtherSources ::
     CAndJsSources rec
  => rec
  -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources :: forall rec.
CAndJsSources rec =>
rec -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources rec
build = do
  cwd <- IO (Path Abs Dir) -> RIO GetPackageFileContext (Path Abs Dir)
forall a. IO a -> RIO GetPackageFileContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  dir <- asks (parent . (.file))
  file <- asks (.file)
  let resolveDirFiles [String]
files Path Abs File -> DotCabalPath
toCabalPath =
        [String]
-> (String -> RIO GetPackageFileContext (Maybe DotCabalPath))
-> RIO GetPackageFileContext [DotCabalPath]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [String]
files ((String -> RIO GetPackageFileContext (Maybe DotCabalPath))
 -> RIO GetPackageFileContext [DotCabalPath])
-> (String -> RIO GetPackageFileContext (Maybe DotCabalPath))
-> RIO GetPackageFileContext [DotCabalPath]
forall a b. (a -> b) -> a -> b
$ \String
fp ->
          Path Abs Dir
-> String -> RIO GetPackageFileContext (Maybe (Path Abs File))
forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir String
fp RIO GetPackageFileContext (Maybe (Path Abs File))
-> (Maybe (Path Abs File)
    -> RIO GetPackageFileContext (Maybe DotCabalPath))
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a b.
RIO GetPackageFileContext a
-> (a -> RIO GetPackageFileContext b)
-> RIO GetPackageFileContext b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe (Path Abs File)
Nothing -> do
              Text
-> Path Abs Dir
-> String
-> Path Abs File
-> RIO GetPackageFileContext ()
warnMissingFile Text
"File" Path Abs Dir
cwd String
fp Path Abs File
file
              Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DotCabalPath
forall a. Maybe a
Nothing
            Just Path Abs File
p -> Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DotCabalPath
 -> RIO GetPackageFileContext (Maybe DotCabalPath))
-> Maybe DotCabalPath
-> RIO GetPackageFileContext (Maybe DotCabalPath)
forall a b. (a -> b) -> a -> b
$ DotCabalPath -> Maybe DotCabalPath
forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
toCabalPath Path Abs File
p)
  csources <- resolveDirFiles build.cSources DotCabalCFilePath
  jsources <- resolveDirFiles build.jsSources DotCabalFilePath
  pure (csources <> jsources)

-- | 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 :: forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
x String
y = do
  -- The standard canonicalizePath does not work for this case

  p <- String -> m (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseCollapsedAbsFile (Path Abs Dir -> String
forall b t. Path b t -> String
toFilePath Path Abs Dir
x String -> String -> String
FilePath.</> String
y)
  exists <- doesFileExist p
  pure $ if exists then Just p else 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 GetPackageFileContext ()
warnMultiple :: forall b t.
DotCabalDescriptor
-> Path b t -> [Path b t] -> RIO GetPackageFileContext ()
warnMultiple DotCabalDescriptor
name Path b t
candidate [Path b t]
rest =
  -- TODO: figure out how to style 'name' and the dispOne stuff

  [StyleDoc] -> RIO GetPackageFileContext ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
    [ String -> StyleDoc
flow String
"There were multiple candidates for the Cabal entry"
    , String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc)
-> (DotCabalDescriptor -> String) -> DotCabalDescriptor -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> String
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
<> String -> StyleDoc
flow String
"picking:"
    , Path b t -> StyleDoc
forall {b} {t}. Path b t -> StyleDoc
dispOne Path b t
candidate
    ]
 where
  showName :: DotCabalDescriptor -> String
showName (DotCabalModule ModuleName
name') = ModuleName -> String
forall a. Pretty a => a -> String
display ModuleName
name'
  showName (DotCabalMain String
fp) = String
fp
  showName (DotCabalFile String
fp) = String
fp
  showName (DotCabalCFile String
fp) = String
fp
  dispOne :: Path b t -> StyleDoc
dispOne = String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc)
-> (Path b t -> String) -> Path b t -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> String
forall b t. Path b t -> String
toFilePath
    -- TODO: figure out why dispOne can't be just `display`

    --       (remove the .hlint.yaml exception if it can be)


-- | Parse a package name from a file path.

parsePackageNameFromFilePath :: MonadThrow m => Path a File -> m PackageName
parsePackageNameFromFilePath :: forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath Path a File
fp = do
  base <- String -> m String
clean (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Rel File -> String) -> Path Rel File -> String
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 parsePackageName base of
    Maybe PackageName
Nothing -> PackageException -> m PackageName
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (PackageException -> m PackageName)
-> PackageException -> m PackageName
forall a b. (a -> b) -> a -> b
$ String -> PackageException
CabalFileNameInvalidPackageName (String -> PackageException) -> String -> PackageException
forall a b. (a -> b) -> a -> b
$ Path a File -> String
forall b t. Path b t -> String
toFilePath Path a File
fp
    Just PackageName
x -> PackageName -> m PackageName
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageName
x
 where
  clean :: String -> m String
clean = (String -> String) -> m String -> m String
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
forall a. [a] -> [a]
reverse (m String -> m String)
-> (String -> m String) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m String
strip (String -> m String) -> (String -> String) -> String -> m String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
  strip :: String -> m String
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':String
xs) = String -> m String
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
  strip String
_ = PackageException -> m String
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (String -> PackageException
CabalFileNameParseFail (Path a File -> String
forall b t. Path b t -> String
toFilePath Path a File
fp))

-- | Resolve the directory, if it can't be resolved, warn for the user

-- (purely to be helpful).

resolveDirOrWarn ::
     FilePath.FilePath
  -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn :: String -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn = Text
-> (Path Abs Dir
    -> String -> RIO GetPackageFileContext (Maybe (Path Abs Dir)))
-> String
-> RIO GetPackageFileContext (Maybe (Path Abs Dir))
forall a.
Text
-> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a))
-> String
-> RIO GetPackageFileContext (Maybe a)
resolveOrWarn Text
"Directory" Path Abs Dir
-> String -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
forall {m :: * -> *}.
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
f
 where
  f :: Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
f Path Abs Dir
p String
x = Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
forall {m :: * -> *}.
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs Dir))
forgivingResolveDir Path Abs Dir
p String
x m (Maybe (Path Abs Dir))
-> (Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir)))
-> m (Maybe (Path Abs Dir))
forall a b. m a -> (a -> m b) -> m b
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

-- | Make the global autogen dir if Cabal version is new enough.

packageAutogenDir :: Path Abs Dir -> Path Abs Dir
packageAutogenDir :: Path Abs Dir -> Path Abs Dir
packageAutogenDir Path Abs Dir
distDir = 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 :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentAutogenDir NamedComponent
component Path Abs Dir
distDir =
  NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir 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

-- | 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 :: StackUnqualCompName -> Path Rel Dir
componentNameToDir :: StackUnqualCompName -> Path Rel Dir
componentNameToDir = Bool -> StackUnqualCompName -> Path Rel Dir
componentNameToDirNormOrTmp Bool
False

componentNameToDirNormOrTmp :: Bool -> StackUnqualCompName -> Path Rel Dir
componentNameToDirNormOrTmp :: Bool -> StackUnqualCompName -> Path Rel Dir
componentNameToDirNormOrTmp Bool
isTemp StackUnqualCompName
name =
  Path Rel Dir -> Maybe (Path Rel Dir) -> Path Rel Dir
forall a. a -> Maybe a -> a
fromMaybe (PackageException -> Path Rel Dir
forall a e. (HasCallStack, Exception e) => e -> a
throw (PackageException -> Path Rel Dir)
-> PackageException -> Path Rel Dir
forall a b. (a -> b) -> a -> b
$ String -> PackageException
ComponentNotParsedBug String
sName) (String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir String
fullName)
 where
  fullName :: String
fullName = if Bool
isTemp then String
sName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
sName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-tmp" else String
sName
  sName :: String
sName = StackUnqualCompName -> String
unqualCompToString StackUnqualCompName
name

-- | See 'Distribution.Simple.LocalBuildInfo.componentBuildDir'

componentBuildDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir
componentBuildDir NamedComponent
component Path Abs Dir
distDir = case NamedComponent
component of
  NamedComponent
CLib -> Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir
  CSubLib StackUnqualCompName
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
</> StackUnqualCompName -> Path Rel Dir
componentNameToDir StackUnqualCompName
name
  CFlib StackUnqualCompName
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
</> StackUnqualCompName -> Path Rel Dir
componentNameToDir StackUnqualCompName
name
  CExe StackUnqualCompName
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
</> StackUnqualCompName -> Path Rel Dir
componentNameToDir StackUnqualCompName
name
  CTest StackUnqualCompName
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
</> StackUnqualCompName -> Path Rel Dir
componentNameToDir StackUnqualCompName
name
  CBench StackUnqualCompName
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
</> StackUnqualCompName -> Path Rel Dir
componentNameToDir StackUnqualCompName
name

-- Internal helper to define resolveFileOrWarn and resolveDirOrWarn

resolveOrWarn ::
     Text
  -> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a))
  -> FilePath.FilePath
  -> RIO GetPackageFileContext (Maybe a)
resolveOrWarn :: forall a.
Text
-> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a))
-> String
-> RIO GetPackageFileContext (Maybe a)
resolveOrWarn Text
subject Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a)
resolver String
path = do
  cwd <- IO (Path Abs Dir) -> RIO GetPackageFileContext (Path Abs Dir)
forall a. IO a -> RIO GetPackageFileContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
  file <- asks (.file)
  dir <- asks (parent . (.file))
  result <- resolver dir path
  when (isNothing result) $ warnMissingFile subject cwd path file
  pure result

warnMissingFile ::
     Text
  -> Path Abs Dir
  -> FilePath
  -> Path Abs File
  -> RIO GetPackageFileContext ()
warnMissingFile :: Text
-> Path Abs Dir
-> String
-> Path Abs File
-> RIO GetPackageFileContext ()
warnMissingFile Text
subject Path Abs Dir
cwd String
path Path Abs File
fromFile =
  [StyleDoc] -> RIO GetPackageFileContext ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
    [ String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc) -> (Text -> String) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
subject -- TODO: needs style?

    , String -> StyleDoc
flow String
"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)
    , String -> StyleDoc
flow String
"file does not exist:"
    , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (String -> StyleDoc) -> String -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc) -> String -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String
path
    ]