diff options
author | Ben Sima <ben@bsima.me> | 2022-08-05 20:39:17 -0400 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2022-08-05 20:39:17 -0400 |
commit | 985da04a702f78fd569e62a8df119adb72b9d537 (patch) | |
tree | 09b83744aeda5b1e915a0059b78045947a937553 | |
parent | 2e2542c51c74bcfd3b6872de97b8bab7d8d7c90f (diff) |
Refactoring to simplify some code
Reduced duplication of out and sysdeps detection. Some other readibility cleanups.
-rw-r--r-- | Biz/Bild.hs | 69 |
1 files changed, 21 insertions, 48 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs index 07a4fee..5af1676 100644 --- a/Biz/Bild.hs +++ b/Biz/Bild.hs @@ -356,7 +356,7 @@ analyze hmap ns = case Map.lookup ns hmap of root <- Env.getEnv "BIZ_ROOT" absPath <- Dir.makeAbsolute path user <- Env.getEnv "USER" /> Text.pack - host <- Text.pack </ fromMaybe "interactive" </ Env.lookupEnv "HOSTNAME" + host <- Env.lookupEnv "HOSTNAME" /> fromMaybe "interactive" /> Text.pack Log.info ["bild", "analyze", str path] case ext of -- basically we don't support building these @@ -368,19 +368,8 @@ analyze hmap ns = case Map.lookup ns hmap of Namespace.Py -> pure Nothing Namespace.Sh -> pure Nothing Namespace.C -> do - let out = - contentLines - /> Text.unpack - /> Regex.match (metaOut "//" <|> metaLib "//") - |> catMaybes - |> head - |> fromMaybe None - let sysdeps = - contentLines - /> Text.unpack - /> Regex.match (metaSys "//") - |> catMaybes - |> Set.fromList + let out = detectOut (metaOut "//" <|> metaLib "//") contentLines + let sysdeps = detectSysdeps (metaSys "//") contentLines ("guile_3_0" `elem` sysdeps) ?. ( pure mempty, Process.readProcess "guile-config" ["compile"] "" @@ -407,13 +396,7 @@ analyze hmap ns = case Map.lookup ns hmap of |> pure Namespace.Hs -> do langdeps <- detectHaskellImports contentLines - let out = - contentLines - /> Text.unpack - /> Regex.match (metaOut "--") - |> catMaybes - |> head - |> fromMaybe None + let out = detectOut (metaOut "--") contentLines Just </ pure Target @@ -441,23 +424,12 @@ analyze hmap ns = case Map.lookup ns hmap of ], [] ), - sysdeps = - contentLines - /> Text.unpack - /> Regex.match (metaSys "--") - |> catMaybes - |> Set.fromList, + sysdeps = detectSysdeps (metaSys "--") contentLines, outPath = outToPath out, .. } Namespace.Lisp -> do - let out = - contentLines - /> Text.unpack - /> Regex.match (metaOut ";;") - |> catMaybes - |> head - |> fromMaybe None + let out = detectOut (metaOut ";;") contentLines langdeps <- detectLispImports contentLines Just </ pure @@ -504,13 +476,7 @@ analyze hmap ns = case Map.lookup ns hmap of .. } Namespace.Scm -> do - let out = - contentLines - /> Text.unpack - /> Regex.match (metaOut ";;") - |> catMaybes - |> head - |> fromMaybe None + let out = detectOut (metaOut ";;") contentLines Just </ pure Target @@ -531,13 +497,7 @@ analyze hmap ns = case Map.lookup ns hmap of .. } Namespace.Rs -> do - let out = - contentLines - /> Text.unpack - /> Regex.match (metaOut "//") - |> catMaybes - |> head - |> fromMaybe None + let out = detectOut (metaOut "//") contentLines Just </ pure Target @@ -578,6 +538,19 @@ analyze hmap ns = case Map.lookup ns hmap of detectLispImports contentLines = do let requires = contentLines /> Text.unpack /> Regex.match lispRequires |> catMaybes pure <| Set.fromList requires + detectOut m cl = + cl + /> Text.unpack + /> Regex.match m + |> catMaybes + |> head + |> fromMaybe None + detectSysdeps m cl = + cl + /> Text.unpack + /> Regex.match m + |> catMaybes + |> Set.fromList ghcPkgFindModule :: Set String -> String -> IO (Set String) ghcPkgFindModule acc m = do |