From 0727ad4ea80991e2fb104090b6d922557bbea281 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Tue, 2 Aug 2022 11:53:55 -0400 Subject: Break up monolithic detectImports function --- Biz/Bild.hs | 49 ++++++++++++++++++++++++------------------------- 1 file changed, 24 insertions(+), 25 deletions(-) (limited to 'Biz') diff --git a/Biz/Bild.hs b/Biz/Bild.hs index c5777f9..0489185 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -289,29 +289,6 @@ removeVersion = takeWhile (/= '.') .> butlast2 where butlast2 s = take (length s - 2) s -detectImports :: Namespace -> [Text] -> IO (Set Dep) -detectImports (Namespace _ Namespace.Hs) contentLines = do - let imports = - contentLines - /> Text.unpack - /> Regex.match haskellImports - |> catMaybes - pkgs <- foldM ghcPkgFindModule Set.empty imports - transitivePkgs <- - imports - |> map (Namespace.fromHaskellModule .> Namespace.toPath) - |> traverse Dir.makeAbsolute - +> filterM Dir.doesFileExist - +> Async.mapConcurrently analyze - /> catMaybes - /> map langdeps - /> mconcat - pure <| pkgs <> transitivePkgs -detectImports (Namespace _ Namespace.Lisp) contentLines = do - let requires = contentLines /> Text.unpack /> Regex.match lispRequires |> catMaybes - pure <| Set.fromList requires -detectImports _ _ = Exit.die "can only detectImports for Haskell" - -- | TODO: globally cache analyses, so I'm not re-analyzing modules all the -- time. This is important as it would speed up building by a lot. analyze :: FilePath -> IO (Maybe Target) @@ -376,7 +353,7 @@ analyze path = do .. } Namespace.Hs -> do - langdeps <- detectImports namespace contentLines + langdeps <- detectHaskellImports contentLines let out = contentLines /> Text.unpack @@ -396,7 +373,7 @@ analyze path = do .. } Namespace.Lisp -> do - langdeps <- detectImports namespace contentLines + langdeps <- detectLispImports contentLines pure Target { sysdeps = Set.empty, @@ -460,6 +437,28 @@ analyze path = do builder = user <> "@localhost", .. } + where + detectHaskellImports :: [Text] -> IO (Set Dep) + detectHaskellImports contentLines = do + let imports = + contentLines + /> Text.unpack + /> Regex.match haskellImports + |> catMaybes + pkgs <- foldM ghcPkgFindModule Set.empty imports + transitivePkgs <- + imports + |> map (Namespace.fromHaskellModule .> Namespace.toPath) + |> traverse Dir.makeAbsolute + +> filterM Dir.doesFileExist + +> Async.mapConcurrently analyze + /> catMaybes + /> map langdeps + /> mconcat + pure <| pkgs <> transitivePkgs + detectLispImports contentLines = do + let requires = contentLines /> Text.unpack /> Regex.match lispRequires |> catMaybes + pure <| Set.fromList requires ghcPkgFindModule :: Set String -> String -> IO (Set String) ghcPkgFindModule acc m = do -- cgit v1.2.3