Merge pull request #67 from jindraivanek/project-load

Reordering project file

src/Mechanic.CommandLine/Program.fs

@@ -1,9 +1,24 @@
 open Mechanic
+open Mechanic.Files
+open Mechanic.GraphAlg
+open Mechanic.Utils
 
 [<EntryPoint>]
 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

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
 

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

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<string>
+        |> 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) =

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
+    |> solveOrder id