Skip to content

Commit 17b8cf1

Browse files
vbfoxvbfox
committed
Make the configuration parser report errors
1 parent 7e7f947 commit 17b8cf1

File tree

8 files changed

+285
-93
lines changed

8 files changed

+285
-93
lines changed

‎paket.dependencies

+1
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ source https://nuget.org/api/v2
33
// Code
44
nuget FSharp.Core
55
nuget Microsoft.CodeAnalysis prerelease
6+
nuget ExtCore
67

78
// Unit tests
89
nuget NUnit

‎paket.lock

+1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
NUGET
22
remote: https://nuget.org/api/v2
33
specs:
4+
ExtCore (0.8.45)
45
FAKE (3.31.2)
56
FSharp.Core (3.1.2.1)
67
FsUnit (1.3.0.1)

‎src/BlackFox.Stidgen/BlackFox.Stidgen.fsproj

+21
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@
6565
<Compile Include="CsharpGeneration.fs" />
6666
<Compile Include="FileGeneration.fs" />
6767
<Compile Include="Program.fs" />
68+
<None Include="paket.references" />
6869
</ItemGroup>
6970
<ItemGroup>
7071
<Reference Include="mscorlib" />
@@ -79,6 +80,26 @@
7980
<Target Name="AfterBuild">
8081
</Target>
8182
-->
83+
<Choose>
84+
<When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And ($(TargetFrameworkVersion) == 'v4.0')">
85+
<ItemGroup>
86+
<Reference Include="ExtCore">
87+
<HintPath>..\..\packages\ExtCore\lib\net40\ExtCore.dll</HintPath>
88+
<Private>True</Private>
89+
<Paket>True</Paket>
90+
</Reference>
91+
</ItemGroup>
92+
</When>
93+
<When Condition="($(TargetFrameworkIdentifier) == '.NETFramework' And ($(TargetFrameworkVersion) == 'v4.5' Or $(TargetFrameworkVersion) == 'v4.5.1' Or $(TargetFrameworkVersion) == 'v4.5.2' Or $(TargetFrameworkVersion) == 'v4.5.3' Or $(TargetFrameworkVersion) == 'v4.6')) Or ($(TargetFrameworkIdentifier) == 'MonoAndroid') Or ($(TargetFrameworkIdentifier) == 'MonoTouch')">
94+
<ItemGroup>
95+
<Reference Include="ExtCore">
96+
<HintPath>..\..\packages\ExtCore\lib\net45\ExtCore.dll</HintPath>
97+
<Private>True</Private>
98+
<Paket>True</Paket>
99+
</Reference>
100+
</ItemGroup>
101+
</When>
102+
</Choose>
82103
<Choose>
83104
<When Condition="$(TargetFrameworkIdentifier) == '.NETFramework' And ($(TargetFrameworkVersion) == 'v4.0' Or $(TargetFrameworkVersion) == 'v4.5' Or $(TargetFrameworkVersion) == 'v4.5.1' Or $(TargetFrameworkVersion) == 'v4.5.2' Or $(TargetFrameworkVersion) == 'v4.5.3' Or $(TargetFrameworkVersion) == 'v4.6')">
84105
<ItemGroup>

‎src/BlackFox.Stidgen/ConfigurationParser.fs

+160-88
Original file line numberDiff line numberDiff line change
@@ -1,66 +1,95 @@
11
module BlackFox.Stidgen.ConfigurationParser
22

33
open BlackFox.Stidgen.Description
4+
open ExtCore.Control
45

56
type LineContent =
67
| TypeDefinition of visibility:string * namespace':string * name:string * underlyingType:string
78
| Property of name:string * value:string
89

910
type Line =
1011
{
12+
Number : int
1113
Text : string
14+
}
15+
override x.ToString () = sprintf "%i: %s" x.Number x.Text
16+
17+
type ParsedLine =
18+
{
19+
Line : Line
1220
Content : LineContent
1321
}
22+
override x.ToString () = x.Line.ToString()
23+
24+
type ErrorText = string
25+
type ParseError =
26+
{
27+
Line : Line
28+
ErrorText : ErrorText
29+
IsInvalidType : bool
30+
}
31+
static member fromString text line = { Line = line; ErrorText = text; IsInvalidType = false }
32+
override x.ToString () = sprintf "Error line %i: %s" x.Line.Number x.ErrorText
1433

1534
module private TextParser =
1635
let isEmpty (line: string) = System.String.IsNullOrWhiteSpace line
1736
let isComment (line: string) = line.Trim().StartsWith("//")
1837

19-
let filterOut cond = Seq.filter (fun x -> not (cond x))
38+
let filterOut cond = Seq.filter (fun (x:Line) -> not (cond x.Text))
2039

21-
let parseTypeDefinition (line:string) =
22-
let fail () = failwith ("Invalid type definition:" + line)
40+
let parseTypeDefinition (line:string) : Choice<LineContent, ErrorText> =
41+
let fail details =
42+
Choice2Of2 (sprintf "Invalid type definition, should %s like 'public MyType<int>'" details)
2343

2444
match line.Split(' ') with
2545
| [| visibility; rest |] ->
2646
match rest.Split('<') with
2747
| [| fullName; underlyingType |] ->
28-
if not (underlyingType.EndsWith(">")) then fail()
29-
let underlyingType = underlyingType.Substring(0, underlyingType.Length - 1)
30-
let lastDot = fullName.LastIndexOf('.')
31-
let namespace' =
32-
if lastDot <> -1 then
33-
fullName.Substring(0, lastDot)
34-
else
35-
""
36-
let name = fullName.Substring(lastDot+1)
48+
match underlyingType with
49+
| _ when underlyingType.Length = 0 -> fail "have a non-empty underlying type"
50+
| _ when fullName.Length = 0 -> fail "have a non-empty type name"
51+
| _ when not (underlyingType.EndsWith(">")) -> fail "end with >"
52+
| _ ->
53+
let underlyingType = underlyingType.Substring(0, underlyingType.Length - 1)
54+
let lastDot = fullName.LastIndexOf('.')
55+
let namespace' =
56+
if lastDot <> -1 then
57+
fullName.Substring(0, lastDot)
58+
else
59+
""
60+
let name = fullName.Substring(lastDot+1)
3761

38-
TypeDefinition(visibility, namespace', name, underlyingType)
62+
Choice1Of2 (TypeDefinition(visibility, namespace', name, underlyingType))
3963

40-
| _ -> fail()
41-
| _ -> fail()
64+
| _ -> fail "contain an underlying type between <>"
65+
| _ -> fail "contain one space"
4266

43-
let parseProperty (line:string) =
67+
let parseProperty (line:string) : Choice<LineContent, ErrorText> =
4468
let separator = line.IndexOf(':')
4569
match separator with
46-
| -1 -> failwith ("Invalid property definition:" + line)
70+
| -1 -> Choice2Of2 "Invalid property definition, should be 'name:value'"
4771
| _ ->
4872
let name = line.Substring(0, separator)
4973
let value = line.Substring(separator+1)
50-
Property(name,value)
74+
Choice1Of2 (Property(name,value))
5175

52-
let parseLine (line:string) =
53-
let firstChar = line.[0]
54-
let content =
55-
if firstChar = ' ' || firstChar = '\t' then
56-
parseProperty (line.Trim())
57-
else
58-
parseTypeDefinition (line.Trim())
76+
let augmentChoice line isType contentOrErrorText =
77+
match contentOrErrorText with
78+
| Choice1Of2(content) -> Choice1Of2 { Line = line; Content = content }
79+
| Choice2Of2(errorText) -> Choice2Of2 { Line = line; ErrorText = errorText; IsInvalidType = isType }
5980

60-
{ Text = line; Content = content }
81+
let parseLine (line:Line) =
82+
let text = line.Text
83+
let firstChar = text.[0]
84+
85+
if firstChar = ' ' || firstChar = '\t' then
86+
parseProperty (text.Trim()) |> augmentChoice line false
87+
else
88+
parseTypeDefinition (text.Trim()) |> augmentChoice line true
6189

6290
let parseLines lines =
6391
lines
92+
|> Seq.mapi (fun i l -> { Number = i+1; Text = l})
6493
|> filterOut isEmpty
6594
|> filterOut isComment
6695
|> Seq.map parseLine
@@ -69,106 +98,149 @@ type Configuration =
6998
{
7099
Path : string option
71100
Types : IdType list
101+
Errors : ParseError list
72102
}
73103

74104
module private LineParser =
75105
let parseCast (text:string) =
76106
let lowerCasedText = text.ToLower()
77107
match lowerCasedText with
78-
| "explicit" -> Cast.Explicit
79-
| "implicit" -> Cast.Implicit
80-
| _ -> failwith (sprintf "Unknown cast type: '%s'" text)
108+
| "explicit" -> Choice1Of2 Cast.Explicit
109+
| "implicit" -> Choice1Of2 Cast.Implicit
110+
| _ -> Choice2Of2 (sprintf "Unknown cast type: '%s'" text)
81111

82112
let parseOptionalString (text:string) =
83113
if System.String.IsNullOrWhiteSpace(text) then
84114
Option.None
85115
else
86116
Some(text)
87117

88-
let addProperty' (name:string) (value:string) (idType:IdType) =
118+
let addProperty' (name:string) (value:string) (idType:IdType) = choice {
89119
match name with
90-
| "ValueProperty" -> { idType with ValueProperty = value }
91-
| "AllowNull" -> { idType with AllowNull = bool.Parse(value) }
92-
| "InternString" -> { idType with InternString = bool.Parse(value) }
93-
| "EqualsUnderlying" -> { idType with EqualsUnderlying = bool.Parse(value) }
94-
| "CastToUnderlying" -> { idType with CastToUnderlying = parseCast(value) }
95-
| "CastFromUnderlying" -> { idType with CastFromUnderlying = parseCast(value) }
96-
| "FileName" -> { idType with FileName = parseOptionalString(value) }
97-
| _ -> failwith(sprintf "Property '%s' isn't supported" name)
98-
99-
let addProperty (content:LineContent) (idType:IdType) =
120+
| "ValueProperty" -> return { idType with ValueProperty = value }
121+
| "AllowNull" -> return { idType with AllowNull = bool.Parse(value) }
122+
| "InternString" -> return { idType with InternString = bool.Parse(value) }
123+
| "EqualsUnderlying" -> return { idType with EqualsUnderlying = bool.Parse(value) }
124+
| "CastToUnderlying" ->
125+
let! cast = parseCast(value)
126+
return{ idType with CastToUnderlying = cast }
127+
| "CastFromUnderlying" ->
128+
let! cast = parseCast(value)
129+
return{ idType with CastFromUnderlying = cast }
130+
| "FileName" -> return{ idType with FileName = parseOptionalString(value) }
131+
| _ -> return! Choice2Of2 (sprintf "Property '%s' isn't supported" name)
132+
}
133+
134+
let addProperty (content:LineContent) (idType:IdType) = choice {
100135
match content with
101136
| Property(name, value) ->
102-
idType |> addProperty' (name.Trim()) (value.Trim())
103-
| _ -> failwith "Not a property definition"
104-
105-
let parseUnderlyingType = function
106-
| "bool" -> typeof<bool>
107-
| "byte" -> typeof<byte>
108-
| "sbyte" -> typeof<sbyte>
109-
| "char" -> typeof<char>
110-
| "decimal" -> typeof<decimal>
111-
| "double" -> typeof<double>
112-
| "float" -> typeof<single>
113-
| "int" -> typeof<int>
114-
| "uint" -> typeof<System.UInt32>
115-
| "long" -> typeof<System.Int64>
116-
| "ulong" -> typeof<System.UInt64>
117-
| "object" -> typeof<obj>
118-
| "short" -> typeof<System.Int16>
119-
| "ushort" -> typeof<System.UInt16>
120-
| "string" -> typeof<string>
137+
let! newType = idType |> addProperty' (name.Trim()) (value.Trim())
138+
return newType
139+
| _ -> return! Choice2Of2 "Not a property definition"
140+
}
141+
142+
let parseUnderlyingType typeName = choice {
143+
match typeName with
144+
| "bool" -> return typeof<bool>
145+
| "byte" -> return typeof<byte>
146+
| "sbyte" -> return typeof<sbyte>
147+
| "char" -> return typeof<char>
148+
| "decimal" -> return typeof<decimal>
149+
| "double" -> return typeof<double>
150+
| "float" -> return typeof<single>
151+
| "int" -> return typeof<int>
152+
| "uint" -> return typeof<System.UInt32>
153+
| "long" -> return typeof<System.Int64>
154+
| "ulong" -> return typeof<System.UInt64>
155+
| "object" -> return typeof<obj>
156+
| "short" -> return typeof<System.Int16>
157+
| "ushort" -> return typeof<System.UInt16>
158+
| "string" -> return typeof<string>
121159
| s ->
122160
let type' = System.Type.GetType(s, false)
123161
let type' = if type' <> null then type' else System.Type.GetType("System." + s, false)
124162

125163
if type' <> null then
126-
type'
164+
return type'
127165
else
128-
failwith (sprintf "Type '%s' not found." s)
166+
return! Choice2Of2 (sprintf "Type '%s' not found." s)
167+
}
129168

130-
let parseVisibility = function
131-
| "public" -> Public
132-
| "internal" -> Internal
133-
| s -> failwith (sprintf "Visibility can't be parsed: '%s'" s)
169+
let parseVisibility visibilityText = choice {
170+
match visibilityText with
171+
| "public" -> return Public
172+
| "internal" -> return Internal
173+
| s -> return! Choice2Of2 (sprintf "Visibility can't be parsed: '%s'" s)
174+
}
134175

135-
let typeDefinitionToType (content:LineContent) =
176+
let typeDefinitionToType (content:LineContent) = choice {
136177
match content with
137178
| TypeDefinition(visibility,namespace',name,underlyingType) ->
138-
let underlyingType = parseUnderlyingType underlyingType
139-
makeIdType underlyingType (fun idType ->
179+
let! underlyingType = parseUnderlyingType underlyingType
180+
let! visibility = parseVisibility visibility
181+
return makeIdType underlyingType (fun idType ->
140182
{ idType with
141183
Name = name
142184
Namespace = namespace'
143-
Visibility = parseVisibility visibility
185+
Visibility = visibility
144186
}
145187
)
146-
| _ -> failwith "Not a type definition"
188+
| _ -> return! Choice2Of2 "Not a type definition"
189+
}
190+
191+
let propertyWithNoValidType (line:ParsedLine) =
192+
{
193+
Line = line.Line;
194+
ErrorText = "Property line associated with no valid type";
195+
IsInvalidType = false
196+
}
147197

148-
let rec linesToIdTypes (currentType:IdType option) (remainingLines : Line list) =
198+
let rec linesToIdTypes' newCurrentType remainingLines typeToAdd errorToAdd : IdType list * ParseError list =
199+
let (innerTypes, innerErrors) = linesToIdTypes newCurrentType remainingLines
200+
let innerTypes = match typeToAdd with | Some(t) -> t :: innerTypes | _ -> innerTypes
201+
let innerErrors = match errorToAdd with | Some(t) -> t :: innerErrors | _ -> innerErrors
202+
(innerTypes, innerErrors)
203+
204+
and linesToIdTypes currentType remainingLines =
149205
match remainingLines with
150206
| line :: rest ->
151-
match line.Content with
152-
| Property(_,_) ->
153-
match currentType with
154-
| Some(idType) ->
155-
let idType = idType |> addProperty line.Content
156-
linesToIdTypes (Some(idType)) rest
157-
| Option.None -> failwith ("Found a property line before founding any type: " + line.Text)
158-
| TypeDefinition(_,_,_,_) ->
159-
let newType = typeDefinitionToType line.Content
160-
match currentType with
161-
| Some(idType) -> idType :: linesToIdTypes (Some(newType)) rest
162-
| Option.None -> linesToIdTypes (Some(newType)) rest
207+
// Helper functions to make to rest clearer
208+
let reportTypeError error = linesToIdTypes' Option.None rest currentType (Some(error))
209+
let reportPropertyError error = linesToIdTypes' currentType rest Option.None (Some(error))
210+
let finishCurrentType newType = linesToIdTypes' (Some(newType)) rest currentType Option.None
211+
let continueOnType type' = linesToIdTypes (Some(type')) rest
212+
213+
match line with
214+
| Choice1Of2(line) ->
215+
match line.Content with
216+
| Property(_,_) ->
217+
match currentType with
218+
| Some(idType) ->
219+
let idType = idType |> addProperty line.Content
220+
match idType with
221+
| Choice1Of2(idType) -> continueOnType idType
222+
| Choice2Of2(error) -> reportPropertyError (ParseError.fromString error line.Line)
223+
| Option.None -> reportPropertyError (propertyWithNoValidType line)
224+
| TypeDefinition(_,_,_,_) ->
225+
let newType = typeDefinitionToType line.Content
226+
match newType with
227+
| Choice1Of2(newType) -> finishCurrentType newType
228+
| Choice2Of2(error) -> reportTypeError (ParseError.fromString error line.Line)
229+
| Choice2Of2(error) ->
230+
// If a type line was invalid we don't want the following properties to be associated with the previous type
231+
// But if a property is invalid we want the following properties to be associated with the current type
232+
match (error.IsInvalidType, currentType) with
233+
| (true, Some(currentType)) -> reportTypeError error
234+
| _ -> reportPropertyError error
163235
| [] ->
164236
match currentType with
165-
| Some(idType) -> [idType]
166-
| Option.None -> []
237+
| Some(idType) -> ([idType], [])
238+
| Option.None -> ([], [])
167239

168-
let linesToConfiguration (lines:Line seq) : Configuration =
240+
let linesToConfiguration (lines:Choice<ParsedLine,ParseError> seq) : Configuration =
169241
let lines = lines |> List.ofSeq
170-
let types = linesToIdTypes Option.None lines
171-
{ Path = Option.None; Types = types}
242+
let (types, errors) = linesToIdTypes Option.None lines
243+
{ Path = Option.None; Types = types; Errors = errors }
172244

173245
let loadFromLines (lines:string seq) =
174246
lines

‎src/BlackFox.Stidgen/FileGeneration.fs

+4-1
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,11 @@ let private generateToFile configurationPath idType =
2929
let generateToFiles configurationPath =
3030
let configurationInfo = new FileInfo(configurationPath)
3131
let configuration = ConfigurationParser.loadFromFile configurationInfo
32+
3233
match configuration.Path with
3334
| Some(path) ->
3435
for idType in configuration.Types do
3536
idType |> generateToFile path
36-
| _ -> failwith "Unexpected"
37+
| _ -> failwith "Unexpected"
38+
39+
configuration.Errors

0 commit comments

Comments
 (0)