commit 79b33c8

shrub  ·  2026-10-09 17:20:35 +0000 UTC
parent 4950be7
various improvements
1 files changed,  +26, -57
+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"