commit 76bc5f9
shrub
·
2026-10-08 23:22:02 +0000 UTC
parent 76bc5f9
init
A
Makefile
+7,
-0
1@@ -0,0 +1,7 @@
2+all: test
3+
4+test: poop
5+ echo test
6+
7+poop:
8+ echo poop
A
main.hs
+152,
-0
1@@ -0,0 +1,152 @@
2+module Main where
3+import Char (isSpace)
4+import Directory (doesFileExist)
5+import System (system, ExitCode(..))
6+
7+data TypedLine
8+ = Blank
9+ -- | Comment
10+ | Recipe String
11+ | Statement String
12+ | Unknown String
13+ deriving (Show, Eq)
14+
15+data Rule = Rule
16+ String -- name
17+ [String] -- prereqs
18+ [String] -- recipe
19+ deriving (Show, Eq)
20+
21+stripComment :: String -> String
22+stripComment line = takeWhile(/= '#') line
23+
24+parseLine :: String -> TypedLine
25+parseLine ('\t':rest) = Recipe rest
26+parseLine line
27+ | null trimmed = Blank
28+ | elem ':' stripped = Statement stripped
29+ | otherwise = Unknown stripped
30+ where
31+ stripped = stripComment line
32+ trimmed = dropWhile isSpace stripped
33+
34+-- split statement into rhs (target) and lhs (prereqs)
35+splitStmt :: String -> (String, [String])
36+splitStmt stmt =
37+ case break(== ':') stmt of
38+ (lhs, ':':rhs) -> (lhs, words rhs)
39+ (_, []) -> error "wtf? stmt has no colon"
40+
41+isRecipe :: TypedLine -> Bool
42+isRecipe (Recipe _) = True
43+isRecipe _ = False
44+
45+recipeText :: TypedLine -> String
46+recipeText (Recipe text) = text
47+
48+parseRules :: [TypedLine] -> Either String [Rule]
49+parseRules [] = Right []
50+parseRules (Unknown line : rest) = Left "unknown line type"
51+parseRules (Recipe line : rest) = Left "recipe without preceding dependency declaration"
52+parseRules (Blank : rest) = parseRules rest
53+parseRules (Statement stmt : rest) = -- if you see stmt split into stmt and rest
54+ -- split into 1) recipe lines immedtiately following the stmt
55+ -- 2) everything else
56+ let (recipeLines, remaining) = span isRecipe rest
57+ -- create a rule with the statement and recipe lines
58+ currentRule = mkRule stmt recipeLines
59+ in case parseRules remaining of
60+ Left message -> Left message
61+ Right nextRules -> Right (currentRule : nextRules)
62+
63+-- we take a string and a list of typed lines and produce a rule
64+mkRule :: String -> [TypedLine] -> Rule
65+mkRule stmt recipeLines =
66+ let (name, prereqs) = splitStmt stmt
67+ recipes = map recipeText recipeLines
68+ in Rule name prereqs recipes
69+
70+-- we take a target name, a list of rules, and we might return a rule (if one exists with the name)
71+findRule :: String -> [Rule] -> Maybe Rule
72+findRule wanted [] = Nothing
73+findRule wanted (rule : rest) =
74+ case rule of
75+ Rule actualName _ _ ->
76+ if wanted == actualName
77+ -- if this is the wanted rule, return it
78+ then Just rule
79+ -- if not the wanted rule run findRule on the rest
80+ -- eventually rest will be []
81+ else findRule wanted rest
82+
83+-- take a rule and return its prereqs
84+rulePrereqs :: Rule -> [String]
85+rulePrereqs (Rule _ prereqs _) = prereqs
86+
87+-- take a rule and return it's recipe
88+ruleRecipes :: Rule -> [String]
89+ruleRecipes (Rule _ _ recipe) = recipe
90+
91+--take a list of rules, a target name and return its recipe
92+targetRecipes :: [Rule] -> String -> [String]
93+targetRecipes rules name =
94+ case findRule name rules of
95+ Nothing -> []
96+ Just rule -> ruleRecipes rule
97+
98+-- take a list of rules,
99+-- a target name and do DFS returning updated done and prereqs in order
100+orderTarget :: [Rule] -> String -> [String]
101+orderTarget rules wanted =
102+ case findRule wanted rules of
103+ Nothing -> [wanted]
104+ Just rule ->
105+ let prereqs = rulePrereqs rule
106+ -- run "orderTarget rules" on every prereq in prereqs
107+ -- this returns a list of dependency lists so use concat
108+ -- to just make it one list
109+ prereqOrders = map (orderTarget rules) prereqs
110+ in concat prereqOrders ++ [wanted]
111+ -- xxx handle cycles and duplicates
112+
113+hasRule :: [Rule] -> String -> Bool
114+hasRule rules name =
115+ case findRule name rules of
116+ Nothing -> False
117+ Just _ -> True
118+
119+-- take a list of rules, target names, and return the names that dont have rules
120+noRule :: [Rule] -> [String] -> [String]
121+noRule rules names =
122+ filter hasNoRule names
123+ where
124+ hasNoRule name = not (hasRule rules name)
125+
126+checkExistence :: String -> IO Bool
127+checkExistence name = doesFileExist name
128+
129+-- print and run a recipe
130+runRecipe :: String -> IO Bool
131+runRecipe command = do
132+ putStrLn command
133+ exitCode <- system command
134+ case exitCode of
135+ ExitSuccess -> return True
136+ ExitFailure _ -> return False
137+
138+main :: IO ()
139+main = do
140+ mkf <- readFile "Makefile"
141+ let rawLines = lines mkf
142+ let parsedLines = map parseLine rawLines
143+ case parseRules parsedLines of
144+ Left message -> putStrLn ("parse error: " ++ message)
145+ Right rules -> do
146+ -- xxx cli option for requested target
147+ let order = (orderTarget rules "all")
148+ let leafs = noRule rules order
149+ exists <- mapM checkExistence leafs
150+ let recipes = (concat (map (targetRecipes rules) order))
151+ if and exists
152+ then mapM_ runRecipe recipes
153+ else putStrLn "a leaf node is missing"