1module Main where
  2import Char (isSpace)
  3import Directory (doesFileExist)
  4import System (system, ExitCode(..))
  5import List (find)
  6import qualified Data.Map as Map
  7
  8-- IF YOU USE GHC COMMENT THE ABOVE IMPORTS AND UNCOMMENT THESE
  9-- i dont reccomend to use GHC as it is not bootstrappable which 
 10-- could lead to a trusting-trust attack
 11-- import Data.Char (isSpace)
 12-- import System.Directory (doesFileExist)
 13-- import System.Process (system)
 14-- import System.Exit (ExitCode(..))  
 15-- import Data.List (find)
 16
 17data TypedLine
 18    = Blank
 19    | Recipe     String
 20    | Statement  String
 21    | Assignment String
 22    | Unknown    String
 23    deriving (Show, Eq)
 24
 25-- thanks ricardo for suggesting this
 26data Rule = Rule
 27    { ruleName    :: String
 28    , rulePrereqs :: [String] 
 29    , ruleRecipes :: [String] 
 30    } deriving (Show, Eq)
 31
 32parseLine :: String -> TypedLine
 33parseLine ('\t':rest) = Recipe rest	
 34parseLine line
 35    | null trimmed      = Blank 
 36    | elem ':' stripped = Statement stripped
 37    | elem '=' stripped = Assignment stripped
 38    | otherwise         = Unknown stripped
 39        where
 40            stripComment line = takeWhile(/= '#') line
 41            stripped = stripComment line
 42            trimmed  = dropWhile isSpace stripped
 43
 44isRecipe :: TypedLine -> Bool
 45isRecipe (Recipe _)    = True
 46isRecipe _             = False
 47
 48recipeText :: TypedLine -> String
 49recipeText (Recipe text) = text
 50
 51parseRules :: [TypedLine] -> Either String [Rule]
 52parseRules []                      = Right []
 53parseRules (Unknown line : rest)   = Left "unknown line type"
 54parseRules (Recipe line : rest)    = Left "recipe without preceding dependency declaration"
 55parseRules (Blank : rest)          = parseRules rest
 56parseRules (Assignment _ : rest)          = parseRules rest
 57parseRules (Statement stmt : rest) = -- if you see stmt split into stmt and rest
 58    -- split into 1) recipe lines immedtiately following the stmt
 59    --            2) everything else
 60    let (recipeLines, remaining) = span isRecipe rest
 61        -- create a rule with the statement and recipe lines
 62        currentRule = mkRule stmt recipeLines
 63    in case parseRules remaining of
 64        Left message    -> Left message
 65        Right nextRules -> Right (currentRule : nextRules)
 66
 67-- we take a string and a list of typed lines and produce a rule
 68mkRule :: String -> [TypedLine] -> Rule
 69mkRule stmt recipeLines =
 70    let (name, prereqs) = splitStmt stmt
 71        recipes = map recipeText recipeLines
 72    in Rule name prereqs recipes
 73    where 
 74        splitStmt stmt = case break(== ':') stmt of
 75            (lhs, ':':rhs) -> (lhs, words rhs)
 76            _              -> error "statement has no colon" 
 77
 78-- take a string (assignment) and a map of assignments and return new map of assignments
 79parseAssign :: String -> Map.Map String String -> Map.Map String String
 80parseAssign line macros =
 81    let (name, val) = break(== '=') line
 82        trimmedName = trim name
 83	-- drop =
 84        trimmedVal  = trim (drop 1 val)
 85    -- insert the pair into new map
 86    in Map.insert trimmedName trimmedVal macros
 87    where 
 88        -- trim both sides
 89        trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
 90
 91
 92collectAssigns :: [TypedLine] -> Map.Map String String
 93collectAssigns [] = Map.empty
 94-- if its an assignment parse it, add it to map, then keep iterating on remaning typed lines 
 95collectAssigns (Assignment text : rest) = parseAssign text (collectAssigns rest)
 96-- if not assignment ignore
 97collectAssigns (_ : rest) = collectAssigns rest
 98
 99expandMacro :: Map.Map String String -> String -> String
100expandMacro _ [] = []
101-- we found a macro
102expandMacro macros ('$':'(':rest) = 
103    let (name, afterName) = break (== ')') rest
104    in case afterName of
105        ')':after ->
106            -- search for the macro
107            case Map.lookup name macros of 
108               Just value -> 
109                   -- expand the macro's value and the remaining text
110                   expandMacro macros value ++ expandMacro macros after
111               Nothing ->
112                   -- replace with an empty string and expand the rest
113                   expandMacro macros after
114        -- for a case where theres no closing )
115        _ -> "$(" ++ rest
116expandMacro macros (char:rest) = char : expandMacro macros rest
117
118expandLine :: Map.Map String String -> TypedLine -> TypedLine
119expandLine macros (Statement text) = Statement (expandMacro macros text)
120expandLine macros (Recipe    text) = Recipe    (expandMacro macros text)
121expandLine _ line = line
122
123findRule :: String -> [Rule] -> Maybe Rule
124findRule name rules = find (\rule -> ruleName rule == name) rules
125
126-- take a list of rules, a target name and return its recipe
127targetRecipes :: [Rule] -> String -> [String]
128targetRecipes rules name =
129    case findRule name rules of
130        Nothing   -> []
131        Just rule -> ruleRecipes rule
132
133-- take a list of rules,
134-- a target name and do DFS, return list of rules in correct order
135orderTarget :: [Rule] -> String -> [Rule]
136orderTarget rules wanted =
137    case findRule wanted rules of
138        Nothing   -> [Rule wanted [] []]
139        Just rule ->
140            let prereqs = rulePrereqs rule
141                -- run "orderTarget rules" on every prereq in prereqs
142                -- this returns a list of dependency lists so use concat
143                -- to just make it one list
144                prereqOrders = map (orderTarget rules) prereqs
145            in concat prereqOrders ++ [rule]
146            -- xxx handle cycles and duplicates
147
148-- print and run a recipe
149runRecipe :: String -> IO Bool
150runRecipe command = do 
151    putStrLn command
152    exitCode <- system command
153    case exitCode of 
154        ExitSuccess   -> return True
155        ExitFailure _ -> return False
156
157-- this should prob be called isSource or smth as a leaf can have a recipe
158-- as long as it has no prereqs but whateva
159isLeaf :: Rule -> Bool
160isLeaf rule = null (rulePrereqs rule) && null (ruleRecipes rule)
161
162main :: IO ()
163main = do
164    mkf <- readFile "Makefile"
165    let rawLines      = lines mkf
166    let parsedLines   = map parseLine rawLines
167    let macros        = collectAssigns parsedLines
168    let expandedLines = map (expandLine macros) parsedLines
169    case parseRules expandedLines of
170        Left message -> putStrLn ("parse error: " ++ message)
171        Right rules  ->  
172            case rules of 
173                [] -> putStrLn "no targets" 
174                firstRule: _ -> do
175                -- xxx cli option for requested target
176                    let wanted    = ruleName firstRule 
177                    let order     = (orderTarget rules wanted)
178                    let leafs     = filter isLeaf order
179                    let leafNames = map ruleName leafs
180                    exists <- mapM doesFileExist leafNames
181                    let recipes = concatMap ruleRecipes order
182                    if and exists
183                        then mapM_ runRecipe recipes
184                        else putStrLn "a leaf node is missing"