Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
44 changes: 22 additions & 22 deletions src/FSharp.Build/FSharpEmbedResXSource.fs
Original file line number Diff line number Diff line change
Expand Up @@ -10,14 +10,20 @@ open System.Xml.Linq
open Microsoft.Build.Framework
open Microsoft.Build.Utilities

type FSharpEmbedResXSource() =
let mutable _buildEngine: IBuildEngine MaybeNull = null
let mutable _hostObject: ITaskHost MaybeNull = null
type FSharpEmbedResXSource() as this =
inherit Task()
let mutable _embeddedText: ITaskItem[] = [||]
let mutable _generatedSource: ITaskItem[] = [||]
let mutable _outputPath: string = ""
let mutable _targetFramework: string = ""

let failTask fmt =
Printf.ksprintf
(fun msg ->
this.Log.LogError msg
raise TaskFailed)
fmt

let boilerplate =
@"// <auto-generated>

Expand All @@ -36,7 +42,7 @@ module internal {1} =

let generateSource (resx: string) (fullModuleName: string) (generateLegacy: bool) (generateLiteral: bool) =
try
let printMessage = printfn "FSharpEmbedResXSource: %s"
let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt
let justFileName = Path.GetFileNameWithoutExtension(resx)
let sourcePath = Path.Combine(_outputPath, justFileName + ".fs")

Expand All @@ -46,7 +52,7 @@ module internal {1} =
&& File.Exists(sourcePath)
&& File.GetLastWriteTimeUtc(resx) <= File.GetLastWriteTimeUtc(sourcePath)
then
printMessage (sprintf "Skipping generation: '%s' since it is up-to-date." sourcePath)
printMessage "Skipping generation: '%s' since it is up-to-date." sourcePath
Some(sourcePath)
else
let namespaceName, moduleName =
Expand All @@ -63,7 +69,7 @@ module internal {1} =
|| _targetFramework.StartsWith("netcoreapp1.")
)

printMessage (sprintf "Generating code for target framework %s" _targetFramework)
printMessage "Generating code for target framework %s" _targetFramework

let sb =
StringBuilder()
Expand All @@ -72,7 +78,7 @@ module internal {1} =
if generateGetObject then
sb.AppendLine(boilerplateGetObject) |> ignore

printMessage <| sprintf "Generating: %s" sourcePath
printMessage "Generating: %s" sourcePath

let body =
let xname = XName.op_Implicit
Expand All @@ -82,12 +88,12 @@ module internal {1} =
(fun (sb: StringBuilder) (node: XElement) ->
let name =
match node.Attribute(xname "name") with
| null -> failwith (sprintf "Missing resource name on element '%s'" (node.ToString()))
| null -> failTask "Missing resource name on element '%O'" node
| attr -> attr.Value

let docComment =
match node.Elements(xname "value").FirstOrDefault() with
| null -> failwith <| sprintf "Missing resource value for '%s'" name
| null -> failTask "Missing resource value for '%s'" name
| element -> element.Value.Trim()

let identifier =
Expand Down Expand Up @@ -118,7 +124,7 @@ module internal {1} =
sb

File.WriteAllText(sourcePath, body.ToString())
printMessage <| sprintf "Done: %s" sourcePath
printMessage "Done: %s" sourcePath
Some(sourcePath)
with e ->
printf "An exception occurred when processing '%s'\n%s" resx (e.ToString())
Expand All @@ -141,24 +147,16 @@ module internal {1} =
[<Output>]
member _.GeneratedSource = _generatedSource

interface ITask with
member _.BuildEngine
with get () = _buildEngine
and set (value) = _buildEngine <- value

member _.HostObject
with get () = _hostObject
and set (value) = _hostObject <- value

member this.Execute() =
override this.Execute() =
try
let getBooleanMetadata (metadataName: string) (defaultValue: bool) (item: ITaskItem) =
match item.GetMetadata(metadataName) with
| value when String.IsNullOrWhiteSpace(value) -> defaultValue
| value ->
match value.ToLowerInvariant() with
| "true" -> true
| "false" -> false
| _ -> failwith (sprintf "Expected boolean value for '%s' found '%s'" metadataName value)
| _ -> failTask "Expected boolean value for '%s' found '%s'" metadataName value

let mutable success = true

Expand All @@ -181,4 +179,6 @@ module internal {1} =
|]

_generatedSource <- generatedSource
success
success && not this.Log.HasLoggedErrors
with TaskFailed ->
false
89 changes: 44 additions & 45 deletions src/FSharp.Build/FSharpEmbedResourceText.fs
Original file line number Diff line number Diff line change
Expand Up @@ -6,24 +6,32 @@ open System.IO
open Microsoft.Build.Framework
open Microsoft.Build.Utilities

type FSharpEmbedResourceText() =
let mutable _buildEngine: IBuildEngine MaybeNull = null
let mutable _hostObject: ITaskHost MaybeNull = null
/// A special exception that when thrown signifies that
/// the task should end with failure. It is assumed that
/// the task has already emitted the error message.
exception TaskFailed

type FSharpEmbedResourceText() as this =
inherit Task()
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
this.Log.LogError(null, null, null, fileName, line, 0, 0, 0, msg, Array.empty)

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 hint =
"Note that the syntax of each line is one of these three alternatives:
# comment
ident,\"string\"
errNum,ident,\"string\""

this.Log.LogMessage(MessageImportance.High, hint)
raise TaskFailed

let xmlBoilerPlateString =
@"<?xml version=""1.0"" encoding=""utf-8""?>
Expand Down Expand Up @@ -192,7 +200,7 @@ type FSharpEmbedResourceText() =
if s.StartsWith "\"" && s.EndsWith "\"" then
s.Substring(1, s.Length - 2)
else
failwith "error message string should be quoted"
Err(null, 0, "error message string should be quoted")

let ParseLine fileName lineNum (txt: string) =
let mutable errNum = None
Expand Down Expand Up @@ -361,8 +369,7 @@ open Printf

let generateResxAndSource (fileName: string) =
try
let printMessage message =
printfn "FSharpEmbedResourceText: %s" message
let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt

let justFileName = Path.GetFileNameWithoutExtension(fileName) // .txt

Expand Down Expand Up @@ -391,35 +398,33 @@ open Printf
&& (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)
printMessage "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)
printMessage
"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 "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)
printMessage "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)
printMessage "Validating %s" fileName
// validate that all the idents are unique
let allIdents = new System.Collections.Generic.Dictionary<string, int>()

Expand All @@ -436,7 +441,7 @@ open Printf

allIdents.Add(ident, line)

printMessage (sprintf "Validating uniqueness of %s" fileName)
printMessage "Validating uniqueness of %s" fileName
// validate that all the strings themselves are unique
let allStrs = new System.Collections.Generic.Dictionary<string, (int * string)>()

Expand All @@ -456,7 +461,7 @@ open Printf

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

printMessage (sprintf "Generating %s" outFileName)
printMessage "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
Expand All @@ -466,7 +471,7 @@ open Printf
let theResourceName = justFileName
fprintfn out "%s" (StringBoilerPlate theResourceName)

printMessage (sprintf "Generating resource methods for %s" outFileName)
printMessage "Generating resource methods for %s" outFileName
// gen each resource method
stringInfos
|> Seq.iter (fun (lineNum, (optErrNum, ident), str, holes, netFormatString) ->
Expand Down Expand Up @@ -520,7 +525,7 @@ open Printf
justPercentsFromFormatString
(actualArgs.ToString()))

printMessage (sprintf "Generating .resx for %s" outFileName)
printMessage "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"
Expand Down Expand Up @@ -548,7 +553,7 @@ open Printf

use outXmlStream = File.Create outXmlFileName
xd.Save outXmlStream
printMessage (sprintf "Done %s" outFileName)
printMessage "Done %s" outFileName
Some(fileName, outFileName, outXmlFileName)
with e ->
PrintErr(fileName, 0, sprintf "An exception occurred when processing '%s'\n%s" fileName (e.ToString()))
Expand All @@ -570,17 +575,9 @@ open Printf
[<Output>]
member _.GeneratedResx = _generatedResx

interface ITask with
member _.BuildEngine
with get () = _buildEngine
and set (value) = _buildEngine <- value

member _.HostObject
with get () = _hostObject
and set (value) = _hostObject <- value

member this.Execute() =
override this.Execute() =

try
let generatedFiles =
this.EmbeddedText
|> Array.choose (fun item -> generateResxAndSource item.ItemSpec)
Expand Down Expand Up @@ -609,4 +606,6 @@ open Printf

_generatedSource <- generatedSource
_generatedResx <- generatedResx
generatedResult
generatedResult && not this.Log.HasLoggedErrors
with TaskFailed ->
false
Loading