diff options
Diffstat (limited to 'Biz')
| -rw-r--r-- | Biz/Bild.hs | 107 |
1 files changed, 62 insertions, 45 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index b7215d1..562f43a 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -250,6 +250,8 @@ data Target = Target path :: FilePath, -- | Language-specific dependencies, required during compilation langdeps :: Set Meta.Dep, + -- | Local source files on which this target depends + srcs :: Set FilePath, -- | System-level dependencies, required during runtime either via PATH or -- linking, depending on the language sysdeps :: Set Meta.Dep, @@ -455,13 +457,14 @@ analyze hmap ns = case Map.lookup ns hmap of dir <- outable ?: ([Text.pack <| root </> outToPath pout], []) ], outPath = outToPath pout, + srcs = Set.singleton absPath, .. } |> Just |> pure Namespace.Hs -> Meta.detectOut (Meta.out "--") contentLines |> \out -> do - langdeps <- detectHaskellImports contentLines + (langdeps, srcs) <- detectHaskellImports hmap contentLines Target { builder = Local user, wrapper = Nothing, @@ -512,6 +515,7 @@ analyze hmap ns = case Map.lookup ns hmap of ], builder = Local <| user, outPath = outToPath out, + srcs = Set.singleton absPath, .. } Namespace.Nix -> @@ -531,6 +535,7 @@ analyze hmap ns = case Map.lookup ns hmap of |> map Text.pack, out = Meta.None, outPath = outToPath Meta.None, + srcs = Set.singleton absPath, .. } |> Just @@ -552,6 +557,7 @@ analyze hmap ns = case Map.lookup ns hmap of builder = Local user, outPath = outToPath pout, out = pout, + srcs = Set.singleton absPath, wrapper = (pout == Meta.None) ?: ( Nothing, @@ -581,56 +587,67 @@ analyze hmap ns = case Map.lookup ns hmap of compilerFlags = map Text.pack [absPath, "-o", root </> outToPath out], builder = Local user, outPath = outToPath out, + srcs = Set.singleton absPath, .. } |> Just |> pure - fromPath :: String -> IO (Maybe Namespace) --String ->IO (Maybe Namespace) - fromPath x = - Env.getEnv "BIZ_ROOT" +> \root -> - pure <| Namespace.fromPath root x - detectHaskellImports :: [Text] -> IO (Set Meta.Dep) - detectHaskellImports contentLines = - contentLines - /> Text.unpack - /> Regex.match haskellImports - |> catMaybes - |> \imports -> - foldM ghcPkgFindModule Set.empty imports - +> \pkgs -> - imports - |> map Namespace.fromHaskellModule - |> map Namespace.toPath - |> traverse Dir.makeAbsolute - +> filterM Dir.doesFileExist - +> traverse fromPath - /> catMaybes - -- this is still an inefficiency, because this recurses before the - -- hmap is updated by the fold, transitive imports will be - -- re-visited. you can see this with `TERM=dumb bild`. to fix this i - -- need shared state instead of a fold, or figure out how to do a - -- breadth-first search instead of depth-first. - +> foldM analyze hmap - /> Map.elems - /> map langdeps - /> mconcat - /> (<> pkgs) - - detectLispImports :: [Text] -> IO (Set Meta.Dep) - detectLispImports contentLines = do - let requires = contentLines /> Text.unpack /> Regex.match lispRequires |> catMaybes - pure <| Set.fromList requires + +detectHaskellImports :: Analysis -> [Text] -> IO (Set Meta.Dep, Set FilePath) +detectHaskellImports hmap contentLines = + Env.getEnv "BIZ_ROOT" +> \root -> + contentLines + /> Text.unpack + /> Regex.match haskellImports + |> catMaybes + |> \imports -> + foldM ghcPkgFindModule Set.empty imports + +> \pkgs -> do + a <- filepaths imports + b <- deps root imports + pure (b <> pkgs, Set.fromList a) + where + filepaths :: [String] -> IO [FilePath] + filepaths imports = + imports + |> map Namespace.fromHaskellModule + |> map Namespace.toPath + |> traverse Dir.makeAbsolute + +> filterM Dir.doesFileExist + deps :: String -> [String] -> IO (Set Meta.Dep) + deps root imports = + filepaths imports + +> traverse (pure <. Namespace.fromPath root) + /> catMaybes + -- this is still an inefficiency, because this recurses before the + -- hmap is updated by the fold, transitive imports will be + -- re-visited. you can see this with `TERM=dumb bild`. to fix this i + -- need shared state instead of a fold, or figure out how to do a + -- breadth-first search instead of depth-first. + +> foldM analyze hmap + /> Map.elems + /> map langdeps + /> mconcat + +detectLispImports :: [Text] -> IO (Set Meta.Dep) +detectLispImports contentLines = + contentLines + /> Text.unpack + /> Regex.match lispRequires + |> catMaybes + |> Set.fromList + |> pure ghcPkgFindModule :: Set String -> String -> IO (Set String) -ghcPkgFindModule acc m = do - packageDb <- Env.getEnv "GHC_PACKAGE_PATH" - Process.readProcess - "ghc-pkg" - ["--package-db", packageDb, "--names-only", "--simple-output", "find-module", m] - "" - /> String.lines - /> Set.fromList - /> Set.union acc +ghcPkgFindModule acc m = + Env.getEnv "GHC_PACKAGE_PATH" +> \packageDb -> + Process.readProcess + "ghc-pkg" + ["--package-db", packageDb, "--names-only", "--simple-output", "find-module", m] + "" + /> String.lines + /> Set.fromList + /> Set.union acc isFailure :: Exit.ExitCode -> Bool isFailure (Exit.ExitFailure _) = True |