summaryrefslogtreecommitdiff
path: root/Omni/Bild.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Omni/Bild.hs')
-rwxr-xr-xOmni/Bild.hs50
1 files changed, 26 insertions, 24 deletions
diff --git a/Omni/Bild.hs b/Omni/Bild.hs
index 90f6cd6..96ea9e9 100755
--- a/Omni/Bild.hs
+++ b/Omni/Bild.hs
@@ -187,7 +187,7 @@ test_bildBild =
case Namespace.fromPath root path of
Nothing -> Test.assertFailure "can't find ns for bild"
Just ns ->
- analyze mempty ns
+ analyzeAll [ns]
+> build False False 1 2
+> \case
[Exit.ExitFailure _] ->
@@ -204,7 +204,7 @@ test_bildExamples =
|> traverse Dir.makeAbsolute
/> map (Namespace.fromPath root)
/> catMaybes
- +> foldM analyze mempty
+ +> analyzeAll
+> build False False 4 1
+> \case
[] -> Test.assertFailure "asdf"
@@ -214,15 +214,16 @@ move :: Cli.Arguments -> IO ()
move args = do
IO.hSetBuffering stdout IO.NoBuffering
root <- Env.getEnv "CODEROOT"
- Cli.getAllArgs args (Cli.argument "target")
- |> filterM Dir.doesFileExist
- +> filterGitIgnored
- /> filter (\x -> isGitHook x |> don't)
- +> traverse Dir.makeAbsolute
- +> traverse (namespaceFromPathOrDie root)
- /> filter isBuildableNs
- +> foldM analyze mempty
- +> printOrBuild root
+ namespaces <-
+ Cli.getAllArgs args (Cli.argument "target")
+ |> filterM Dir.doesFileExist
+ +> filterGitIgnored
+ /> filter (\x -> isGitHook x |> don't)
+ +> traverse Dir.makeAbsolute
+ +> traverse (namespaceFromPathOrDie root)
+ /> filter isBuildableNs
+ analysis <- analyzeAll namespaces
+ printOrBuild root analysis
|> Timeout.timeout (toMillis minutes)
+> \case
Nothing ->
@@ -439,7 +440,7 @@ dev_getTarget fp = do
|> \case
Nothing -> panic "Could not get namespace from path"
Just ns ->
- analyze mempty ns
+ analyzeAll [ns]
/> Map.lookup ns
/> \case
Nothing -> panic "Could not retrieve target from analysis"
@@ -527,22 +528,21 @@ removeVersion = takeWhile (/= '.') .> butlast2
type Analysis = Map Namespace Target
-analyze :: Analysis -> Namespace -> IO Analysis
-analyze hmap ns = case Map.lookup ns hmap of
- Nothing -> do
- mTarget <- analyzeOne ns
- pure <| maybe hmap (\t -> Map.insert ns t hmap) mTarget
- Just _ -> pure hmap
+analyzeAll :: [Namespace] -> IO Analysis
+analyzeAll nss = do
+ LogC.withLineManager nss <| \lineMgr -> do
+ LogC.initializeLines lineMgr
+ targets <- mapConcurrentlyBounded 8 (analyzeOne lineMgr) nss
+ pure <| Map.fromList <| catMaybes <| zipWith (\ns mt -> (ns,) </ mt) nss targets
where
- analyzeOne :: Namespace -> IO (Maybe Target)
- analyzeOne namespace@(Namespace parts ext) = do
+ analyzeOne :: LogC.LineManager -> Namespace -> IO (Maybe Target)
+ analyzeOne _lineMgr namespace@(Namespace parts ext) = do
let path = Namespace.toPath namespace
root <- Env.getEnv "CODEROOT"
let abspath = root </> path
let quapath = path
user <- Env.getEnv "USER" /> Text.pack
host <- HostName.getHostName /> Text.pack
- Log.wipe >> Log.info ["+", nschunk namespace]
contentLines <-
withFile abspath ReadMode <| \h ->
IO.hSetEncoding h IO.utf8_bom
@@ -552,7 +552,7 @@ analyze hmap ns = case Map.lookup ns hmap of
-- dot-separated namespace instead
isExe <- Dir.getPermissions quapath /> Dir.executable
let defaultOut = isExe ?: (Just <| Namespace.dotSeparated parts, Nothing)
- case ext of
+ result <- case ext of
-- basically we don't support building these
Namespace.Css -> pure Nothing
Namespace.Json -> pure Nothing
@@ -565,7 +565,7 @@ analyze hmap ns = case Map.lookup ns hmap of
contentLines
|> Meta.detectAll "#"
|> \Meta.Parsed {..} ->
- detectPythonImports hmap contentLines +> \srcs ->
+ detectPythonImports mempty contentLines +> \srcs ->
Target
{ builder = "python",
wrapper = Nothing,
@@ -620,7 +620,7 @@ analyze hmap ns = case Map.lookup ns hmap of
contentLines
|> Meta.detectAll "--"
|> \Meta.Parsed {..} ->
- detectHaskellImports hmap contentLines +> \(langdeps, srcs) ->
+ detectHaskellImports mempty contentLines +> \(langdeps, srcs) ->
Target
{ builder = "haskell",
wrapper = Nothing,
@@ -789,6 +789,8 @@ analyze hmap ns = case Map.lookup ns hmap of
}
|> Just
|> pure
+ LogC.updateLineState namespace LogC.Pending
+ pure result
detectHaskellImports :: Analysis -> [Text] -> IO (Set Meta.Dep, Set FilePath)
detectHaskellImports _ contentLines = do