diff --git a/src/Mechanic.CommandLine/Program.fs b/src/Mechanic.CommandLine/Program.fs index de90eb6..5d6fb56 100644 --- a/src/Mechanic.CommandLine/Program.fs +++ b/src/Mechanic.CommandLine/Program.fs @@ -1,9 +1,24 @@ open Mechanic +open Mechanic.Files +open Mechanic.GraphAlg +open Mechanic.Utils [] let main argv = - let root = argv.[0] - let pattern = argv.[1] - SymbolGraph.solveOrderFromPattern root pattern - |> printfn "%A" + match argv.Length with + | 1 -> + let p = ProjectFile.loadFromFile argv.[0] + p |> ProjectFile.getSourceFiles + |> SymbolGraph.solveOrder (fun f -> f.FullName) + |> function + | TopologicalOrderResult.TopologicalOrder xs -> + xs |> fun x -> ProjectFile.updateProjectFile x p + TopologicalOrderResult.TopologicalOrder (xs |> List.map (fun f -> f.FullName)) + | TopologicalOrderResult.Cycle xs -> TopologicalOrderResult.Cycle (xs |> List.map (fun f -> f.FullName)) + |> printfn "%A" + | 2 -> + let root = argv.[0] + let pattern = argv.[1] + SymbolGraph.solveOrderFromPattern root pattern + |> printfn "%A" 0 diff --git a/src/Mechanic.Tests/FileOrderTests.fs b/src/Mechanic.Tests/FileOrderTests.fs index e61bbbe..88f2a47 100644 --- a/src/Mechanic.Tests/FileOrderTests.fs +++ b/src/Mechanic.Tests/FileOrderTests.fs @@ -31,11 +31,11 @@ let makeTempProject sources = let expectOrder sources = let (_, _, files) = makeTempProject sources - Expect.equal (SymbolGraph.solveOrder files) (TopologicalOrder files) "Wrong order of files" + Expect.equal (SymbolGraph.solveOrder id files) (TopologicalOrder files) "Wrong order of files" let checkCycle sources = let (_, _, files) = makeTempProject sources - match SymbolGraph.solveOrder files with + match SymbolGraph.solveOrder id files with | Cycle _ -> true | _ -> false diff --git a/src/Mechanic.Tests/Files.fs b/src/Mechanic.Tests/Files.fs index d54a2bc..315725d 100644 --- a/src/Mechanic.Tests/Files.fs +++ b/src/Mechanic.Tests/Files.fs @@ -41,6 +41,15 @@ let makeTempProjFile contents = File.Delete(pFile) Expect.equal sfNames ["File1.fs"; "File2.fs"; "File3.fs"] "File names are correct" + testCase "Source files full path are parsed correctly" <| fun _ -> + let pFile = makeTempProjFile projectFileText + let pDir = FileInfo(pFile).Directory.FullName + let pf = ProjectFile.loadFromFile pFile + let sfNames = ProjectFile.getSourceFiles pf |> List.map (fun x -> x.FullName) + File.Delete(pFile) + let expectedPaths = ["File1.fs"; "File2.fs"; "File3.fs"] |> List.map (fun x -> Path.Combine(pDir, x)) + Expect.equal sfNames expectedPaths "File paths are correct" + testCase "Source file order is persisted to disk correctly" <| fun _ -> let pFile = makeTempProjFile projectFileText let pf = ProjectFile.loadFromFile pFile diff --git a/src/Mechanic/Files.fs b/src/Mechanic/Files.fs index 6db09f1..221a940 100644 --- a/src/Mechanic/Files.fs +++ b/src/Mechanic/Files.fs @@ -12,7 +12,8 @@ type ProjectFile = { type SourceFile = { FullName : string - ShortName : string + ShortName : string + XmlNode : XmlNode } @@ -63,16 +64,18 @@ module ProjectFile = let parseSourceFileNames (node:XmlNode) = getCompileGroup node - |> Option.map (getChildNodes >> (Seq.choose (getAttribute IncludeAttribute))) - |> Option.defaultValue Seq.empty + |> Option.map (getChildNodes >> (Seq.choose (fun n -> getAttribute IncludeAttribute n |> Option.map (fun a -> n, a)))) + |> Option.defaultValue Seq.empty |> List.ofSeq let getSourceFiles (pf:ProjectFile) = + let projectDir = FileInfo(pf.FileName).Directory.FullName parseSourceFileNames pf.ProjectNode - |> List.map (fun x -> - let fi = FileInfo x + |> List.map (fun (xml,x) -> + let fi = FileInfo (Path.Combine(projectDir, x)) { FullName = fi.FullName - ShortName = x }) + ShortName = x + XmlNode = xml}) let makeNode tag (doc:XmlDocument) = doc.CreateElement tag @@ -86,8 +89,7 @@ module ProjectFile = match files with | [] -> parent | x::xs -> - makeCompileNode x.ShortName doc - |> parent.AppendChild |> ignore + x.XmlNode |> parent.AppendChild |> ignore addCompileNodes xs parent doc let addNewItemGroup (sFiles:SourceFile list) (pf:ProjectFile) = diff --git a/src/Mechanic/SymbolGraph.fs b/src/Mechanic/SymbolGraph.fs index b6da5ca..66effd1 100644 --- a/src/Mechanic/SymbolGraph.fs +++ b/src/Mechanic/SymbolGraph.fs @@ -5,7 +5,7 @@ open Mechanic.Utils open Mechanic.GraphAlg let getDependencies files = - let depsData = files |> List.map SymbolGetter.getSymbols + let depsData = files |> List.map (fun (f: string) -> if f.EndsWith ".fs" then SymbolGetter.getSymbols f else f, [], []) let allDefsMap = depsData |> Seq.collect (fun (f,defs,_) -> defs |> List.map (fun d -> lastPart d, (d, f))) |> Seq.groupBy fst |> Seq.map (fun (k, xs) -> k, xs |> Seq.map snd |> Seq.toList) |> Map.ofSeq @@ -56,15 +56,17 @@ let getDependencies files = //printfn "%A" deps deps -let solveOrder files = +let solveOrder fileNameSelector xs = + let filesMap = xs |> Seq.map (fun x -> fileNameSelector x, x) |> Map.ofSeq + let files = xs |> List.map fileNameSelector let deps = getDependencies files let edges = deps |> List.map (fun (f1,f2,_) -> f1, f2) match GraphAlg.topologicalOrder files edges with | TopologicalOrderResult.Cycle xs -> printfn "Cycle with %A" (deps |> List.filter (fun (x,y,_) -> List.contains x xs && List.contains y xs)) - TopologicalOrderResult.Cycle xs - | x-> x + TopologicalOrderResult.Cycle (xs |> List.map (fun x -> filesMap.[x])) + | TopologicalOrderResult.TopologicalOrder xs -> TopologicalOrderResult.TopologicalOrder (xs |> List.map (fun x -> filesMap.[x])) let solveOrderFromPattern root filePattern = Directory.EnumerateFiles(root,filePattern) |> Seq.toList - |> solveOrder \ No newline at end of file + |> solveOrder id \ No newline at end of file