File Utilities

src/Mechanic/Files.fs

@@ -0,0 +1,106 @@
+namespace Mechanic.Files
+
+open System.IO
+open System.Xml
+
+
+type ProjectFile = {
+    FileName    : string
+    ProjectNode : XmlNode
+    Document    : XmlDocument
+}
+
+type SourceFile = {
+    FullName : string
+    ShortName : string 
+}
+
+
+module ProjectFile =
+
+    open Mechanic.Xml
+
+    let [<Literal>] ProjectTag       = "Project"
+    let [<Literal>] ItemGroupTag     = "ItemGroup"
+    let [<Literal>] CompileTag       = "Compile"
+    let [<Literal>] IncludeAttribute = "Include"
+    let [<Literal>] XmlSchema        = "http://schemas.microsoft.com/developer/msbuild/2003"
+
+
+    let loadFromStream fileName (stream:Stream) =
+        let doc = XmlDocument()
+        doc.Load stream
+        let ns = XmlNamespaceManager(doc.NameTable)
+        ns.AddNamespace("ns", XmlSchema)
+        getNode ProjectTag doc
+        |> function
+           | Some n ->
+             { FileName = fileName; ProjectNode = n; Document = doc}
+           | _ -> failwith "Could not locate project node in project file"
+
+    let loadFromFile fileName =
+        let fi = FileInfo fileName
+        use stream = fi.OpenRead()
+        loadFromStream fi.FullName stream
+
+    let tryLoad fileName =
+        try
+            let fi = FileInfo fileName
+            match fi.Extension with
+            | ".fsproj" -> loadFromFile fi.FullName |> Some
+            | _ -> None
+        with
+        | exn -> None
+
+    let save (pf:ProjectFile) =
+        use f = File.Open(pf.FileName, FileMode.Create)
+        use sw = new StreamWriter(f)
+        pf.Document.Save sw
+
+    let getCompileGroup (node:XmlNode) =
+        getDescendants ItemGroupTag node
+        |> Seq.tryFind (hasChildNodes CompileTag)
+
+    let parseSourceFileNames (node:XmlNode) =
+        getCompileGroup node
+        |> Option.map (getChildNodes >> (Seq.choose (getAttribute IncludeAttribute)))
+        |> Option.defaultValue Seq.empty<string>
+        |> List.ofSeq
+
+    let getSourceFiles (pf:ProjectFile) =
+        parseSourceFileNames pf.ProjectNode
+        |> List.map (fun x ->
+            let fi = FileInfo x
+            { FullName  = fi.FullName
+              ShortName = x })
+
+    let makeNode tag (doc:XmlDocument) =
+        doc.CreateElement tag
+
+    let makeCompileNode fileName (doc:XmlDocument) =
+        let node = makeNode CompileTag doc
+        addAttribute IncludeAttribute fileName node
+
+    let updateProjectFile (sFiles:SourceFile list) (pf:ProjectFile) =
+        let rec addCompileNodes files (parent:XmlNode) (doc:XmlDocument) =
+            match files with
+            | [] -> parent
+            | x::xs ->
+                makeCompileNode x.ShortName doc
+                |> parent.AppendChild |> ignore
+                addCompileNodes xs parent doc
+
+        let addNewItemGroup (sFiles:SourceFile list) (pf:ProjectFile) =
+            let parent = makeNode ItemGroupTag pf.Document
+            addCompileNodes sFiles parent pf.Document
+            |> pf.ProjectNode.AppendChild
+
+        let cg = getCompileGroup pf.ProjectNode
+        match cg with
+        | Some x ->
+            pf.ProjectNode.RemoveChild x |> ignore
+            addNewItemGroup sFiles pf |> ignore
+        | None -> 
+            addNewItemGroup sFiles pf |> ignore
+
+        save pf

src/Mechanic/Mechanic.fsproj

@@ -5,6 +5,8 @@
     <PackageVersion>0.0.0</PackageVersion>
   </PropertyGroup>
   <ItemGroup>
+    <Compile Include="Xml.fs" />  
+    <Compile Include="Files.fs" />
     <Compile Include="Library.fs" />
   </ItemGroup>
   <Import Project="..\.paket\Paket.Restore.targets" />

src/Mechanic/Xml.fs

@@ -0,0 +1,80 @@
+// The MIT License (MIT)
+
+// Copyright (c) 2015 Alexander Groß, Steffen Forkmann
+
+// Permission is hereby granted, free of charge, to any person obtaining a copy
+// of this software and associated documentation files (the "Software"), to deal
+// in the Software without restriction, including without limitation the rights
+// to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+// copies of the Software, and to permit persons to whom the Software is
+// furnished to do so, subject to the following conditions:
+
+// The above copyright notice and this permission notice shall be included in
+// all copies or substantial portions of the Software.
+
+// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+// IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+// FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+// AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+// LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+// OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+// THE SOFTWARE.
+//
+// This file is a subset of the Xml.fs file from the Paket project:
+//     https://github.com/fsprojects/Paket
+
+module Mechanic.Xml
+
+open System.Xml
+
+
+let inline addAttribute name value (node:XmlElement) =
+    node.SetAttribute(name, value) |> ignore
+    node
+
+let inline addChild child (node:XmlElement) =
+    node.AppendChild(child) |> ignore
+    node
+
+let inline hasAttribute name (node:XmlNode) =
+    if isNull node || isNull node.Attributes then false else
+        node.Attributes
+        |> Seq.cast<XmlAttribute>
+        |> Seq.exists (fun x -> x.Name = name)
+
+let inline getAttribute name (node:XmlNode) =
+    if isNull node || isNull node.Attributes then None else
+    node.Attributes 
+    |> Seq.cast<XmlAttribute> 
+    |> Seq.tryFind (fun a -> a.Name = name && (isNull a.Value |> not)) 
+    |> Option.map (fun a -> a.Value)
+
+let inline getNode name (node:XmlNode) =
+    let xpath = sprintf "*[local-name() = '%s']" name
+    match node.SelectSingleNode(xpath) with
+    | null -> None
+    | n -> Some(n)
+
+let inline getNodes name (node:XmlNode) =
+    let xpath = sprintf "*[local-name() = '%s']" name
+    match node.SelectNodes(xpath) with
+    | null -> []
+    | nodeList -> 
+        nodeList
+        |> Seq.cast<XmlNode>
+        |> Seq.toList
+
+let inline getDescendants name (node:XmlNode) = 
+    let xpath = sprintf ".//*[local-name() = '%s']" name
+    match node.SelectNodes(xpath) with
+    | null -> []
+    | nodeList -> 
+        nodeList
+        |> Seq.cast<XmlNode>
+        |> Seq.toList
+
+let inline getChildNodes (node:XmlNode) = System.Linq.Enumerable.Cast<XmlNode>(node)
+
+let inline hasChildNodes name (node:XmlNode) =
+    getChildNodes node
+    |> Seq.exists (fun x -> x.Name = name)