{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
module Stack.ComponentFile
( resolveOrWarn
, libraryFiles
, executableFiles
, testFiles
, benchmarkFiles
, componentOutputDir
, componentBuildDir
, packageAutogenDir
, buildDir
, componentAutogenDir
) where
import Control.Exception ( throw )
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.Package
hiding
( Module, Package, PackageIdentifier, packageName
, packageVersion
)
import Distribution.PackageDescription hiding ( FlagName )
import Distribution.Text ( display )
import Distribution.Utils.Path ( getSymbolicPath )
import Distribution.Version ( mkVersion )
import qualified HiFileParser as Iface
import Path as FL hiding ( replaceExtension )
import Path.Extra
import Path.IO hiding ( findFiles )
import Stack.Constants
import Stack.Prelude hiding ( Display (..) )
import Stack.Types.Config
import Stack.Types.NamedComponent
import Stack.Types.Package
import Stack.Types.PackageFile
( GetPackageFileContext (..), DotCabalDescriptor (..)
, DotCabalPath (..), PackageWarning (..)
)
import qualified System.Directory as D ( doesFileExist )
import qualified System.FilePath as FilePath
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 = do
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 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 = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
build :: BuildInfo
build = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
bench
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 = do
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 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 = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
build :: BuildInfo
build = TestSuite -> BuildInfo
testBuildInfo TestSuite
test
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 = do
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 =
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build) forall a. [a] -> [a] -> [a]
++
[String -> DotCabalDescriptor
DotCabalMain (Executable -> String
modulePath Executable
exe)]
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 = do
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 forall a. [a] -> [a] -> [a]
++ [DotCabalDescriptor]
exposed
exposed :: [DotCabalDescriptor]
exposed = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (Library -> [ModuleName]
exposedModules Library
lib)
bnames :: [DotCabalDescriptor]
bnames = forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (BuildInfo -> [ModuleName]
otherModules BuildInfo
build)
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 <- forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (String -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath) (BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs BuildInfo
build)
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent 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 forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Abs Dir]
dirs then [Path Abs Dir
dir] else [Path Abs Dir]
dirs) forall a. [a] -> [a] -> [a]
++ [Path Abs Dir]
agdirs)
[DotCabalDescriptor]
names
[DotCabalPath]
cfiles <- BuildInfo -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources BuildInfo
build
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ModuleName (Path Abs File)
modules, [DotCabalPath]
files forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
cfiles, [PackageWarning]
warnings)
where
autogenDirs :: RIO GetPackageFileContext [Path Abs Dir]
autogenDirs = do
Version
cabalVer <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Version
ctxCabalVer
Path Abs Dir
distDir <- 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 = forall a. Maybe a -> [a]
maybeToList forall a b. (a -> b) -> a -> b
$ Version -> Path Abs Dir -> Maybe (Path Abs Dir)
packageAutogenDir Version
cabalVer Path Abs Dir
distDir
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM forall (m :: * -> *) b. MonadIO m => Path b Dir -> m Bool
doesDirExist forall a b. (a -> b) -> a -> b
$ Path Abs Dir
compDir forall a. a -> [a] -> [a]
: [Path Abs Dir]
pkgDir
resolveFilesAndDeps
:: NamedComponent
-> [Path Abs Dir]
-> [DotCabalDescriptor]
-> 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) <- [DotCabalDescriptor]
-> Set ModuleName
-> RIO
GetPackageFileContext
([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [DotCabalDescriptor]
names0 forall a. Set a
S.empty
[PackageWarning]
warnings <-
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (forall {f :: * -> *} {b}.
Applicative f =>
Map ModuleName b -> f [PackageWarning]
warnUnlisted Map ModuleName (Path Abs File)
foundModules) (forall {f :: * -> *} {p} {a}. Applicative f => p -> f [a]
warnMissing [ModuleName]
missingModules)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map ModuleName (Path Abs File)
foundModules, [DotCabalPath]
dotCabalPaths, [PackageWarning]
warnings)
where
loop :: [DotCabalDescriptor]
-> Set ModuleName
-> RIO
GetPackageFileContext
([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop [] Set ModuleName
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], forall k a. Map k a
M.empty, [])
loop [DotCabalDescriptor]
names Set ModuleName
doneModules0 = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall a b. (a, b) -> b
snd [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
foundModules :: [(ModuleName, Path Abs File)]
foundModules = 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule [(DotCabalDescriptor, Maybe DotCabalPath)]
resolved
[(Set ModuleName, [Path Abs File])]
pairs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs) [DotCabalPath]
foundFiles
let doneModules :: Set ModuleName
doneModules = forall a. Ord a => Set a -> Set a -> Set a
S.union
Set ModuleName
doneModules0
(forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DotCabalDescriptor -> Maybe ModuleName
dotCabalModule [DotCabalDescriptor]
names))
moduleDeps :: Set ModuleName
moduleDeps = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Set ModuleName, [Path Abs File])]
pairs)
thDepFiles :: [Path Abs File]
thDepFiles = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd [(Set ModuleName, [Path Abs File])]
pairs
modulesRemaining :: Set ModuleName
modulesRemaining = forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ModuleName
moduleDeps Set ModuleName
doneModules
([DotCabalPath]
resolvedFiles, Map ModuleName (Path Abs File)
resolvedModules, [ModuleName]
_) <-
[DotCabalDescriptor]
-> Set ModuleName
-> RIO
GetPackageFileContext
([DotCabalPath], Map ModuleName (Path Abs File), [ModuleName])
loop (forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> DotCabalDescriptor
DotCabalModule (forall a. Set a -> [a]
S.toList Set ModuleName
modulesRemaining)) Set ModuleName
doneModules
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( forall a. Ord a => [a] -> [a]
nubOrd forall a b. (a -> b) -> a -> b
$ [DotCabalPath]
foundFiles forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map Path Abs File -> DotCabalPath
DotCabalFilePath [Path Abs File]
thDepFiles forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
resolvedFiles
, forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union
(forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ModuleName, Path Abs File)]
foundModules)
Map ModuleName (Path Abs File)
resolvedModules
, [ModuleName]
missingModules
)
warnUnlisted :: Map ModuleName b -> f [PackageWarning]
warnUnlisted Map ModuleName b
foundModules = do
let unlistedModules :: Map ModuleName b
unlistedModules =
Map ModuleName b
foundModules forall k a b. Ord k => Map k a -> Map k b -> Map k a
`M.difference`
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> Maybe ModuleName
dotCabalModule) [DotCabalDescriptor]
names0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if forall k a. Map k a -> Bool
M.null Map ModuleName b
unlistedModules
then []
else [ NamedComponent -> [ModuleName] -> PackageWarning
UnlistedModulesWarning
NamedComponent
component
(forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall k a. Map k a -> [(k, a)]
M.toList Map ModuleName b
unlistedModules))
]
warnMissing :: p -> f [a]
warnMissing p
_missingModules = do
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
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)) =
forall a. a -> Maybe a
Just (ModuleName
mn, Path Abs File
fp)
toResolvedModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
forall a. Maybe a
Nothing
toMissingModule
:: (DotCabalDescriptor, Maybe DotCabalPath)
-> Maybe ModuleName
toMissingModule :: (DotCabalDescriptor, Maybe DotCabalPath) -> Maybe ModuleName
toMissingModule (DotCabalModule ModuleName
mn, Maybe DotCabalPath
Nothing) =
forall a. a -> Maybe a
Just ModuleName
mn
toMissingModule (DotCabalDescriptor, Maybe DotCabalPath)
_ =
forall a. Maybe a
Nothing
getDependencies
:: NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
getDependencies :: NamedComponent
-> [Path Abs Dir]
-> DotCabalPath
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
getDependencies NamedComponent
component [Path Abs Dir]
dirs DotCabalPath
dotCabalPath =
case DotCabalPath
dotCabalPath of
DotCabalModulePath Path Abs File
resolvedFile -> forall {t}.
Path Abs t
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalMainPath Path Abs File
resolvedFile -> forall {t}.
Path Abs t
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs File
resolvedFile
DotCabalFilePath{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
DotCabalCFilePath{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
where
readResolvedHi :: Path Abs t
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
readResolvedHi Path Abs t
resolvedFile = do
Path Abs Dir
dumpHIDir <- NamedComponent -> Path Abs Dir -> Path Abs Dir
componentOutputDir NamedComponent
component forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs Dir
ctxDistDir
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPackageFileContext -> Path Abs File
ctxFile)
let sourceDir :: Path Abs Dir
sourceDir = forall a. a -> Maybe a -> a
fromMaybe Path Abs Dir
dir forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (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 = 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 forall {m :: * -> *}.
MonadThrow m =>
Path Abs Dir -> m (Path Rel t)
stripSourceDir Path Abs Dir
sourceDir of
Maybe (Path Rel t)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
Just Path Rel t
fileRel -> do
let hiPath :: String
hiPath = String -> String -> String
FilePath.replaceExtension
(forall b t. Path b t -> String
toFilePath (Path Abs Dir
dumpHIDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel t
fileRel))
String
".hi"
Bool
dumpHIExists <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Bool
D.doesFileExist String
hiPath
if Bool
dumpHIExists
then String
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
parseHI String
hiPath
else forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
parseHI
:: FilePath -> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
parseHI :: String
-> RIO GetPackageFileContext (Set ModuleName, [Path Abs File])
parseHI String
hiPath = do
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPackageFileContext -> Path Abs File
ctxFile)
Either String Interface
result <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(NFData a, MonadUnliftIO m) =>
m a -> (SomeException -> m a) -> m a
catchAnyDeep
(String -> IO (Either String Interface)
Iface.fromFile String
hiPath)
(\SomeException
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left (forall e. Exception e => e -> String
displayException SomeException
e)))
case Either String Interface
result of
Left String
msg -> do
forall env. HasConfig env => [StyleDoc] -> RIO env ()
prettyStackDevL
[ String -> StyleDoc
flow String
"Failed to decode module interface:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
hiPath
, String -> StyleDoc
flow String
"Decoding failure:"
, Style -> StyleDoc -> StyleDoc
style Style
Error forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
msg
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Set a
S.empty, [])
Right Interface
iface -> do
let moduleNames :: Interface -> [ModuleName]
moduleNames = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8Lenient forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
forall a. List a -> [a]
Iface.unList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependencies -> List (ByteString, Bool)
Iface.dmods forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> Dependencies
Iface.deps
resolveFileDependency :: String -> m (Maybe (Path Abs File))
resolveFileDependency String
file = do
Maybe (Path Abs File)
resolved <-
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
dir String
file)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe (Path Abs File)
resolved) forall a b. (a -> b) -> a -> b
$
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 forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
hiPath
, String -> StyleDoc
flow String
"does not exist:"
, Style -> StyleDoc -> StyleDoc
style Style
File forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
file
]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Abs File)
resolved
resolveUsages :: Interface -> RIO GetPackageFileContext [Maybe (Path Abs File)]
resolveUsages = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(forall {m :: * -> *} {env}.
(MonadIO m, HasTerm env, MonadReader env m) =>
String -> m (Maybe (Path Abs File))
resolveFileDependency forall b c a. (b -> c) -> (a -> b) -> a -> c
. Usage -> String
Iface.unUsage) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. List a -> [a]
Iface.unList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Interface -> List Usage
Iface.usage
[Path Abs File]
resolvedUsages <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Interface -> RIO GetPackageFileContext [Maybe (Path Abs File)]
resolveUsages Interface
iface
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ Interface -> [ModuleName]
moduleNames Interface
iface, [Path Abs File]
resolvedUsages)
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 forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir (Text
name forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"-tmp")
resolveFiles
:: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles :: [Path Abs Dir]
-> [DotCabalDescriptor]
-> RIO
GetPackageFileContext [(DotCabalDescriptor, Maybe DotCabalPath)]
resolveFiles [Path Abs Dir]
dirs [DotCabalDescriptor]
names =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [DotCabalDescriptor]
names (\DotCabalDescriptor
name -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (DotCabalDescriptor
name, ) ([Path Abs Dir]
-> DotCabalDescriptor
-> RIO GetPackageFileContext (Maybe DotCabalPath)
findCandidate [Path Abs Dir]
dirs DotCabalDescriptor
name))
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 <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs File
ctxFile forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
MonadThrow m =>
Path a File -> m PackageName
parsePackageNameFromFilePath
[Text]
customPreprocessorExts <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a b. (a -> b) -> a -> b
$ forall env. HasConfig env => Lens' env Config
configL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. (s -> a) -> SimpleGetter s a
to Config -> [Text]
configCustomPreprocessorExts
let haskellPreprocessorExts :: [Text]
haskellPreprocessorExts =
[Text]
haskellDefaultPreprocessorExts forall a. [a] -> [a] -> [a]
++ [Text]
customPreprocessorExts
[Path Abs File]
candidates <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just (Path Abs File -> DotCabalPath
cons Path Abs File
candidate))
[] -> do
case DotCabalDescriptor
name of
DotCabalModule ModuleName
mn
| forall a. Pretty a => a -> String
display ModuleName
mn forall a. Eq a => a -> a -> Bool
/= PackageName -> String
paths_pkg PackageName
pkg -> forall env.
HasTerm env =>
[Path Abs Dir] -> ModuleName -> RIO env ()
logPossibilities [Path Abs Dir]
dirs ModuleName
mn
DotCabalDescriptor
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
(Path Abs File
candidate:[Path Abs File]
rest) -> do
forall b t.
DotCabalDescriptor
-> Path b t -> [Path b t] -> RIO GetPackageFileContext ()
warnMultiple DotCabalDescriptor
name Path Abs File
candidate [Path Abs File]
rest
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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_" forall a. [a] -> [a] -> [a]
++ PackageName -> String
packageNameString PackageName
pkg
makeNameCandidates :: [Text] -> IO [Path Abs File]
makeNameCandidates [Text]
haskellPreprocessorExts =
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
(forall a. Ord a => [a] -> [a]
nubOrd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat)
(forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t 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 -> forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
DotCabalFile String
fp -> forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir String
fp
DotCabalCFile String
fp -> 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 =
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 forall a. [a] -> [a] -> [a]
++ String
"." forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
ext)
[[Path Abs File]]
withHaskellExts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellFileExts
[[Path Abs File]]
withPPExts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {f :: * -> *}.
(MonadIO f, MonadThrow f) =>
Text -> f [Path Abs File]
perExt [Text]
haskellPreprocessorExts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
case (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withHaskellExts, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Path Abs File]]
withPPExts) of
([Path Abs File
_], [Path Abs File
y]) -> [Path Abs File
y]
([Path Abs File]
xs, [Path Abs File]
ys) -> [Path Abs File]
xs forall a. [a] -> [a] -> [a]
++ [Path Abs File]
ys
resolveCandidate :: Path Abs Dir -> String -> f [Path Abs File]
resolveCandidate Path Abs Dir
dir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> [a]
maybeToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadIO m, MonadThrow m) =>
Path Abs Dir -> String -> m (Maybe (Path Abs File))
resolveDirFile Path Abs Dir
dir
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 <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (forall {m :: * -> *} {a}.
(MonadIO m, Pretty a) =>
a -> m [[Path Rel File]]
makePossibilities ModuleName
mn)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Path Rel File]
possibilities) forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> String
display ModuleName
mn) forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
, String -> StyleDoc
flow String
"but did find:"
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList (forall a b. (a -> b) -> [a] -> [b]
map 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 =
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
( \Path Abs Dir
dir -> do
([Path Abs Dir]
_,[Path Abs File]
files) <- forall (m :: * -> *) b.
MonadIO m =>
Path b Dir -> m ([Path Abs Dir], [Path Abs File])
listDir Path Abs Dir
dir
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( forall a b. (a -> b) -> [a] -> [b]
map
forall b. Path b File -> Path Rel File
filename
( forall a. (a -> Bool) -> [a] -> [a]
filter
(forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf (forall a. Pretty a => a -> String
display a
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Path b File -> Path Rel File
filename)
[Path Abs File]
files
)
)
)
[Path Abs Dir]
dirs
buildOtherSources :: BuildInfo -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources :: BuildInfo -> RIO GetPackageFileContext [DotCabalPath]
buildOtherSources BuildInfo
build = do
Path Abs Dir
cwd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent forall b c a. (b -> c) -> (a -> b) -> a -> c
. GetPackageFileContext -> Path Abs File
ctxFile)
Path Abs File
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 =
forall (m :: * -> *) a b.
Monad m =>
[a] -> (a -> m (Maybe b)) -> m [b]
forMaybeM [String]
files forall a b. (a -> b) -> a -> b
$ \String
fp -> do
Maybe (Path Abs File)
result <- 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just Path Abs File
p -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Path Abs File -> b
toCabalPath Path Abs File
p)
[DotCabalPath]
csources <- forall {b}.
[String] -> (Path Abs File -> b) -> RIO GetPackageFileContext [b]
resolveDirFiles (BuildInfo -> [String]
cSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalCFilePath
[DotCabalPath]
jsources <- forall {b}.
[String] -> (Path Abs File -> b) -> RIO GetPackageFileContext [b]
resolveDirFiles (BuildInfo -> [String]
targetJsSources BuildInfo
build) Path Abs File -> DotCabalPath
DotCabalFilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DotCabalPath]
csources forall a. Semigroup a => a -> a -> a
<> [DotCabalPath]
jsources)
targetJsSources :: BuildInfo -> [FilePath]
targetJsSources :: BuildInfo -> [String]
targetJsSources = BuildInfo -> [String]
jsSources
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
Path Abs File
p <- forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseCollapsedAbsFile (forall b t. Path b t -> String
toFilePath Path Abs Dir
x String -> String -> String
FilePath.</> String
y)
Bool
exists <- forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path Abs File
p
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if Bool
exists then forall a. a -> Maybe a
Just Path Abs File
p else forall a. Maybe a
Nothing
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 =
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"
, forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. DotCabalDescriptor -> String
showName forall a b. (a -> b) -> a -> b
$ DotCabalDescriptor
name
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
bulletedList (forall a b. (a -> b) -> [a] -> [b]
map forall {b} {t}. Path b t -> StyleDoc
dispOne (Path b t
candidateforall a. a -> [a] -> [a]
:[Path b t]
rest))
, StyleDoc
line forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"picking:"
, forall {b} {t}. Path b t -> StyleDoc
dispOne Path b t
candidate
]
where
showName :: DotCabalDescriptor -> String
showName (DotCabalModule ModuleName
name') = 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 = forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> String
toFilePath
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 forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
toFilePath forall a b. (a -> b) -> a -> b
$ forall b. Path b File -> Path Rel File
filename Path a File
fp
case String -> Maybe PackageName
parsePackageName String
base of
Maybe PackageName
Nothing -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> PackageException
CabalFileNameInvalidPackageName forall a b. (a -> b) -> a -> b
$ forall b t. Path b t -> String
toFilePath Path a File
fp
Just PackageName
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure PackageName
x
where
clean :: String -> m String
clean = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {f :: * -> *}. MonadThrow f => String -> f String
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
strip :: String -> f String
strip (Char
'l':Char
'a':Char
'b':Char
'a':Char
'c':Char
'.':String
xs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure String
xs
strip String
_ = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> PackageException
CabalFileNameParseFail (forall b t. Path b t -> String
toFilePath Path a File
fp))
resolveDirOrWarn :: FilePath.FilePath
-> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn :: String -> RIO GetPackageFileContext (Maybe (Path Abs Dir))
resolveDirOrWarn = forall a.
Text
-> (Path Abs Dir -> String -> RIO GetPackageFileContext (Maybe a))
-> String
-> RIO GetPackageFileContext (Maybe a)
resolveOrWarn Text
"Directory" 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
m a -> m (Maybe a)
forgivingAbsence (forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
p String
x)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs Dir) -> m (Maybe (Path Abs Dir))
rejectMissingDir
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 forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
2, Int
0] = forall a. Maybe a
Nothing
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirGlobalAutogen
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 forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirAutogen
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir :: Path Abs Dir -> Path Abs Dir
buildDir Path Abs Dir
distDir = Path Abs Dir
distDir forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel Dir
relDirBuild
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir :: Text -> Path Rel Dir
componentNameToDir Text
name =
forall a. a -> Maybe a -> a
fromMaybe (forall a e. Exception e => e -> a
throw PackageException
ComponentNotParsedBug) (forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir (Text -> String
T.unpack Text
name))
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 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 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 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 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 forall b t. Path b Dir -> Path Rel t -> Path b t
</> Text -> Path Rel Dir
componentNameToDir Text
name
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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getCurrentDir
Path Abs File
file <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks GetPackageFileContext -> Path Abs File
ctxFile
Path Abs Dir
dir <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall b t. Path b t -> Path b Dir
parent 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isNothing Maybe a
result) 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
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 =
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
[ forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
subject
, String -> StyleDoc
flow String
"listed in"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. Pretty a => a -> StyleDoc
pretty Path Abs File
fromFile) forall a. Pretty a => a -> StyleDoc
pretty (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
path
]