{-# language CPP #-} module Hix.Cabal where import Control.Monad.Trans.Except (ExceptT (ExceptT), throwE) import Distribution.PackageDescription (BuildInfo (..), GenericPackageDescription (..)) #if MIN_VERSION_Cabal(3,8,0) import Distribution.Simple.PackageDescription (readGenericPackageDescription) #else import Distribution.PackageDescription.Parsec (readGenericPackageDescription) #endif import Distribution.Types.Benchmark (benchmarkBuildInfo) import Distribution.Types.CondTree (CondTree (..)) import qualified Distribution.Types.Executable as Executable import Distribution.Types.Library (Library (..)) import Distribution.Types.TestSuite (testBuildInfo) import Distribution.Utils.Path (getSymbolicPath) import qualified Distribution.Verbosity as Cabal import Exon (exon) import Hix.Data.Error (Error (..), pathText, sourceError) import Path ( Abs, Dir, File, Path, Rel, absdir, isProperPrefixOf, parent, parseRelDir, parseRelFile, stripProperPrefix, toFilePath, (</>), ) import System.FilePattern.Directory (getDirectoryFiles) import System.IO.Error (tryIOError) noMatch :: Text -> Path b File -> ExceptT Error IO a noMatch :: forall b a. Text -> Path b File -> ExceptT Error IO a noMatch Text reason Path b File source = forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE (Text -> Error NoMatch (forall b t. Text -> Path b t -> Text sourceError Text reason Path b File source)) cabalsInDir :: Path Abs Dir -> ExceptT Error IO [Path Abs File] cabalsInDir :: Path Abs Dir -> ExceptT Error IO [Path Abs File] cabalsInDir Path Abs Dir dir = do [FilePattern] matches <- forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (FilePattern -> [FilePattern] -> IO [FilePattern] getDirectoryFiles (forall b t. Path b t -> FilePattern toFilePath Path Abs Dir dir) [FilePattern "*.cabal"]) let err :: Error err = Text -> Error PreprocError [exon|Internal error when parsing globbed paths in '#{pathText dir}': #{show matches}|] forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE Error err) forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse FilePattern -> Maybe (Path Abs File) parse [FilePattern] matches) where parse :: FilePattern -> Maybe (Path Abs File) parse FilePattern f = do Path Rel File rel <- forall (m :: * -> *). MonadThrow m => FilePattern -> m (Path Rel File) parseRelFile FilePattern f pure (Path Abs Dir dir forall b t. Path b Dir -> Path Rel t -> Path b t </> Path Rel File rel) findCabal :: Path Abs File -> ExceptT Error IO (Path Abs File, Path Rel File) findCabal :: Path Abs File -> ExceptT Error IO (Path Abs File, Path Rel File) findCabal Path Abs File source = Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) spin (forall b t. Path b t -> Path b Dir parent Path Abs File source) where spin :: Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) spin Path Abs Dir dir | Path Abs Dir dir forall a. Eq a => a -> a -> Bool == [absdir|/nix/store|] = ExceptT Error IO (Path Abs File, Path Rel File) notFound | Path Abs Dir dir forall a. Eq a => a -> a -> Bool == forall b t. Path b t -> Path b Dir parent Path Abs Dir dir = ExceptT Error IO (Path Abs File, Path Rel File) notFound | Bool otherwise = Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) tryDir Path Abs Dir dir tryDir :: Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) tryDir Path Abs Dir dir = Path Abs Dir -> ExceptT Error IO [Path Abs File] cabalsInDir Path Abs Dir dir forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case [Item [Path Abs File] cabal] -> do Path Rel File sub <- forall (m :: * -> *) b t. MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) stripProperPrefix (forall b t. Path b t -> Path b Dir parent Item [Path Abs File] cabal) Path Abs File source pure (Item [Path Abs File] cabal, Path Rel File sub) [] -> Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) spin (forall b t. Path b t -> Path b Dir parent Path Abs Dir dir) [Path Abs File] _ -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE (Text -> Error PreprocError (forall b t. Text -> Path b t -> Text sourceError Text "Multiple cabal files in parent dir of" Path Abs File source)) notFound :: ExceptT Error IO (Path Abs File, Path Rel File) notFound = forall b a. Text -> Path b File -> ExceptT Error IO a noMatch Text "No cabal file found for " Path Abs File source parseCabal :: Path Abs File -> ExceptT Error IO GenericPackageDescription parseCabal :: Path Abs File -> ExceptT Error IO GenericPackageDescription parseCabal Path Abs File path = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (Text -> Error PreprocError forall b c a. (b -> c) -> (a -> b) -> a -> c . forall b a. (Show a, IsString b) => a -> b show)) forall a b. (a -> b) -> a -> b $ forall a. IO a -> IO (Either IOError a) tryIOError do Verbosity -> FilePattern -> IO GenericPackageDescription readGenericPackageDescription Verbosity Cabal.verbose (forall b t. Path b t -> FilePattern toFilePath Path Abs File path) buildInfo :: (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo :: forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo a -> BuildInfo f (b _, CondTree c d a t) = a -> BuildInfo f CondTree c d a t.condTreeData matchComponent :: GenericPackageDescription -> Path Rel File -> ExceptT Error IO BuildInfo matchComponent :: GenericPackageDescription -> Path Rel File -> ExceptT Error IO BuildInfo matchComponent GenericPackageDescription pkg Path Rel File source = forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall b a. Text -> Path b File -> ExceptT Error IO a noMatch Text "cabal component" Path Rel File source) forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a find BuildInfo -> Bool matchSource [BuildInfo] infos) where matchSource :: BuildInfo -> Bool matchSource BuildInfo {Bool [FilePattern] [(FilePattern, FilePattern)] [Language] [Extension] [Dependency] [ExeDependency] [LegacyExeDependency] [Mixin] [ModuleName] [PkgconfigDependency] [SymbolicPath PackageDir SourceDir] Maybe Language PerCompilerFlavor [FilePattern] asmOptions :: BuildInfo -> [FilePattern] asmSources :: BuildInfo -> [FilePattern] autogenIncludes :: BuildInfo -> [FilePattern] autogenModules :: BuildInfo -> [ModuleName] buildToolDepends :: BuildInfo -> [ExeDependency] buildTools :: BuildInfo -> [LegacyExeDependency] buildable :: BuildInfo -> Bool cSources :: BuildInfo -> [FilePattern] ccOptions :: BuildInfo -> [FilePattern] cmmOptions :: BuildInfo -> [FilePattern] cmmSources :: BuildInfo -> [FilePattern] cppOptions :: BuildInfo -> [FilePattern] customFieldsBI :: BuildInfo -> [(FilePattern, FilePattern)] cxxOptions :: BuildInfo -> [FilePattern] cxxSources :: BuildInfo -> [FilePattern] defaultExtensions :: BuildInfo -> [Extension] defaultLanguage :: BuildInfo -> Maybe Language extraBundledLibs :: BuildInfo -> [FilePattern] extraDynLibFlavours :: BuildInfo -> [FilePattern] extraFrameworkDirs :: BuildInfo -> [FilePattern] extraGHCiLibs :: BuildInfo -> [FilePattern] extraLibDirs :: BuildInfo -> [FilePattern] extraLibFlavours :: BuildInfo -> [FilePattern] extraLibs :: BuildInfo -> [FilePattern] frameworks :: BuildInfo -> [FilePattern] hsSourceDirs :: BuildInfo -> [SymbolicPath PackageDir SourceDir] hsc2hsOptions :: BuildInfo -> [FilePattern] includeDirs :: BuildInfo -> [FilePattern] includes :: BuildInfo -> [FilePattern] installIncludes :: BuildInfo -> [FilePattern] jsSources :: BuildInfo -> [FilePattern] ldOptions :: BuildInfo -> [FilePattern] mixins :: BuildInfo -> [Mixin] oldExtensions :: BuildInfo -> [Extension] options :: BuildInfo -> PerCompilerFlavor [FilePattern] otherExtensions :: BuildInfo -> [Extension] otherLanguages :: BuildInfo -> [Language] otherModules :: BuildInfo -> [ModuleName] pkgconfigDepends :: BuildInfo -> [PkgconfigDependency] profOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] sharedOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] staticOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] targetBuildDepends :: BuildInfo -> [Dependency] virtualModules :: BuildInfo -> [ModuleName] mixins :: [Mixin] targetBuildDepends :: [Dependency] customFieldsBI :: [(FilePattern, FilePattern)] staticOptions :: PerCompilerFlavor [FilePattern] sharedOptions :: PerCompilerFlavor [FilePattern] profOptions :: PerCompilerFlavor [FilePattern] options :: PerCompilerFlavor [FilePattern] installIncludes :: [FilePattern] autogenIncludes :: [FilePattern] includes :: [FilePattern] includeDirs :: [FilePattern] extraLibDirs :: [FilePattern] extraDynLibFlavours :: [FilePattern] extraLibFlavours :: [FilePattern] extraBundledLibs :: [FilePattern] extraGHCiLibs :: [FilePattern] extraLibs :: [FilePattern] oldExtensions :: [Extension] otherExtensions :: [Extension] defaultExtensions :: [Extension] otherLanguages :: [Language] defaultLanguage :: Maybe Language autogenModules :: [ModuleName] virtualModules :: [ModuleName] otherModules :: [ModuleName] hsSourceDirs :: [SymbolicPath PackageDir SourceDir] jsSources :: [FilePattern] cxxSources :: [FilePattern] cSources :: [FilePattern] cmmSources :: [FilePattern] asmSources :: [FilePattern] extraFrameworkDirs :: [FilePattern] frameworks :: [FilePattern] pkgconfigDepends :: [PkgconfigDependency] hsc2hsOptions :: [FilePattern] ldOptions :: [FilePattern] cxxOptions :: [FilePattern] ccOptions :: [FilePattern] cmmOptions :: [FilePattern] asmOptions :: [FilePattern] cppOptions :: [FilePattern] buildToolDepends :: [ExeDependency] buildTools :: [LegacyExeDependency] buildable :: Bool ..} = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (FilePattern -> Bool matchSourceDir forall b c a. (b -> c) -> (a -> b) -> a -> c . forall from to. SymbolicPath from to -> FilePattern getSymbolicPath) [SymbolicPath PackageDir SourceDir] hsSourceDirs matchSourceDir :: FilePattern -> Bool matchSourceDir FilePattern dir | Just Path Rel Dir p <- forall (m :: * -> *). MonadThrow m => FilePattern -> m (Path Rel Dir) parseRelDir FilePattern dir, forall b t. Path b Dir -> Path b t -> Bool isProperPrefixOf Path Rel Dir p Path Rel File source = Bool True | Bool otherwise = Bool False infos :: [BuildInfo] infos = ((.condTreeData.libBuildInfo) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Maybe a -> [a] maybeToList GenericPackageDescription pkg.condLibrary) forall a. Semigroup a => a -> a -> a <> (forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Library -> BuildInfo libBuildInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condSubLibraries) forall a. Semigroup a => a -> a -> a <> (forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Executable -> BuildInfo Executable.buildInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condExecutables) forall a. Semigroup a => a -> a -> a <> (forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo TestSuite -> BuildInfo testBuildInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condTestSuites) forall a. Semigroup a => a -> a -> a <> (forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Benchmark -> BuildInfo benchmarkBuildInfo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condBenchmarks) buildInfoForFile :: Path Abs File -> ExceptT Error IO BuildInfo buildInfoForFile :: Path Abs File -> ExceptT Error IO BuildInfo buildInfoForFile Path Abs File source = do (Path Abs File cabalPath, Path Rel File sourceRel) <- Path Abs File -> ExceptT Error IO (Path Abs File, Path Rel File) findCabal Path Abs File source GenericPackageDescription pkg <- Path Abs File -> ExceptT Error IO GenericPackageDescription parseCabal Path Abs File cabalPath GenericPackageDescription -> Path Rel File -> ExceptT Error IO BuildInfo matchComponent GenericPackageDescription pkg Path Rel File sourceRel