summaryrefslogtreecommitdiff
path: root/Biz/Bild.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2022-08-05 20:39:17 -0400
committerBen Sima <ben@bsima.me>2022-08-05 20:39:17 -0400
commit985da04a702f78fd569e62a8df119adb72b9d537 (patch)
tree09b83744aeda5b1e915a0059b78045947a937553 /Biz/Bild.hs
parent2e2542c51c74bcfd3b6872de97b8bab7d8d7c90f (diff)
Refactoring to simplify some code
Reduced duplication of out and sysdeps detection. Some other readibility cleanups.
Diffstat (limited to 'Biz/Bild.hs')
-rw-r--r--Biz/Bild.hs69
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