commit 76bc5f9

shrub  ·  2026-10-08 23:22:02 +0000 UTC
parent 76bc5f9
init
2 files changed,  +159, -0
+7, -0
1@@ -0,0 +1,7 @@
2+all: test
3+
4+test: poop 
5+	echo test
6+
7+poop:
8+	echo poop
+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"