{-# LANGUAGE NoImplicitPrelude   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables   #-}

-- | A module which exports all package-level file-gathering logic.

module Stack.PackageFile
  ( packageDescModulesAndFiles
  ) where

import qualified Data.Map.Strict as M
import qualified Data.Set as S
import qualified Data.Text as T
import           Distribution.CabalSpecVersion ( CabalSpecVersion )
import           Distribution.ModuleName ( ModuleName )
import           Distribution.PackageDescription hiding ( FlagName )
import           Distribution.Simple.Glob ( matchDirFileGlob )
import qualified Distribution.Types.UnqualComponentName as Cabal
import           Path as FL hiding ( replaceExtension )
import           Path.Extra
import           Path.IO hiding ( findFiles )
import           Stack.ComponentFile
import           Stack.Prelude hiding ( Display (..) )
import           Stack.Types.NamedComponent
import           Stack.Types.PackageFile
                   ( DotCabalPath (..), GetPackageFileContext (..)
                   , PackageWarning (..)
                   )
import qualified System.FilePath as FilePath
import           System.IO.Error ( isUserError )

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

-- (purely to be helpful).

resolveFileOrWarn :: FilePath.FilePath
                  -> RIO GetPackageFileContext (Maybe (Path Abs File))
resolveFileOrWarn :: FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File))
resolveFileOrWarn = Text
-> (Path Abs Dir
    -> FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File)))
-> FilePath
-> RIO GetPackageFileContext (Maybe (Path Abs File))
forall a.
Text
-> (Path Abs Dir
    -> FilePath -> RIO GetPackageFileContext (Maybe a))
-> FilePath
-> RIO GetPackageFileContext (Maybe a)
resolveOrWarn Text
"File" Path Abs Dir
-> FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File))
forall {m :: * -> *}.
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f
 where
  f :: Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
f Path Abs Dir
p FilePath
x = IO (Maybe (Path Abs File)) -> m (Maybe (Path Abs File))
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Path Abs Dir -> FilePath -> IO (Maybe (Path Abs File))
forall {m :: * -> *}.
MonadIO m =>
Path Abs Dir -> FilePath -> m (Maybe (Path Abs File))
forgivingResolveFile Path Abs Dir
p FilePath
x) m (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> m (Maybe (Path Abs File)))
-> m (Maybe (Path Abs File))
forall 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 File) -> m (Maybe (Path Abs File))
forall (m :: * -> *).
MonadIO m =>
Maybe (Path Abs File) -> m (Maybe (Path Abs File))
rejectMissingFile

-- | Get all files referenced by the package.

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


-- | Resolve globbing of files (e.g. data files) to absolute paths.

resolveGlobFiles
  :: CabalSpecVersion -- ^ Cabal file version

  -> [String]
  -> RIO GetPackageFileContext (Set (Path Abs File))
resolveGlobFiles :: CabalSpecVersion
-> [FilePath] -> RIO GetPackageFileContext (Set (Path Abs File))
resolveGlobFiles CabalSpecVersion
cabalFileVersion =
  ([[Maybe (Path Abs File)]] -> Set (Path Abs File))
-> RIO GetPackageFileContext [[Maybe (Path Abs File)]]
-> RIO GetPackageFileContext (Set (Path Abs File))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ([Path Abs File] -> Set (Path Abs File)
forall a. Ord a => [a] -> Set a
S.fromList ([Path Abs File] -> Set (Path Abs File))
-> ([[Maybe (Path Abs File)]] -> [Path Abs File])
-> [[Maybe (Path Abs File)]]
-> Set (Path Abs File)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (Path Abs File)] -> [Path Abs File]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs File)] -> [Path Abs File])
-> ([[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)])
-> [[Maybe (Path Abs File)]]
-> [Path Abs File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe (Path Abs File)]] -> [Maybe (Path Abs File)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (RIO GetPackageFileContext [[Maybe (Path Abs File)]]
 -> RIO GetPackageFileContext (Set (Path Abs File)))
-> ([FilePath]
    -> RIO GetPackageFileContext [[Maybe (Path Abs File)]])
-> [FilePath]
-> RIO GetPackageFileContext (Set (Path Abs File))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (FilePath -> RIO GetPackageFileContext [Maybe (Path Abs File)])
-> [FilePath]
-> RIO GetPackageFileContext [[Maybe (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 FilePath -> RIO GetPackageFileContext [Maybe (Path Abs File)]
resolve
 where
  resolve :: FilePath -> RIO GetPackageFileContext [Maybe (Path Abs File)]
resolve FilePath
name =
    if Char
'*' Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
name
      then FilePath -> RIO GetPackageFileContext [Maybe (Path Abs File)]
explode FilePath
name
      else (Maybe (Path Abs File) -> [Maybe (Path Abs File)])
-> RIO GetPackageFileContext (Maybe (Path Abs File))
-> RIO GetPackageFileContext [Maybe (Path Abs File)]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe (Path Abs File) -> [Maybe (Path Abs File)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File))
resolveFileOrWarn FilePath
name)
  explode :: FilePath -> RIO GetPackageFileContext [Maybe (Path Abs File)]
explode FilePath
name = 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)
    [FilePath]
names <- FilePath -> FilePath -> RIO GetPackageFileContext [FilePath]
forall {m :: * -> *} {env}.
(MonadUnliftIO m, HasTerm env, MonadReader env m) =>
FilePath -> FilePath -> m [FilePath]
matchDirFileGlob' (Path Abs Dir -> FilePath
forall b t. Path b t -> FilePath
FL.toFilePath Path Abs Dir
dir) FilePath
name
    (FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File)))
-> [FilePath] -> RIO GetPackageFileContext [Maybe (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 FilePath -> RIO GetPackageFileContext (Maybe (Path Abs File))
resolveFileOrWarn [FilePath]
names
  matchDirFileGlob' :: FilePath -> FilePath -> m [FilePath]
matchDirFileGlob' FilePath
dir FilePath
glob =
    m [FilePath] -> (IOException -> m [FilePath]) -> m [FilePath]
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
      (IO [FilePath] -> m [FilePath]
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Verbosity
-> CabalSpecVersion -> FilePath -> FilePath -> IO [FilePath]
matchDirFileGlob Verbosity
forall a. Bounded a => a
minBound CabalSpecVersion
cabalFileVersion FilePath
dir FilePath
glob))
      ( \(IOException
e :: IOException) ->
        if IOException -> Bool
isUserError IOException
e
          then do
            [StyleDoc] -> m ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
              [ FilePath -> StyleDoc
flow FilePath
"Wildcard does not match any files:"
              , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
glob
              , StyleDoc
line StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> FilePath -> StyleDoc
flow FilePath
"in directory:"
              , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString FilePath
dir
              ]
            [FilePath] -> m [FilePath]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
          else IOException -> m [FilePath]
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e
      )