{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}

-- | A module which exports all component-level file-gathering logic. It also

-- includes utility functions for handling paths and directories.


module Stack.ComponentFile
  ( resolveOrWarn
  , libraryFiles
  , executableFiles
  , testFiles
  , benchmarkFiles
  , componentOutputDir
  , componentBuildDir
  , packageAutogenDir
  , buildDir
  , componentAutogenDir
  ) 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
                   ( Benchmark (..), BenchmarkInterface (..), BuildInfo (..)
                   , Executable (..), Library (..), TestSuite (..)
                   , TestSuiteInterface (..)
                   )
import           Distribution.Text ( display )
import           Distribution.Utils.Path ( getSymbolicPath )
import           Distribution.Version ( mkVersion )
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.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

-- | Get all files referenced by the benchmark.

benchmarkFiles ::
     NamedComponent
  -> Benchmark
  -> RIO
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles :: NamedComponent
-> Benchmark
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
benchmarkFiles NamedComponent
component Benchmark
bench =
  NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (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
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
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
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles :: NamedComponent
-> TestSuite
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
testFiles NamedComponent
component TestSuite
test =
  NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (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
_ String
fp -> [String -> DotCabalDescriptor
DotCabalMain String
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
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles :: NamedComponent
-> Executable
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
executableFiles NamedComponent
component Executable
exe =
  NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (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]
++
    [String -> DotCabalDescriptor
DotCabalMain (Executable -> String
modulePath Executable
exe)]

-- | Get all files referenced by the library.

libraryFiles ::
     NamedComponent
  -> Library
  -> RIO
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles :: NamedComponent
-> Library
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
libraryFiles NamedComponent
component Library
lib =
  NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (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
       GetPackageFileContext
       (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles :: NamedComponent
-> BuildInfo
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveComponentFiles NamedComponent
component BuildInfo
build [DotCabalDescriptor]
names = do
  [Path Abs Dir]
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) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
build)
  Path Abs Dir
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
. GetPackageFileContext -> Path Abs File
ctxFile)
  [Path Abs Dir]
agdirs <- RIO GetPackageFileContext [Path Abs Dir]
autogenDirs
  (Map ModuleName (Path Abs File)
modules,[DotCabalPath]
files,[PackageWarning]
warnings) <-
    NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
resolveFilesAndDeps
      NamedComponent
component
      ((if [Path Abs Dir] -> Bool
forall a. [a] -> 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 GetPackageFileContext [DotCabalPath]
buildOtherSources BuildInfo
build
  (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 GetPackageFileContext [Path Abs Dir]
autogenDirs = do
    Version
cabalVer <- (GetPackageFileContext -> Version)
-> RIO GetPackageFileContext Version
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Version
ctxCabalVer
    Path Abs Dir
distDir <- (GetPackageFileContext -> Path Abs Dir)
-> RIO GetPackageFileContext (Path Abs Dir)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> 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 GetPackageFileContext Bool)
-> [Path Abs Dir] -> RIO GetPackageFileContext [Path Abs Dir]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM Path Abs Dir -> RIO GetPackageFileContext Bool
forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist ([Path Abs Dir] -> RIO GetPackageFileContext [Path Abs Dir])
-> [Path Abs Dir] -> RIO GetPackageFileContext [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

-- | 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
  ([DotCabalPath]
dotCabalPaths, Map ModuleName (Path Abs File)
foundModules, [ModuleName]
missingModules, Map Any Any
_) <- [DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map Any Any)
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
  [PackageWarning]
warnings <-
    ([PackageWarning] -> [PackageWarning] -> [PackageWarning])
-> RIO GetPackageFileContext [PackageWarning]
-> RIO GetPackageFileContext [PackageWarning]
-> RIO GetPackageFileContext [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 GetPackageFileContext [PackageWarning]
forall {f :: * -> *} {b}.
Applicative f =>
Map ModuleName b -> f [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules) ([ModuleName] -> RIO GetPackageFileContext [PackageWarning]
forall {f :: * -> *} {p} {a}. Applicative f => p -> f [a]
warnMissing [ModuleName]
missingModules)
  (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
-> RIO
     GetPackageFileContext
     (Map ModuleName (Path Abs File), [DotCabalPath], [PackageWarning])
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ModuleName (Path Abs File)
foundModules, [DotCabalPath]
dotCabalPaths, [PackageWarning]
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
    [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved <- [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
     GetPackageFileContext [(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
        getDependenciesFold :: DotCabalPath
-> ([(Set ModuleName, Map String (Path Abs File))],
    Map String (Path Abs File))
-> RIO
     GetPackageFileContext
     ([(Set ModuleName, Map String (Path Abs File))],
      Map String (Path Abs File))
getDependenciesFold DotCabalPath
c ([(Set ModuleName, Map String (Path Abs File))]
ps, Map String (Path Abs File)
ku) = do
          (Set ModuleName, Map String (Path Abs File))
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
          ([(Set ModuleName, Map String (Path Abs File))],
 Map String (Path Abs File))
-> RIO
     GetPackageFileContext
     ([(Set ModuleName, Map String (Path Abs File))],
      Map String (Path Abs File))
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Set ModuleName, Map String (Path Abs File))
p (Set ModuleName, Map String (Path Abs File))
-> [(Set ModuleName, Map String (Path Abs File))]
-> [(Set ModuleName, Map String (Path Abs File))]
forall a. a -> [a] -> [a]
: [(Set ModuleName, Map String (Path Abs File))]
ps, Map String (Path Abs File)
ku Map String (Path Abs File)
-> Map String (Path Abs File) -> Map String (Path Abs File)
forall a. Semigroup a => a -> a -> a
<> (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))
p)
    ([(Set ModuleName, Map String (Path Abs File))]
pairs, Map String (Path Abs File)
foundUsages) <- (DotCabalPath
 -> ([(Set ModuleName, Map String (Path Abs File))],
     Map String (Path Abs File))
 -> RIO
      GetPackageFileContext
      ([(Set ModuleName, Map String (Path Abs File))],
       Map String (Path Abs File)))
-> ([(Set ModuleName, Map String (Path Abs File))],
    Map String (Path Abs File))
-> [DotCabalPath]
-> RIO
     GetPackageFileContext
     ([(Set ModuleName, Map String (Path Abs File))],
      Map String (Path Abs File))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
foldrM DotCabalPath
-> ([(Set ModuleName, Map String (Path Abs File))],
    Map String (Path Abs File))
-> RIO
     GetPackageFileContext
     ([(Set ModuleName, Map String (Path Abs File))],
      Map String (Path Abs File))
getDependenciesFold ([], Map String (Path Abs File)
knownUsages) [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, 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 :: [Path Abs File]
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
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]
_, Map k a
foundUsages') <-
      [DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map k a)
forall k a.
[DotCabalDescriptor]
-> Set ModuleName
-> Map String (Path Abs File)
-> RIO
     GetPackageFileContext
     ([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName],
      Map k a)
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 Map String (Path Abs File)
foundUsages
    ([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
      ( [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
      , Map k a
foundUsages'
      )
  warnUnlisted :: Map ModuleName b -> f [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 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] -> f [PackageWarning]
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PackageWarning] -> f [PackageWarning])
-> [PackageWarning] -> f [PackageWarning]
forall a b. (a -> b) -> a -> b
$
      [ 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))
      | Bool -> Bool
not (Map ModuleName b -> Bool
forall k a. Map k a -> Bool
M.null Map ModuleName b
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))
forall {t}.
Path Abs t
-> 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))
forall {t}.
Path Abs t
-> 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 t
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (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 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 GetPackageFileContext -> Path Abs Dir
ctxDistDir
    Path Abs Dir
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
. GetPackageFileContext -> 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, 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 t
fileRel -> do
        let hiPath :: String
hiPath = String -> String -> String
FilePath.replaceExtension
                       (Path Abs t -> String
forall b t. Path b t -> String
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))
                       String
".hi"
        Bool
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 Bool
dumpHIExists
          then Map String (Path Abs File)
-> String
-> RIO
     GetPackageFileContext (Set ModuleName, Map String (Path Abs File))
parseHI Map String (Path Abs File)
knownUsages String
hiPath
          else (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)

-- | 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
  Path Abs Dir
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
. GetPackageFileContext -> Path Abs File
ctxFile)
  Either String Interface
result <-
    IO (Either String Interface)
-> RIO GetPackageFileContext (Either String Interface)
forall a. IO a -> RIO GetPackageFileContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String Interface)
 -> RIO GetPackageFileContext (Either String Interface))
-> IO (Either String Interface)
-> RIO GetPackageFileContext (Either String Interface)
forall a b. (a -> b) -> a -> b
$ IO (Either String Interface)
-> (SomeException -> IO (Either String Interface))
-> IO (Either String Interface)
forall a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep
      (String -> IO (Either String Interface)
Iface.fromFile String
hiPath)
      (Either String Interface -> IO (Either String Interface)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Interface -> IO (Either String Interface))
-> (SomeException -> Either String Interface)
-> SomeException
-> IO (Either String Interface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Interface
forall a b. a -> Either a b
Left (String -> Either String Interface)
-> (SomeException -> String)
-> SomeException
-> Either String Interface
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall e. Exception e => e -> String
displayException)
  case Either String Interface
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 -> f (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) -> f (Maybe (String, Path Abs File))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, Path Abs File)
 -> f (Maybe (String, Path Abs File)))
-> Maybe (String, Path Abs File)
-> f (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
                Maybe (Path Abs File)
resolved <- Path Abs Dir -> String -> f (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
dir String
file f (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> f (Maybe (Path Abs File)))
-> f (Maybe (Path Abs File))
forall a b. f a -> (a -> f b) -> f b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Path Abs File) -> f (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
                Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Path Abs File) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Path Abs File)
resolved) (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$
                  [StyleDoc] -> f ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
                    [ String -> StyleDoc
flow String
"Dependent file listed in:"
                    , 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
"does not exist:"
                    , 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
file
                    ]
                Maybe (String, Path Abs File) -> f (Maybe (String, Path Abs File))
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (String, Path Abs File)
 -> f (Maybe (String, Path Abs File)))
-> Maybe (String, Path Abs File)
-> f (Maybe (String, Path Abs File))
forall a b. (a -> b) -> a -> b
$ (String
file,) (Path Abs File -> (String, Path Abs File))
-> Maybe (Path Abs File) -> Maybe (String, Path Abs File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Path Abs 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))
forall {f :: * -> *} {env}.
(MonadIO f, HasTerm env, MonadReader env f) =>
String -> f (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
      [(String, Path Abs File)]
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
      (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 ([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, [(String, Path Abs File)] -> Map String (Path Abs File)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(String, Path Abs File)]
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
    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")

-- | 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
  PackageName
pkg <- (GetPackageFileContext -> Path Abs File)
-> RIO GetPackageFileContext (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs File
ctxFile 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
  [Text]
customPreprocessorExts <- Getting [Text] GetPackageFileContext [Text]
-> RIO GetPackageFileContext [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting [Text] GetPackageFileContext [Text]
 -> RIO GetPackageFileContext [Text])
-> Getting [Text] GetPackageFileContext [Text]
-> RIO GetPackageFileContext [Text]
forall a b. (a -> b) -> a -> b
$ (Config -> Const [Text] Config)
-> GetPackageFileContext -> Const [Text] GetPackageFileContext
forall env. HasConfig env => Lens' env Config
Lens' GetPackageFileContext Config
configL ((Config -> Const [Text] Config)
 -> GetPackageFileContext -> Const [Text] GetPackageFileContext)
-> (([Text] -> Const [Text] [Text])
    -> Config -> Const [Text] Config)
-> Getting [Text] GetPackageFileContext [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> [Text]) -> SimpleGetter Config [Text]
forall s a. (s -> a) -> SimpleGetter s a
to Config -> [Text]
configCustomPreprocessorExts
  let haskellPreprocessorExts :: [Text]
haskellPreprocessorExts =
        [Text]
haskellDefaultPreprocessorExts [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
customPreprocessorExts
  [Path Abs File]
candidates <- IO [Path Abs File] -> RIO GetPackageFileContext [Path Abs File]
forall a. IO a -> RIO GetPackageFileContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Abs File] -> RIO GetPackageFileContext [Path Abs File])
-> IO [Path Abs File] -> RIO GetPackageFileContext [Path Abs File]
forall a b. (a -> b) -> a -> b
$ [Text] -> IO [Path Abs File]
makeNameCandidates [Text]
haskellPreprocessorExts
  case [Path Abs File]
candidates of
    [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 -> f [Path Abs File]
perExt Text
ext =
                Path Abs Dir -> String -> f [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)
          [[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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> IO a
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 -> 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
  [Path Rel File]
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]]
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 a. [a] -> 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
    [ String -> StyleDoc
flow String
"Unable to find a known candidate for the Cabal entry"
    , (Style -> StyleDoc -> StyleDoc
style Style
Module (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
$ ModuleName -> String
forall a. Pretty a => a -> String
display ModuleName
mn) StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
    , String -> StyleDoc
flow String
"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)
    , String -> StyleDoc
flow String
"If you are using a custom preprocessor for this module"
    , String -> StyleDoc
flow String
"with its own file extension, consider adding the extension"
    , String -> StyleDoc
flow String
"to the 'custom-preprocessor-extensions' field in stack.yaml."
    ]
 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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
             ( (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
                     (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (a -> String
forall a. Pretty a => a -> String
display a
name) (String -> Bool)
-> (Path Abs File -> String) -> Path Abs File -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel File -> String
forall b t. Path b t -> String
toFilePath (Path Rel File -> String)
-> (Path Abs File -> Path Rel File) -> Path Abs File -> String
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

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

buildOtherSources :: BuildInfo -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources :: BuildInfo -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources BuildInfo
build = do
  Path Abs Dir
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
  Path Abs Dir
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
. GetPackageFileContext -> Path Abs File
ctxFile)
  Path Abs File
file <- (GetPackageFileContext -> Path Abs File)
-> RIO GetPackageFileContext (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs File
ctxFile
  let resolveDirFiles :: [String] -> (Path Abs File -> b) -> RIO GetPackageFileContext [b]
resolveDirFiles [String]
files Path Abs File -> b
toCabalPath =
        [String]
-> (String -> RIO GetPackageFileContext (Maybe b))
-> RIO GetPackageFileContext [b]
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [String]
files ((String -> RIO GetPackageFileContext (Maybe b))
 -> RIO GetPackageFileContext [b])
-> (String -> RIO GetPackageFileContext (Maybe b))
-> RIO GetPackageFileContext [b]
forall a b. (a -> b) -> a -> b
$ \String
fp -> do
          Maybe (Path Abs File)
result <- 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
          case Maybe (Path Abs File)
result of
            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 b -> RIO GetPackageFileContext (Maybe b)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
            Just Path Abs File
p -> Maybe b -> RIO GetPackageFileContext (Maybe b)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> RIO GetPackageFileContext (Maybe b))
-> Maybe b -> RIO GetPackageFileContext (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 <- [String]
-> (Path Abs File -> DotCabalPath)
-> RIO GetPackageFileContext [DotCabalPath]
forall {b}.
[String] -> (Path Abs File -> b) -> RIO GetPackageFileContext [b]
resolveDirFiles (BuildInfo -> [String]
cSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalCFilePath
  [DotCabalPath]
jsources <- [String]
-> (Path Abs File -> DotCabalPath)
-> RIO GetPackageFileContext [DotCabalPath]
forall {b}.
[String] -> (Path Abs File -> b) -> RIO GetPackageFileContext [b]
resolveDirFiles (BuildInfo -> [String]
targetJsSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalFilePath
  [DotCabalPath] -> RIO GetPackageFileContext [DotCabalPath]
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([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 -> [String]
targetJsSources = BuildInfo -> [String]
jsSources

-- | 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

  Path Abs File
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)
  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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 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
  String
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 String -> Maybe PackageName
parsePackageName String
base of
    Maybe PackageName
Nothing -> PackageException -> m PackageName
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, 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
forall {f :: * -> *}. MonadThrow f => String -> f 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 -> f String
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':String
xs) = String -> f String
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
  strip String
_ = PackageException -> f String
forall e a. Exception e => e -> f a
forall (m :: * -> *) e a. (MonadThrow m, 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 :: 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

-- | 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 (PackageException -> Path Rel Dir
forall a e. Exception e => e -> a
throw PackageException
ComponentNotParsedBug) (String -> Maybe (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
T.unpack Text
name))

-- | 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

-- 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
  Path Abs Dir
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
  Path Abs File
file <- (GetPackageFileContext -> Path Abs File)
-> RIO GetPackageFileContext (Path Abs File)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs File
ctxFile
  Path Abs Dir
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
. GetPackageFileContext -> Path Abs File
ctxFile)
  Maybe a
result <- Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a)
resolver Path Abs Dir
dir String
path
  Bool
-> RIO GetPackageFileContext () -> RIO GetPackageFileContext ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
result) (RIO GetPackageFileContext () -> RIO GetPackageFileContext ())
-> RIO GetPackageFileContext () -> RIO GetPackageFileContext ()
forall a b. (a -> b) -> a -> b
$ Text
-> Path Abs Dir
-> String
-> Path Abs File
-> RIO GetPackageFileContext ()
warnMissingFile Text
subject Path Abs Dir
cwd String
path Path Abs File
file
  Maybe a -> RIO GetPackageFileContext (Maybe a)
forall a. a -> RIO GetPackageFileContext a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
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
    ]