Skip to content
This repository has been archived by the owner on Sep 26, 2020. It is now read-only.

Commit

Permalink
revamp solution asts and parsers
Browse files Browse the repository at this point in the history
  • Loading branch information
@cloudRoutine
cloudRoutine committed Mar 8, 2016
1 parent 1a57639 commit 4d1c4c6
Show file tree
Hide file tree
Showing 8 changed files with 285 additions and 503 deletions.
3 changes: 3 additions & 0 deletions Reference.md
View file
@@ -1,3 +1,6 @@
## Solution File Reference

[The differences between Solution build configurations and Project build configurations](http://jimmyscorner.com/archives/51/the-differences-between-solution-build-configurations-and-project-build-configurations)


## Visual Studio ProjectType GUIDs
Expand Down
3 changes: 2 additions & 1 deletion src/Forge.Core/Forge.Core.fsproj
View file
Expand Up @@ -76,14 +76,15 @@
<Compile Include="GacSearch.fs" />
<Compile Include="Constants.fs" />
<Compile Include="ProjectValidation.fs" />
<Compile Include="SolutionFile.fs" />
<Compile Include="SolutionSystem.fs" />
<Compile Include="ProjectSystem.fs" />
<Compile Include="ProjectManager.fs" />
<Compile Include="Templates.fs" />
<Compile Include="Project.fs" />
<EmbeddedResource Include="XmlSchemas\Microsoft.Build.Commontypes.xsd" />
<EmbeddedResource Include="XmlSchemas\Microsoft.Build.Core.xsd" />
<EmbeddedResource Include="XmlSchemas\Microsoft.Build.xsd" />
<None Include="Scratch\furnace.fsx" />
</ItemGroup>
<ItemGroup>
<Reference Include="FSharp.Core, Version=4.4.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a">
Expand Down
169 changes: 2 additions & 167 deletions src/Forge.Core/ProjectSystem.fs
View file
Expand Up @@ -20,6 +20,8 @@ open System.IO
open System.Collections.Generic
open System.Xml
open System.Xml.Linq
open Forge
open Forge.SolutionSystem

(* Project System AST
==================
Expand Down Expand Up @@ -59,33 +61,9 @@ open System.Xml.Linq
*)


let (|InvariantEqual|_|) (str:string) arg =
if String.Compare(str, arg, StringComparison.OrdinalIgnoreCase) = 0
then Some () else None

/// Sets the platform for a Build Configuration
/// x86, x64, or AnyCPU.
/// The default is AnyCPU.
type PlatformType =
| X86 | X64 | AnyCPU

override self.ToString () = self |> function
| X86 -> Constants.X86
| X64 -> Constants.X64
| AnyCPU -> Constants.AnyCPU

static member Parse text = text |> function
| InvariantEqual Constants.X86 -> X86
| InvariantEqual Constants.X64 -> X64
| InvariantEqual Constants.AnyCPU -> AnyCPU
| _ ->
failwithf "Could not parse '%s' into a `PlatformType`" text

static member TryParse text = text |> function
| InvariantEqual Constants.X86 -> Some X86
| InvariantEqual Constants.X64 -> Some X64
| InvariantEqual Constants.AnyCPU -> Some AnyCPU
| _ -> None


[<RequireQualifiedAccess>]
Expand Down Expand Up @@ -1110,149 +1088,6 @@ module FsProject =
| ex -> traceException ex




// A small abstraction over MSBuild project files.
type ProjectFile (projectFileName:string, documentContent:string) =
let document = XMLDoc documentContent

let nsmgr =
let nsmgr = XmlNamespaceManager document.NameTable
nsmgr.AddNamespace("default", document.DocumentElement.NamespaceURI)
nsmgr

let compileNodesXPath = "/default:Project/default:ItemGroup/default:Compile"

let projectFilesXPath = "/default:Project/default:ItemGroup/default:Compile|" +
"/default:Project/default:ItemGroup/default:Content|" +
"/default:Project/default:ItemGroup/default:None"

let referenceFilesXPath = "/default:Project/default:ItemGroup/default:Reference"

let nodeListToList (nodeList:XmlNodeList) = [for node in nodeList -> node]
let getNodes xpath (document:XmlDocument) = document.SelectNodes(xpath, nsmgr) |> nodeListToList
let getFileAttribute (node:XmlNode) = node.Attributes.["Include"].InnerText

let newElement (document:XmlDocument) name = document.CreateElement(name, document.DocumentElement.NamespaceURI)

let addFile fileName nodeType xPath =
let document = XMLDoc documentContent // we create a copy and work immutable

let newNode = newElement document nodeType
newNode.SetAttribute("Include", fileName)

//get the first ItemGroup node
let itemGroup = getNodes xPath document |> List.map(fun x -> x.ParentNode) |> List.distinct |> List.tryHead

match itemGroup with
| Some n -> n.AppendChild(newNode) |> ignore
| None ->
let groupNode = newElement document "ItemGroup"
groupNode.AppendChild newNode |> ignore
let project = getNodes "/default:Project" document |> Seq.head
project.AppendChild groupNode |> ignore

new ProjectFile(projectFileName,document.OuterXml)

let getNode document xPath fileName =
getNodes xPath document
|> List.filter (fun node -> getFileAttribute node = fileName)
|> Seq.tryLast

let removeFile fileName xPath =
let document = XMLDoc documentContent // we create a copy and work immutable
let node = getNode document xPath fileName

match node with
| Some n -> n.ParentNode.RemoveChild n |> ignore
| None -> ()

new ProjectFile(projectFileName,document.OuterXml)

let orderFiles fileName1 fileName2 xPath =
let document = XMLDoc documentContent // we create a copy and work immutable
match getNode document xPath fileName1 with
| Some n1 ->
let updated = removeFile fileName1 xPath
let updatedXml = XMLDoc updated.Content
match getNode updatedXml xPath fileName2 with
| Some n2 ->
let node = newElement updatedXml n1.Name
node.SetAttribute("Include", fileName1)
n2.ParentNode.InsertBefore(node, n2) |> ignore

new ProjectFile(projectFileName, updatedXml.OuterXml)

| None -> new ProjectFile(projectFileName,document.OuterXml)
| _ -> new ProjectFile(projectFileName,document.OuterXml)

/// Read a Project from a FileName
static member FromFile(projectFileName) = new ProjectFile(projectFileName,String.readFileAsString projectFileName)

/// Saves the project file
member x.Save(?fileName) =
use writer = new System.IO.StreamWriter(defaultArg fileName projectFileName,
false,
new System.Text.UTF8Encoding(false))
document.Save(writer)

member x.Content =
let utf8 = System.Text.UTF8Encoding false
let settings = XmlWriterSettings()
settings.Encoding <- utf8
settings.Indent <- true
use ms = new System.IO.MemoryStream()
use writer = System.Xml.XmlWriter.Create(ms, settings)
document.Save(writer)
ms.GetBuffer() |> utf8.GetString



/// Add a file to the ItemGroup node with node type
member x.AddFile fileName nodeType =
addFile fileName nodeType projectFilesXPath

/// Removes a file from the ItemGroup node with optional node type
member x.RemoveFile fileName =
removeFile fileName projectFilesXPath

member x.AddReference reference =
addFile reference "Reference" referenceFilesXPath

member x.RemoveReference reference =
removeFile reference referenceFilesXPath

/// All files which are in "Compile" sections
member x.Files = getNodes compileNodesXPath document |> List.map getFileAttribute


member x.ProjectFiles = getNodes projectFilesXPath document |> List.map getFileAttribute

member x.References = getNodes referenceFilesXPath document |> List.map getFileAttribute

/// Finds duplicate files which are in "Compile" sections
member this.FindDuplicateFiles() =
[let dict = Dictionary()
for file in this.Files do
match dict.TryGetValue file with
| false,_ -> dict.[file] <- false // first observance
| true,false -> dict.[file] <- true; yield file // second observance
| true,true -> () // already seen at least twice
]

member x.RemoveDuplicates() =
x.FindDuplicateFiles()
|> List.fold (fun (project:ProjectFile) duplicate -> project.RemoveFile duplicate) x

/// Places the first file above the second file
member x.OrderFiles file1 file2 =
orderFiles file1 file2 projectFilesXPath


/// The project file name
member x.ProjectFileName = projectFileName


#if INTERACTIVE
;;
let projfile = __SOURCE_DIRECTORY__ + "/../Forge/Forge.fsproj"
Expand Down

0 comments on commit 4d1c4c6

Please sign in to comment.