open System.Collections

open System.IO

open Microsoft.Build.Framework

open Microsoft.Build.Utilities

type FSharpEmbedResourceText() =

let mutable _buildEngine : IBuildEngine = null

let mutable _hostObject : ITaskHost = null

let mutable _embeddedText : ITaskItem[] = [||]

let mutable _generatedSource : ITaskItem[] = [||]

let mutable _generatedResx : ITaskItem[] = [||]

let mutable _outputPath : string = ""

let PrintErr(filename, line, msg) =

printfn "%s(%d): error : %s" filename line msg

let Err(filename, line, msg) =

PrintErr(filename, line, msg)

printfn "Note that the syntax of each line is one of these three alternatives:"

printfn "# comment"

printfn "ident,\"string\""

printfn "errNum,ident,\"string\""

failwith (sprintf "there were errors in the file '%s'" filename)

let xmlBoilerPlateString = @"<?xml version=""1.0"" encoding=""utf-8""?>

// The kinds of 'holes' we can do

let ComputeHoles filename lineNum (txt:string) : ResizeArray<string> * string =

// takes in a %d%s kind of string, returns array of string and {0}{1} kind of string

let mutable i = 0

let mutable holeNumber = 0

let mutable holes = ResizeArray() // order

let sb = new System.Text.StringBuilder()

let AddHole holeType =

sb.Append(sprintf "{%d}" holeNumber) |> ignore

holeNumber <- holeNumber + 1

holes.Add(holeType)

while i < txt.Length do

if txt.[i] = '%' then

if i+1 = txt.Length then

Err(filename, lineNum, "(at end of string) % must be followed by d, f, s, or %")

else

match txt.[i+1] with

| 'd' -> AddHole "System.Int32"

| 'f' -> AddHole "System.Double"

| 's' -> AddHole "System.String"

| '%' -> sb.Append('%') |> ignore

| c -> Err(filename, lineNum, sprintf "'%%%c' is not a valid sequence, only %%d %%f %%s or %%%%" c)

i <- i + 2

else

match txt.[i] with

| '{' -> sb.Append "{{" |> ignore

| '}' -> sb.Append "}}" |> ignore

| c -> sb.Append c |> ignore

i <- i + 1

//printfn "holes.Length = %d, lineNum = %d" holes.Length //lineNum txt

(holes, sb.ToString())

let Unquote (s : string) =

if s.StartsWith "\"" && s.EndsWith "\"" then s.Substring(1, s.Length - 2)

else failwith "error message string should be quoted"

let ParseLine filename lineNum (txt:string) =

let mutable errNum = None

let identB = new System.Text.StringBuilder()

let mutable i = 0

// parse optional error number

if i < txt.Length && System.Char.IsDigit txt.[i] then

let numB = new System.Text.StringBuilder()

while i < txt.Length && System.Char.IsDigit txt.[i] do

numB.Append txt.[i] |> ignore

i <- i + 1

errNum <- Some(int (numB.ToString()))

if i = txt.Length || txt.[i] <> ',' then

Err(filename, lineNum, sprintf "After the error number '%d' there should be a comma" errNum.Value)

// Skip the comma

i <- i + 1

// parse short identifier

if i < txt.Length && not(System.Char.IsLetter(txt.[i])) then

Err(filename, lineNum, sprintf "The first character in the short identifier should be a letter, but found '%c'" txt.[i])

while i < txt.Length && System.Char.IsLetterOrDigit txt.[i] do

identB.Append txt.[i] |> ignore

i <- i + 1

let ident = identB.ToString()

if ident.Length = 0 then

Err(filename, lineNum, "Did not find the short identifier")

else

if i = txt.Length || txt.[i] <> ',' then

Err(filename, lineNum, sprintf "After the identifier '%s' there should be a comma" ident)

else

// Skip the comma

i <- i + 1

if i = txt.Length then

Err(filename, lineNum, sprintf "After the identifier '%s' and comma, there should be the quoted string resource" ident)

else

let str =

try

System.String.Format(Unquote(txt.Substring i)) // Format turns e.g '\n' into that char, but also requires that we 'escape' curlies in the original .txt file, e.g. "{{"

with

e -> Err(filename, lineNum, sprintf "Error calling System.String.Format (note that curly braces must be escaped, and there cannot be trailing space on the line): >>>%s<<< -- %s" (txt.Substring i) e.Message)

let holes, netFormatString = ComputeHoles filename lineNum str

(lineNum, (errNum,ident), str, holes.ToArray(), netFormatString)

let stringBoilerPlatePrefix = @"

let StringBoilerPlate filename = @"

static let resources = lazy (new System.Resources.ResourceManager(""" + filename + @""", getCurrentAssembly()))

let generateResxAndSource (filename:string) =

try

let printMessage message = printfn "FSharpEmbedResourceText: %s" message

let justfilename = Path.GetFileNameWithoutExtension(filename) // .txt

if justfilename |> Seq.exists (System.Char.IsLetterOrDigit >> not) then

Err(filename, 0, sprintf "The filename '%s' is not allowed; only letters and digits can be used, as the filename also becomes the namespace for the SR class" justfilename)

let outFilename = Path.Combine(_outputPath, justfilename + ".fs")

let outXmlFilename = Path.Combine(_outputPath, justfilename + ".resx")

let condition1 = File.Exists(outFilename)

let condition2 = condition1 && File.Exists(outXmlFilename)

let condition3 = condition2 && File.Exists(filename)

let condition4 = condition3 && (File.GetLastWriteTimeUtc(filename) <= File.GetLastWriteTimeUtc(outFilename))

let condition5 = condition4 && (File.GetLastWriteTimeUtc(filename) <= File.GetLastWriteTimeUtc(outXmlFilename) )

if condition5 then

printMessage (sprintf "Skipping generation of %s and %s from %s since up-to-date" outFilename outXmlFilename filename)

Some (filename, outFilename, outXmlFilename)

else

printMessage (sprintf "Generating %s and %s from %s, because condition %d is false, see FSharpEmbedResourceText.fs in the F# source" outFilename outXmlFilename filename (if not condition1 then 1 elif not condition2 then 2 elif not condition3 then 3 elif not condition4 then 4 else 5) )

printMessage (sprintf "Reading %s" filename)

let lines = File.ReadAllLines(filename)

|> Array.mapi (fun i s -> i,s) // keep line numbers

|> Array.filter (fun (i,s) -> not(s.StartsWith "#")) // filter out comments

printMessage (sprintf "Parsing %s" filename)

let stringInfos = lines |> Array.map (fun (i,s) -> ParseLine filename i s)

// now we have array of (lineNum, ident, str, holes, netFormatString) // str has %d, netFormatString has {0}

printMessage (sprintf "Validating %s" filename)

// validate that all the idents are unique

let allIdents = new System.Collections.Generic.Dictionary<string,int>()

for (line,(_,ident),_,_,_) in stringInfos do

if allIdents.ContainsKey(ident) then

Err(filename,line,sprintf "Identifier '%s' is already used previously on line %d - each identifier must be unique" ident allIdents.[ident])

allIdents.Add(ident,line)

printMessage (sprintf "Validating uniqueness of %s" filename)

// validate that all the strings themselves are unique

let allStrs = new System.Collections.Generic.Dictionary<string,(int*string)>()

for (line,(_,ident),str,_,_) in stringInfos do

if allStrs.ContainsKey(str) then

let prevLine,prevIdent = allStrs.[str]

Err(filename,line,sprintf "String '%s' already appears on line %d with identifier '%s' - each string must be unique" str prevLine prevIdent)

allStrs.Add(str,(line,ident))

printMessage (sprintf "Generating %s" outFilename)

use outStream = File.Create outFilename

use out = new StreamWriter(outStream)

fprintfn out "// This is a generated file; the original input is '%s'" filename

fprintfn out "namespace %s" justfilename

fprintfn out "%s" stringBoilerPlatePrefix

fprintfn out "type internal SR private() ="

let theResourceName = justfilename

fprintfn out "%s" (StringBoilerPlate theResourceName)

printMessage (sprintf "Generating resource methods for %s" outFilename)

// gen each resource method

stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) ->

let formalArgs = new System.Text.StringBuilder()

let actualArgs = new System.Text.StringBuilder()

let firstTime = ref true

let n = ref 0

formalArgs.Append "(" |> ignore

for hole in holes do

if !firstTime then

firstTime := false

else

formalArgs.Append ", " |> ignore

actualArgs.Append " " |> ignore

formalArgs.Append(sprintf "a%d : %s" !n hole) |> ignore

actualArgs.Append(sprintf "a%d" !n) |> ignore

n := !n + 1

formalArgs.Append ")" |> ignore

fprintfn out " /// %s" str

fprintfn out " /// (Originally from %s:%d)" filename (lineNum+1)

let justPercentsFromFormatString =

(holes |> Array.fold (fun acc holeType ->

acc + match holeType with

| "System.Int32" -> ",,,%d"

| "System.Double" -> ",,,%f"

| "System.String" -> ",,,%s"

| _ -> failwith "unreachable") "") + ",,,"

let errPrefix = match optErrNum with

| None -> ""

| Some n -> sprintf "%d, " n

fprintfn out " static member %s%s = (%sGetStringFunc(\"%s\",\"%s\") %s)" ident (formalArgs.ToString()) errPrefix ident justPercentsFromFormatString (actualArgs.ToString())

)

printMessage (sprintf "Generating .resx for %s" outFilename)

fprintfn out ""

// gen validation method

fprintfn out " /// Call this method once to validate that all known resources are valid; throws if not"

fprintfn out " static member RunStartupValidation() ="

stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) ->

fprintfn out " ignore(GetString(\"%s\"))" ident

)

fprintfn out " ()" // in case there are 0 strings, we need the generated code to parse

// gen to resx

let xd = new System.Xml.XmlDocument()

xd.LoadXml(xmlBoilerPlateString)

stringInfos |> Seq.iter (fun (lineNum, (optErrNum,ident), str, holes, netFormatString) ->

let xn = xd.CreateElement("data")

xn.SetAttribute("name",ident) |> ignore

xn.SetAttribute("xml:space","preserve") |> ignore

let xnc = xd.CreateElement "value"

xn.AppendChild xnc |> ignore

xnc.AppendChild(xd.CreateTextNode netFormatString) |> ignore

xd.LastChild.AppendChild xn |> ignore

)

use outXmlStream = File.Create outXmlFilename

xd.Save outXmlStream

printMessage (sprintf "Done %s" outFilename)

Some (filename, outFilename, outXmlFilename)

with e ->

PrintErr(filename, 0, sprintf "An exception occurred when processing '%s'\n%s" filename (e.ToString()))

None

[<Required>]

member this.EmbeddedText

with get() = _embeddedText

and set(value) = _embeddedText <- value

[<Required>]

member this.IntermediateOutputPath

with get() = _outputPath

and set(value) = _outputPath <- value

[<Output>]

member this.GeneratedSource

with get() = _generatedSource

[<Output>]

member this.GeneratedResx

with get() = _generatedResx

interface ITask with

member this.BuildEngine

with get() = _buildEngine

and set(value) = _buildEngine <- value

member this.HostObject

with get() = _hostObject

and set(value) = _hostObject <- value

member this.Execute() =

let generatedFiles =

this.EmbeddedText

|> Array.choose (fun item -> generateResxAndSource item.ItemSpec)

let generatedSource, generatedResx =

[| for (textFile, source, resx) in generatedFiles do

let sourceItem =

let item = TaskItem(source)

item.SetMetadata("AutoGen", "true")

item.SetMetadata("DesignTime", "true")

item.SetMetadata("DependentUpon", resx)

item :> ITaskItem

let resxItem =

let item = TaskItem(resx)

item.SetMetadata("ManifestResourceName", Path.GetFileNameWithoutExtension(resx))

item.SetMetadata("SourceDocumentPath", textFile)

item :> ITaskItem

yield (sourceItem, resxItem) |]

|> Array.unzip

let generatedResult = (generatedFiles.Length = this.EmbeddedText.Length)

_generatedSource <- generatedSource

_generatedResx <- generatedResx

generatedResult