commit 79b33c8
shrub
·
2026-10-09 17:20:35 +0000 UTC
parent 4950be7
various improvements
1 files changed,
+26,
-57
M
main.hs
M
main.hs
+26,
-57
1@@ -2,6 +2,7 @@ module Main where
2 import Char (isSpace)
3 import Directory (doesFileExist)
4 import System (system, ExitCode(..))
5+import List (find)
6
7 -- IF YOU USE GHC COMMENT THE ABOVE IMPORTS AND UNCOMMENT THESE
8 -- i dont reccomend to use GHC as it is not bootstrappable which
9@@ -19,14 +20,12 @@ data TypedLine
10 | Unknown String
11 deriving (Show, Eq)
12
13+-- thanks ricardo for suggesting this
14 data Rule = Rule
15- String -- name
16- [String] -- prereqs
17- [String] -- recipe
18- deriving (Show, Eq)
19-
20-stripComment :: String -> String
21-stripComment line = takeWhile(/= '#') line
22+ { ruleName :: String
23+ , rulePrereqs :: [String]
24+ , ruleRecipes :: [String]
25+ } deriving (Show, Eq)
26
27 parseLine :: String -> TypedLine
28 parseLine ('\t':rest) = Recipe rest
29@@ -35,16 +34,10 @@ parseLine line
30 | elem ':' stripped = Statement stripped
31 | otherwise = Unknown stripped
32 where
33+ stripComment line = takeWhile(/= '#') line
34 stripped = stripComment line
35 trimmed = dropWhile isSpace stripped
36
37--- split statement into rhs (target) and lhs (prereqs)
38-splitStmt :: String -> (String, [String])
39-splitStmt stmt =
40- case break(== ':') stmt of
41- (lhs, ':':rhs) -> (lhs, words rhs)
42- (_, []) -> error "wtf? stmt has no colon"
43-
44 isRecipe :: TypedLine -> Bool
45 isRecipe (Recipe _) = True
46 isRecipe _ = False
47@@ -73,29 +66,15 @@ mkRule stmt recipeLines =
48 let (name, prereqs) = splitStmt stmt
49 recipes = map recipeText recipeLines
50 in Rule name prereqs recipes
51+ where
52+ splitStmt stmt = case break(== ':') stmt of
53+ (lhs, ':':rhs) -> (lhs, words rhs)
54+ _ -> error "statement has no colon"
55
56--- we take a target name, a list of rules, and we might return a rule (if one exists with the name)
57 findRule :: String -> [Rule] -> Maybe Rule
58-findRule wanted [] = Nothing
59-findRule wanted (rule : rest) =
60- case rule of
61- Rule actualName _ _ ->
62- if wanted == actualName
63- -- if this is the wanted rule, return it
64- then Just rule
65- -- if not the wanted rule run findRule on the rest
66- -- eventually rest will be []
67- else findRule wanted rest
68-
69--- take a rule and return its prereqs
70-rulePrereqs :: Rule -> [String]
71-rulePrereqs (Rule _ prereqs _) = prereqs
72-
73--- take a rule and return it's recipe
74-ruleRecipes :: Rule -> [String]
75-ruleRecipes (Rule _ _ recipe) = recipe
76+findRule name rules = find (\rule -> ruleName rule == name) rules
77
78---take a list of rules, a target name and return its recipe
79+-- take a list of rules, a target name and return its recipe
80 targetRecipes :: [Rule] -> String -> [String]
81 targetRecipes rules name =
82 case findRule name rules of
83@@ -103,36 +82,20 @@ targetRecipes rules name =
84 Just rule -> ruleRecipes rule
85
86 -- take a list of rules,
87--- a target name and do DFS returning updated done and prereqs in order
88-orderTarget :: [Rule] -> String -> [String]
89+-- a target name and do DFS, return list of rules in correct order
90+orderTarget :: [Rule] -> String -> [Rule]
91 orderTarget rules wanted =
92 case findRule wanted rules of
93- Nothing -> [wanted]
94+ Nothing -> [Rule wanted [] []]
95 Just rule ->
96 let prereqs = rulePrereqs rule
97 -- run "orderTarget rules" on every prereq in prereqs
98 -- this returns a list of dependency lists so use concat
99 -- to just make it one list
100 prereqOrders = map (orderTarget rules) prereqs
101- in concat prereqOrders ++ [wanted]
102+ in concat prereqOrders ++ [rule]
103 -- xxx handle cycles and duplicates
104
105-hasRule :: [Rule] -> String -> Bool
106-hasRule rules name =
107- case findRule name rules of
108- Nothing -> False
109- Just _ -> True
110-
111--- take a list of rules, target names, and return the names that dont have rules
112-noRule :: [Rule] -> [String] -> [String]
113-noRule rules names =
114- filter hasNoRule names
115- where
116- hasNoRule name = not (hasRule rules name)
117-
118-checkExistence :: String -> IO Bool
119-checkExistence name = doesFileExist name
120-
121 -- print and run a recipe
122 runRecipe :: String -> IO Bool
123 runRecipe command = do
124@@ -142,6 +105,11 @@ runRecipe command = do
125 ExitSuccess -> return True
126 ExitFailure _ -> return False
127
128+-- this should prob be called isSource or smth as a leaf can have a recipe
129+-- as long as it has no prereqs but whateva
130+isLeaf :: Rule -> Bool
131+isLeaf rule = null (rulePrereqs rule) && null (ruleRecipes rule)
132+
133 main :: IO ()
134 main = do
135 mkf <- readFile "Makefile"
136@@ -152,9 +120,10 @@ main = do
137 Right rules -> do
138 -- xxx cli option for requested target
139 let order = (orderTarget rules "all")
140- let leafs = noRule rules order
141- exists <- mapM checkExistence leafs
142- let recipes = (concat (map (targetRecipes rules) order))
143+ let leafs = filter isLeaf order
144+ let leafNames = map ruleName leafs
145+ exists <- mapM doesFileExist leafNames
146+ let recipes = concatMap ruleRecipes order
147 if and exists
148 then mapM_ runRecipe recipes
149 else putStrLn "a leaf node is missing"