diff options
| -rw-r--r-- | Omni/Bild.hs | 37 | ||||
| -rw-r--r-- | Omni/Bild/Builder.nix | 149 |
2 files changed, 163 insertions, 23 deletions
diff --git a/Omni/Bild.hs b/Omni/Bild.hs index e8c2f09..078aac1 100644 --- a/Omni/Bild.hs +++ b/Omni/Bild.hs @@ -178,7 +178,8 @@ main = Cli.Plan help move test_ pure |> Cli.main test_bildExamples, test_isGitIgnored, test_isGitHook, - test_detectPythonImports + test_detectPythonImports, + test_buildHsModuleGraph ] test_bildBild :: Test.Tree @@ -645,7 +646,7 @@ analyzeAll nss = do |> Meta.detectAll "--" |> \Meta.Parsed {..} -> detectHaskellImports mempty contentLines +> \(langdeps, srcs) -> do - graph <- buildHsModuleGraph namespace srcs + graph <- buildHsModuleGraph namespace quapath srcs pure <| Just Target @@ -921,6 +922,23 @@ test_detectPythonImports = Set.fromList ["Omni/Log.py"] @=? set ] +test_buildHsModuleGraph :: Test.Tree +test_buildHsModuleGraph = + Test.group + "buildHsModuleGraph" + [ Test.unit "includes entry point in graph" <| do + let ns = Namespace ["Omni", "Bild", "Example"] Namespace.Hs + let entryPoint = "Omni/Bild/Example.hs" + let deps = Set.fromList ["Alpha.hs", "Omni/Test.hs"] + + result <- buildHsModuleGraph ns entryPoint deps + case result of + Nothing -> Test.assertFailure "buildHsModuleGraph returned Nothing" + Just graph -> do + let modules = Map.keys (graphModules graph) + Text.pack "Omni.Bild.Example" `elem` modules @=? True + ] + type GhcPkgCacheMem = Map String (Set String) type GhcPkgCacheDisk = Map String [String] @@ -1013,12 +1031,15 @@ ghcPkgFindModule acc m = /> Set.union acc -- | Build module graph for Haskell targets, returns Nothing if TH or cycles detected -buildHsModuleGraph :: Namespace -> Set FilePath -> IO (Maybe HsModuleGraph) -buildHsModuleGraph namespace srcs = do +buildHsModuleGraph :: Namespace -> FilePath -> Set FilePath -> IO (Maybe HsModuleGraph) +buildHsModuleGraph namespace entryPoint deps = do root <- Env.getEnv "CODEROOT" - nodes <- foldM (analyzeModule root) Map.empty (Set.toList srcs) - let hasTH = any nodeHasTH (Map.elems nodes) - let hasCycles = detectCycles nodes + -- Analyze all dependencies first + depNodes <- foldM (analyzeModule root) Map.empty (Set.toList deps) + -- Then analyze the entry point itself + allNodes <- analyzeModule root depNodes entryPoint + let hasTH = any nodeHasTH (Map.elems allNodes) + let hasCycles = detectCycles allNodes if hasTH || hasCycles then pure Nothing else @@ -1026,7 +1047,7 @@ buildHsModuleGraph namespace srcs = do <| Just HsModuleGraph { graphEntry = Namespace.toHaskellModule namespace |> Text.pack, - graphModules = nodes + graphModules = allNodes } where analyzeModule :: FilePath -> Map ModuleName HsModuleNode -> FilePath -> IO (Map ModuleName HsModuleNode) diff --git a/Omni/Bild/Builder.nix b/Omni/Bild/Builder.nix index 2d311ff..a91924c 100644 --- a/Omni/Bild/Builder.nix +++ b/Omni/Bild/Builder.nix @@ -115,21 +115,140 @@ with bild; let buildPhase = compileLine; }; - haskell = stdenv.mkDerivation rec { - inherit name src CODEROOT preBuild; - nativeBuildInputs = [makeWrapper]; - buildInputs = - sysdeps_ - ++ [ - (haskell.ghcWith (p: (lib.attrsets.attrVals target.langdeps p))) - ]; - buildPhase = compileLine; - installPhase = '' - install -D ${name} $out/bin/${name} - wrapProgram $out/bin/${name} \ - --prefix PATH : ${lib.makeBinPath rundeps_} - ''; - }; + haskell = + if target.hsGraph == null + then + # Monolithic build (fallback for TH/cycles) + stdenv.mkDerivation rec { + inherit name src CODEROOT preBuild; + nativeBuildInputs = [makeWrapper]; + buildInputs = + sysdeps_ + ++ [ + (haskell.ghcWith (p: (lib.attrsets.attrVals target.langdeps p))) + ]; + buildPhase = compileLine; + installPhase = '' + install -D ${name} $out/bin/${name} + wrapProgram $out/bin/${name} \ + --prefix PATH : ${lib.makeBinPath rundeps_} + ''; + } + else + # Per-module incremental build + let + graph = target.hsGraph; + ghcPkg = haskell.ghcWith (p: (lib.attrsets.attrVals target.langdeps p)); + + # Helper to sanitize module names for Nix attr names + sanitize = builtins.replaceStrings ["."] ["_"]; + + # Create source filter for a single module + mkModuleSrc = modulePath: let + moduleFiles = [modulePath]; + moduleAllSources = moduleFiles; + moduleAllSourcesRel = lib.lists.map normalize moduleAllSources; + moduleAllowedDirs = lib.lists.unique ( + [""] + ++ lib.lists.concatMap + (p: let + parts = lib.strings.splitString "/" p; + in + dirPrefixes (lib.lists.init parts)) + moduleAllSourcesRel + ); + moduleFilter = file: type: + if lib.lists.elem (builtins.baseNameOf file) skip + then false + else if type == "directory" + then let + rel = lib.strings.removePrefix "${root}/" file; + rel' = normalize rel; + in + lib.lists.elem rel' moduleAllowedDirs + else if type == "regular" + then let + rel = lib.strings.removePrefix "${root}/" file; + rel' = normalize rel; + in + lib.lists.elem rel' moduleAllSourcesRel + else false; + in + lib.sources.cleanSourceWith { + filter = moduleFilter; + src = lib.sources.cleanSource root; + }; + + # Build one module derivation + mkModuleDrv = modName: node: depDrvs: + stdenv.mkDerivation { + name = "hs-mod-${sanitize modName}"; + src = mkModuleSrc node.nodePath; + inherit CODEROOT; + buildInputs = sysdeps_ ++ [ghcPkg] ++ depDrvs; + buildPhase = let + copyDeps = + lib.strings.concatMapStringsSep "\n" (d: '' + cp -rL ${d}/hidir/. hidir/ 2>/dev/null || true + '') + depDrvs; + in '' + mkdir -p hidir odir + ${copyDeps} + chmod -R +w hidir || true + ghc -c \ + -Wall -Werror -haddock -Winvalid-haddock \ + -i. -ihidir \ + -odir odir -hidir hidir \ + ${node.nodePath} + ''; + installPhase = '' + mkdir -p $out/hidir $out/odir + cp -r hidir/* $out/hidir/ || true + cp -r odir/* $out/odir/ || true + ''; + }; + + # Recursive attrset of all module derivations + modules = lib.fix (self: + lib.mapAttrs + (modName: node: + mkModuleDrv modName node (map (dep: builtins.getAttr dep self) node.nodeImports)) + graph.graphModules); + + # Compute exact object paths at eval time + moduleToObjPath = modName: drv: "${drv}/odir/${lib.strings.replaceStrings ["."] ["/"] modName}.o"; + objectPaths = + lib.attrsets.mapAttrsToList moduleToObjPath modules; + in + # Final link derivation + stdenv.mkDerivation rec { + inherit name CODEROOT src; + nativeBuildInputs = [makeWrapper]; + dontConfigure = true; + buildPhase = let + pkgFlags = lib.strings.concatMapStringsSep " " (p: "-package ${p}") target.langdeps; + hiDirs = lib.attrsets.mapAttrsToList (_modName: drv: "${drv}/hidir") modules; + iFlags = lib.strings.concatMapStringsSep " " (d: "-i ${d}") hiDirs; + in '' + set -eux + echo "Starting custom link phase with ${builtins.toString (builtins.length objectPaths)} object files" + ${ghcPkg}/bin/ghc --make -o ${name} \ + -i. ${iFlags} \ + ${pkgFlags} \ + -threaded \ + ${lib.optionalString (target.mainModule != "Main") "-main-is ${target.mainModule}"} \ + ${target.quapath} + echo "Link completed successfully" + ''; + installPhase = '' + install -D ${name} $out/bin/${name} + ${lib.optionalString (rundeps_ != []) '' + wrapProgram $out/bin/${name} \ + --prefix PATH : ${lib.makeBinPath rundeps_} + ''} + ''; + }; c = stdenv.mkDerivation rec { inherit name src CODEROOT preBuild; |