module Hix.Cabal where import Control.Monad.Trans.Except (ExceptT (ExceptT), throwE) import Distribution.PackageDescription (BuildInfo (..), GenericPackageDescription (..)) 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 Path ( Abs, Dir, File, Path, Rel, absdir, isProperPrefixOf, parent, parseRelDir, parseRelFile, stripProperPrefix, toFilePath, (</>), ) import System.FilePattern.Directory (getDirectoryFiles) import System.IO.Error (tryIOError) import Hix.Compat (readGenericPackageDescription) import Hix.Data.Error (Error (..), pathText, sourceError) 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 = Error -> ExceptT Error IO a forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE (Text -> Error NoMatch (Text -> Path b File -> Text 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 <- IO [FilePattern] -> ExceptT Error IO [FilePattern] forall a. IO a -> ExceptT Error IO a forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (FilePattern -> [FilePattern] -> IO [FilePattern] getDirectoryFiles (Path Abs Dir -> FilePattern forall b t. Path b t -> FilePattern toFilePath Path Abs Dir dir) [FilePattern Item [FilePattern] "*.cabal"]) let err :: Error err = Text -> Error PreprocError [exon|Internal error when parsing globbed paths in '#{pathText dir}': #{show matches}|] ExceptT Error IO [Path Abs File] -> ([Path Abs File] -> ExceptT Error IO [Path Abs File]) -> Maybe [Path Abs File] -> ExceptT Error IO [Path Abs File] forall b a. b -> (a -> b) -> Maybe a -> b maybe (Error -> ExceptT Error IO [Path Abs File] forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE Error err) [Path Abs File] -> ExceptT Error IO [Path Abs File] forall a. a -> ExceptT Error IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ((FilePattern -> Maybe (Path Abs File)) -> [FilePattern] -> Maybe [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 FilePattern -> Maybe (Path Abs File) parse [FilePattern] matches) where parse :: FilePattern -> Maybe (Path Abs File) parse FilePattern f = do Path Rel File rel <- FilePattern -> Maybe (Path Rel File) forall (m :: * -> *). MonadThrow m => FilePattern -> m (Path Rel File) parseRelFile FilePattern f pure (Path Abs Dir dir Path Abs Dir -> Path Rel File -> Path Abs File 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 (Path Abs File -> Path Abs Dir 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 Path Abs Dir -> Path Abs Dir -> Bool forall a. Eq a => a -> a -> Bool == [absdir|/nix/store|] = ExceptT Error IO (Path Abs File, Path Rel File) notFound | Path Abs Dir dir Path Abs Dir -> Path Abs Dir -> Bool forall a. Eq a => a -> a -> Bool == Path Abs Dir -> Path Abs Dir 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 ExceptT Error IO [Path Abs File] -> ([Path Abs File] -> ExceptT Error IO (Path Abs File, Path Rel File)) -> ExceptT Error IO (Path Abs File, Path Rel File) forall a b. ExceptT Error IO a -> (a -> ExceptT Error IO b) -> ExceptT Error IO b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case [Item [Path Abs File] cabal] -> do Path Rel File sub <- Path Abs Dir -> Path Abs File -> ExceptT Error IO (Path Rel File) forall (m :: * -> *) b t. MonadThrow m => Path b Dir -> Path b t -> m (Path Rel t) stripProperPrefix (Path Abs File -> Path Abs Dir forall b t. Path b t -> Path b Dir parent Item [Path Abs File] Path Abs File cabal) Path Abs File source pure (Item [Path Abs File] Path Abs File cabal, Path Rel File sub) [] -> Path Abs Dir -> ExceptT Error IO (Path Abs File, Path Rel File) spin (Path Abs Dir -> Path Abs Dir forall b t. Path b t -> Path b Dir parent Path Abs Dir dir) [Path Abs File] _ -> Error -> ExceptT Error IO (Path Abs File, Path Rel File) forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a throwE (Text -> Error PreprocError (Text -> Path Abs File -> Text 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 = Text -> Path Abs File -> ExceptT Error IO (Path Abs File, Path Rel File) 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 = IO (Either Error GenericPackageDescription) -> ExceptT Error IO GenericPackageDescription forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a ExceptT (IO (Either Error GenericPackageDescription) -> ExceptT Error IO GenericPackageDescription) -> IO (Either Error GenericPackageDescription) -> ExceptT Error IO GenericPackageDescription forall a b. (a -> b) -> a -> b $ (Either IOError GenericPackageDescription -> Either Error GenericPackageDescription) -> IO (Either IOError GenericPackageDescription) -> IO (Either Error GenericPackageDescription) forall a b. (a -> b) -> IO a -> IO b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ((IOError -> Error) -> Either IOError GenericPackageDescription -> Either Error GenericPackageDescription forall a b c. (a -> b) -> Either a c -> Either b c forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (Text -> Error PreprocError (Text -> Error) -> (IOError -> Text) -> IOError -> Error forall b c a. (b -> c) -> (a -> b) -> a -> c . IOError -> Text forall b a. (Show a, IsString b) => a -> b show)) (IO (Either IOError GenericPackageDescription) -> IO (Either Error GenericPackageDescription)) -> IO (Either IOError GenericPackageDescription) -> IO (Either Error GenericPackageDescription) forall a b. (a -> b) -> a -> b $ IO GenericPackageDescription -> IO (Either IOError GenericPackageDescription) forall a. IO a -> IO (Either IOError a) tryIOError do Verbosity -> FilePattern -> IO GenericPackageDescription readGenericPackageDescription Verbosity Cabal.verbose (Path Abs File -> FilePattern 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 = ExceptT Error IO BuildInfo -> (BuildInfo -> ExceptT Error IO BuildInfo) -> Maybe BuildInfo -> ExceptT Error IO BuildInfo forall b a. b -> (a -> b) -> Maybe a -> b maybe (Text -> Path Rel File -> ExceptT Error IO BuildInfo forall b a. Text -> Path b File -> ExceptT Error IO a noMatch Text "cabal component" Path Rel File source) BuildInfo -> ExceptT Error IO BuildInfo forall a. a -> ExceptT Error IO a forall (f :: * -> *) a. Applicative f => a -> f a pure ((BuildInfo -> Bool) -> [BuildInfo] -> Maybe BuildInfo 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)] [ModuleName] [Dependency] [Extension] [Language] [SymbolicPath PackageDir SourceDir] [PkgconfigDependency] [Mixin] [LegacyExeDependency] [ExeDependency] Maybe Language PerCompilerFlavor [FilePattern] buildable :: Bool buildTools :: [LegacyExeDependency] buildToolDepends :: [ExeDependency] cppOptions :: [FilePattern] asmOptions :: [FilePattern] cmmOptions :: [FilePattern] ccOptions :: [FilePattern] cxxOptions :: [FilePattern] ldOptions :: [FilePattern] hsc2hsOptions :: [FilePattern] pkgconfigDepends :: [PkgconfigDependency] frameworks :: [FilePattern] extraFrameworkDirs :: [FilePattern] asmSources :: [FilePattern] cmmSources :: [FilePattern] cSources :: [FilePattern] cxxSources :: [FilePattern] jsSources :: [FilePattern] hsSourceDirs :: [SymbolicPath PackageDir SourceDir] otherModules :: [ModuleName] virtualModules :: [ModuleName] autogenModules :: [ModuleName] defaultLanguage :: Maybe Language otherLanguages :: [Language] defaultExtensions :: [Extension] otherExtensions :: [Extension] oldExtensions :: [Extension] extraLibs :: [FilePattern] extraLibsStatic :: [FilePattern] extraGHCiLibs :: [FilePattern] extraBundledLibs :: [FilePattern] extraLibFlavours :: [FilePattern] extraDynLibFlavours :: [FilePattern] extraLibDirs :: [FilePattern] extraLibDirsStatic :: [FilePattern] includeDirs :: [FilePattern] includes :: [FilePattern] autogenIncludes :: [FilePattern] installIncludes :: [FilePattern] options :: PerCompilerFlavor [FilePattern] profOptions :: PerCompilerFlavor [FilePattern] sharedOptions :: PerCompilerFlavor [FilePattern] staticOptions :: PerCompilerFlavor [FilePattern] customFieldsBI :: [(FilePattern, FilePattern)] targetBuildDepends :: [Dependency] mixins :: [Mixin] buildToolDepends :: BuildInfo -> [ExeDependency] hsSourceDirs :: BuildInfo -> [SymbolicPath PackageDir SourceDir] buildable :: BuildInfo -> Bool buildTools :: BuildInfo -> [LegacyExeDependency] cppOptions :: BuildInfo -> [FilePattern] asmOptions :: BuildInfo -> [FilePattern] cmmOptions :: BuildInfo -> [FilePattern] ccOptions :: BuildInfo -> [FilePattern] cxxOptions :: BuildInfo -> [FilePattern] ldOptions :: BuildInfo -> [FilePattern] hsc2hsOptions :: BuildInfo -> [FilePattern] pkgconfigDepends :: BuildInfo -> [PkgconfigDependency] frameworks :: BuildInfo -> [FilePattern] extraFrameworkDirs :: BuildInfo -> [FilePattern] asmSources :: BuildInfo -> [FilePattern] cmmSources :: BuildInfo -> [FilePattern] cSources :: BuildInfo -> [FilePattern] cxxSources :: BuildInfo -> [FilePattern] jsSources :: BuildInfo -> [FilePattern] otherModules :: BuildInfo -> [ModuleName] virtualModules :: BuildInfo -> [ModuleName] autogenModules :: BuildInfo -> [ModuleName] defaultLanguage :: BuildInfo -> Maybe Language otherLanguages :: BuildInfo -> [Language] defaultExtensions :: BuildInfo -> [Extension] otherExtensions :: BuildInfo -> [Extension] oldExtensions :: BuildInfo -> [Extension] extraLibs :: BuildInfo -> [FilePattern] extraLibsStatic :: BuildInfo -> [FilePattern] extraGHCiLibs :: BuildInfo -> [FilePattern] extraBundledLibs :: BuildInfo -> [FilePattern] extraLibFlavours :: BuildInfo -> [FilePattern] extraDynLibFlavours :: BuildInfo -> [FilePattern] extraLibDirs :: BuildInfo -> [FilePattern] extraLibDirsStatic :: BuildInfo -> [FilePattern] includeDirs :: BuildInfo -> [FilePattern] includes :: BuildInfo -> [FilePattern] autogenIncludes :: BuildInfo -> [FilePattern] installIncludes :: BuildInfo -> [FilePattern] options :: BuildInfo -> PerCompilerFlavor [FilePattern] profOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] sharedOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] staticOptions :: BuildInfo -> PerCompilerFlavor [FilePattern] customFieldsBI :: BuildInfo -> [(FilePattern, FilePattern)] targetBuildDepends :: BuildInfo -> [Dependency] mixins :: BuildInfo -> [Mixin] ..} = (SymbolicPath PackageDir SourceDir -> Bool) -> [SymbolicPath PackageDir SourceDir] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (FilePattern -> Bool matchSourceDir (FilePattern -> Bool) -> (SymbolicPath PackageDir SourceDir -> FilePattern) -> SymbolicPath PackageDir SourceDir -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . SymbolicPath PackageDir SourceDir -> FilePattern forall from to. SymbolicPath from to -> FilePattern getSymbolicPath) [SymbolicPath PackageDir SourceDir] hsSourceDirs matchSourceDir :: FilePattern -> Bool matchSourceDir FilePattern dir | Just Path Rel Dir p <- FilePattern -> Maybe (Path Rel Dir) forall (m :: * -> *). MonadThrow m => FilePattern -> m (Path Rel Dir) parseRelDir FilePattern dir, Path Rel Dir -> Path Rel File -> Bool 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) (CondTree ConfVar [Dependency] Library -> BuildInfo) -> [CondTree ConfVar [Dependency] Library] -> [BuildInfo] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Maybe (CondTree ConfVar [Dependency] Library) -> [CondTree ConfVar [Dependency] Library] forall a. Maybe a -> [a] maybeToList GenericPackageDescription pkg.condLibrary) [BuildInfo] -> [BuildInfo] -> [BuildInfo] forall a. Semigroup a => a -> a -> a <> ((Library -> BuildInfo) -> (UnqualComponentName, CondTree ConfVar [Dependency] Library) -> BuildInfo forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Library -> BuildInfo libBuildInfo ((UnqualComponentName, CondTree ConfVar [Dependency] Library) -> BuildInfo) -> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> [BuildInfo] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condSubLibraries) [BuildInfo] -> [BuildInfo] -> [BuildInfo] forall a. Semigroup a => a -> a -> a <> ((Executable -> BuildInfo) -> (UnqualComponentName, CondTree ConfVar [Dependency] Executable) -> BuildInfo forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Executable -> BuildInfo Executable.buildInfo ((UnqualComponentName, CondTree ConfVar [Dependency] Executable) -> BuildInfo) -> [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> [BuildInfo] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condExecutables) [BuildInfo] -> [BuildInfo] -> [BuildInfo] forall a. Semigroup a => a -> a -> a <> ((TestSuite -> BuildInfo) -> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite) -> BuildInfo forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo TestSuite -> BuildInfo testBuildInfo ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite) -> BuildInfo) -> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> [BuildInfo] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> GenericPackageDescription pkg.condTestSuites) [BuildInfo] -> [BuildInfo] -> [BuildInfo] forall a. Semigroup a => a -> a -> a <> ((Benchmark -> BuildInfo) -> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark) -> BuildInfo forall a b c d. (a -> BuildInfo) -> (b, CondTree c d a) -> BuildInfo buildInfo Benchmark -> BuildInfo benchmarkBuildInfo ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark) -> BuildInfo) -> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> [BuildInfo] 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