Add srcs to Target

Only fully implemented for Haskell at the moment but that is okay.

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