From 537c005c47fff436bd5f208775d4e72d0954b6c7 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Tue, 16 Jan 2018 08:07:15 +0100 Subject: [PATCH 1/8] Allow to load files fro project --- src/Mechanic.CommandLine/Program.fs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/Mechanic.CommandLine/Program.fs b/src/Mechanic.CommandLine/Program.fs index de90eb6..edb306d 100644 --- a/src/Mechanic.CommandLine/Program.fs +++ b/src/Mechanic.CommandLine/Program.fs @@ -1,9 +1,19 @@ open Mechanic +open Mechanic.Files [] let main argv = - let root = argv.[0] - let pattern = argv.[1] - SymbolGraph.solveOrderFromPattern root pattern - |> printfn "%A" + match argv.Length with + | 1 -> + ProjectFile.loadFromFile argv.[0] + |> ProjectFile.getSourceFiles + |> List.map (fun f -> f.FullName) + |> List.filter (fun x -> x.EndsWith ".fs") + |> SymbolGraph.solveOrder + |> printfn "%A" + | 2 -> + let root = argv.[0] + let pattern = argv.[1] + SymbolGraph.solveOrderFromPattern root pattern + |> printfn "%A" 0 From db4f21799d9dddb2aa99b74f0b43721e0da57b30 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Tue, 16 Jan 2018 08:08:46 +0100 Subject: [PATCH 2/8] Fix fullpath in project files --- src/Mechanic.Tests/Files.fs | 9 +++++++++ src/Mechanic/Files.fs | 3 ++- 2 files changed, 11 insertions(+), 1 deletion(-) 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..c3114e5 100644 --- a/src/Mechanic/Files.fs +++ b/src/Mechanic/Files.fs @@ -68,9 +68,10 @@ module ProjectFile = |> List.ofSeq let getSourceFiles (pf:ProjectFile) = + let projectDir = FileInfo(pf.FileName).Directory.FullName parseSourceFileNames pf.ProjectNode |> List.map (fun x -> - let fi = FileInfo x + let fi = FileInfo (Path.Combine(projectDir, x)) { FullName = fi.FullName ShortName = x }) From bcd2ea17fa49dddecbd161a9d5ceb400fc0bdeae Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Mon, 29 Jan 2018 14:44:10 +0100 Subject: [PATCH 3/8] Non .fs files part of deps --- src/Mechanic.CommandLine/Program.fs | 1 - src/Mechanic/SymbolGraph.fs | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Mechanic.CommandLine/Program.fs b/src/Mechanic.CommandLine/Program.fs index edb306d..ec7af3e 100644 --- a/src/Mechanic.CommandLine/Program.fs +++ b/src/Mechanic.CommandLine/Program.fs @@ -8,7 +8,6 @@ let main argv = ProjectFile.loadFromFile argv.[0] |> ProjectFile.getSourceFiles |> List.map (fun f -> f.FullName) - |> List.filter (fun x -> x.EndsWith ".fs") |> SymbolGraph.solveOrder |> printfn "%A" | 2 -> diff --git a/src/Mechanic/SymbolGraph.fs b/src/Mechanic/SymbolGraph.fs index 8e189f4..084fcdf 100644 --- a/src/Mechanic/SymbolGraph.fs +++ b/src/Mechanic/SymbolGraph.fs @@ -3,7 +3,7 @@ open System.IO open Utils.Namespace 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 From c49aa76da621215c1823f1fe690d42e6f8ef9c00 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Mon, 29 Jan 2018 14:46:25 +0100 Subject: [PATCH 4/8] merge fix --- src/Mechanic/SymbolGraph.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Mechanic/SymbolGraph.fs b/src/Mechanic/SymbolGraph.fs index d076a9a..bb7e4ba 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 (fun (f: string) -> if f.EndsWith ".fs" then SymbolGetter.getSymbols f else f, [], [], []) + 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 From f98d21522da138a78035e82ceec0edfeb23fe5e7 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Mon, 29 Jan 2018 17:31:10 +0100 Subject: [PATCH 5/8] Allow to sort any type (with filename inside); reordering files in project using xml node --- src/Mechanic.CommandLine/Program.fs | 14 ++++++++++---- src/Mechanic.Tests/FileOrderTests.fs | 4 ++-- src/Mechanic/Files.fs | 16 +++++++++------- src/Mechanic/SymbolGraph.fs | 10 ++++++---- 4 files changed, 27 insertions(+), 17 deletions(-) diff --git a/src/Mechanic.CommandLine/Program.fs b/src/Mechanic.CommandLine/Program.fs index ec7af3e..dcf26e3 100644 --- a/src/Mechanic.CommandLine/Program.fs +++ b/src/Mechanic.CommandLine/Program.fs @@ -1,14 +1,20 @@ open Mechanic open Mechanic.Files +open Mechanic.GraphAlg +open Mechanic.Utils [] let main argv = match argv.Length with | 1 -> - ProjectFile.loadFromFile argv.[0] - |> ProjectFile.getSourceFiles - |> List.map (fun f -> f.FullName) - |> SymbolGraph.solveOrder + 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 + |x -> x |> printfn "%A" | 2 -> let root = argv.[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/Files.fs b/src/Mechanic/Files.fs index c3114e5..081d147 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 + Xml : XmlNode } @@ -63,17 +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 -> + |> List.map (fun (xml,x) -> let fi = FileInfo (Path.Combine(projectDir, x)) { FullName = fi.FullName - ShortName = x }) + ShortName = x + Xml = xml}) let makeNode tag (doc:XmlDocument) = doc.CreateElement tag @@ -87,8 +89,8 @@ module ProjectFile = match files with | [] -> parent | x::xs -> - makeCompileNode x.ShortName doc - |> parent.AppendChild |> ignore + //makeCompileNode x.ShortName doc + x.Xml |> 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 bb7e4ba..66effd1 100644 --- a/src/Mechanic/SymbolGraph.fs +++ b/src/Mechanic/SymbolGraph.fs @@ -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 From 278afaaa20b8f42fd9aba33690d72b6c4b364ebe Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Tue, 30 Jan 2018 09:43:07 +0100 Subject: [PATCH 6/8] SourceFile.Xml renamed to XmlNode --- src/Mechanic/Files.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Mechanic/Files.fs b/src/Mechanic/Files.fs index 081d147..8d533ce 100644 --- a/src/Mechanic/Files.fs +++ b/src/Mechanic/Files.fs @@ -13,7 +13,7 @@ type ProjectFile = { type SourceFile = { FullName : string ShortName : string - Xml : XmlNode + XmlNode : XmlNode } @@ -75,7 +75,7 @@ module ProjectFile = let fi = FileInfo (Path.Combine(projectDir, x)) { FullName = fi.FullName ShortName = x - Xml = xml}) + XmlNode = xml}) let makeNode tag (doc:XmlDocument) = doc.CreateElement tag @@ -90,7 +90,7 @@ module ProjectFile = | [] -> parent | x::xs -> //makeCompileNode x.ShortName doc - x.Xml |> parent.AppendChild |> ignore + x.XmlNode |> parent.AppendChild |> ignore addCompileNodes xs parent doc let addNewItemGroup (sFiles:SourceFile list) (pf:ProjectFile) = From e515b2ced11e9853e561f505d45776f9c6b29ed3 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Tue, 30 Jan 2018 09:48:35 +0100 Subject: [PATCH 7/8] Remove commented line --- src/Mechanic/Files.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Mechanic/Files.fs b/src/Mechanic/Files.fs index 8d533ce..221a940 100644 --- a/src/Mechanic/Files.fs +++ b/src/Mechanic/Files.fs @@ -89,7 +89,6 @@ module ProjectFile = match files with | [] -> parent | x::xs -> - //makeCompileNode x.ShortName doc x.XmlNode |> parent.AppendChild |> ignore addCompileNodes xs parent doc From c43ecf8a213ae47fd0fa756985d799fcc0559115 Mon Sep 17 00:00:00 2001 From: jindraivanek Date: Tue, 30 Jan 2018 10:08:49 +0100 Subject: [PATCH 8/8] Output only file paths --- src/Mechanic.CommandLine/Program.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Mechanic.CommandLine/Program.fs b/src/Mechanic.CommandLine/Program.fs index dcf26e3..5d6fb56 100644 --- a/src/Mechanic.CommandLine/Program.fs +++ b/src/Mechanic.CommandLine/Program.fs @@ -11,10 +11,10 @@ let main argv = p |> ProjectFile.getSourceFiles |> SymbolGraph.solveOrder (fun f -> f.FullName) |> function - |TopologicalOrderResult.TopologicalOrder xs -> + | TopologicalOrderResult.TopologicalOrder xs -> xs |> fun x -> ProjectFile.updateProjectFile x p - TopologicalOrderResult.TopologicalOrder xs - |x -> x + 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]