1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
|
namespace MonoDevelop.FSharp.Shared
open System
open System.Text
open System.Threading.Tasks
open System.IO
open Microsoft.FSharp.Compiler.SourceCodeServices
open ExtCore
module Seq =
let tryHead items =
if Seq.isEmpty items then None else Some (Seq.head items)
module List =
///Returns the greatest of all elements in the list that is less than the threshold
let maxUnderThreshold nmax =
List.maxBy(fun n -> if n > nmax then 0 else n)
module Option =
let inline getOrElse f o =
match o with
| Some v -> v
| _ -> f()
let inline tryCast<'T> (o: obj): 'T option =
match o with
| null -> None
| :? 'T as a -> Some a
| _ -> None
let inline cast o =
(Option.bind tryCast) o
/// Convert string into Option string where null and String.Empty result in None
let inline ofString (s:string) =
if String.isNullOrEmpty s then None
else Some s
/// Some(Some x) -> Some x | None -> None
let inline flatten x =
match x with
| Some x -> x
| None -> None
/// Gets the option if Some x, otherwise try to get another value
let inline orTry f =
function
| Some x -> Some x
| None -> f()
module String =
/// Split a line so it fits to a line width
let splitLine (sb : StringBuilder) (line : string) lineWidth =
let emit (s : string) = sb.Append(s) |> ignore
let indent =
line
|> Seq.takeWhile (fun c -> c = ' ')
|> Seq.length
let words = line.Split(' ')
let mutable i = 0
let mutable first = true
for word in words do
if first || i + word.Length < lineWidth then
emit word
emit " "
i <- i + word.Length + 1
first <- false
else
sb.AppendLine() |> ignore
for i in 1..indent do
emit " "
emit word
emit " "
i <- indent + word.Length + 1
first <- true
sb.AppendLine() |> ignore
/// Wrap text so it fits to a line width
let wrapText (text : String) lineWidth =
//dont wrap empty lines
if text.Length = 0 then text
else
let sb = StringBuilder()
let lines = text.Split [| '\r'; '\n' |]
for line in lines do
if line.Length <= lineWidth then sb.AppendLine(line) |> ignore
else splitLine sb line lineWidth
sb.ToString()
let inline isNotNull v = not (isNull v)
let getLines (str: string) =
use reader = new StringReader(str)
[|
let line = ref (reader.ReadLine())
while isNotNull (!line) do
yield !line
line := reader.ReadLine()
if str.EndsWith("\n") then
// last trailing space not returned
// http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak
yield String.Empty
|]
[<AutoOpen>]
module FSharpSymbolExt =
type FSharpSymbol with
member x.IsSymbolLocalForProject =
match x with
| :? FSharpParameter -> true
| :? FSharpMemberOrFunctionOrValue as m -> not m.IsModuleValueOrMember || not m.Accessibility.IsPublic
| :? FSharpEntity as m -> not m.Accessibility.IsPublic
| :? FSharpGenericParameter -> true
| :? FSharpUnionCase as m -> not m.Accessibility.IsPublic
| :? FSharpField as m -> not m.Accessibility.IsPublic
| _ -> false
member x.XmlDocSig =
match x with
| :? FSharpMemberOrFunctionOrValue as func -> func.XmlDocSig
| :? FSharpEntity as fse -> fse.XmlDocSig
| :? FSharpField as fsf -> fsf.XmlDocSig
| :? FSharpUnionCase as fsu -> fsu.XmlDocSig
| :? FSharpActivePatternCase as apc -> apc.XmlDocSig
| :? FSharpGenericParameter -> ""
| _ -> ""
type FSharpMemberOrFunctionOrValue with
// FullType may raise exceptions (see https://github.com/fsharp/fsharp/issues/307).
member x.FullTypeSafe = Option.attempt (fun _ -> x.FullType)
member x.IsConstructor = x.CompiledName = ".ctor"
member x.IsOperatorOrActivePattern =
let name = x.DisplayName
if name.StartsWith "( " && name.EndsWith " )" && name.Length > 4
then name.Substring (2, name.Length - 4) |> String.forall (fun c -> c <> ' ')
else false
type FSharpEntity with
member x.TryGetFullName() =
Option.attempt (fun _ -> x.TryFullName)
|> Option.flatten
|> Option.orTry (fun _ -> Option.attempt (fun _ -> String.Join(".", x.AccessPath, x.DisplayName)))
member x.TryGetFullNameWithUnderScoreTypes() =
try
let name = String.Join(".", x.AccessPath, x.DisplayName)
if x.GenericParameters.Count > 0 then
Some (name + "<" + String.concat "," (x.GenericParameters |> Seq.map (fun gp -> gp.DisplayName)) + ">")
else Some name
with _ -> None
member x.UnAnnotate() =
let rec realEntity (s:FSharpEntity) =
if s.IsFSharpAbbreviation && s.AbbreviatedType.HasTypeDefinition
then realEntity s.AbbreviatedType.TypeDefinition
else s
realEntity x
member x.InheritanceDepth() =
let rec loop (ent:FSharpEntity) l =
match ent.BaseType with
| Some bt -> loop (bt.TypeDefinition.UnAnnotate()) l + 1
| None -> l
loop x 0
//TODO: Do we need to unannotate like above?
member x.AllBaseTypes =
let rec allBaseTypes (entity:FSharpEntity) =
[
match entity.TryFullName with
| Some _ ->
match entity.BaseType with
| Some bt ->
yield bt
if bt.HasTypeDefinition then
yield! allBaseTypes bt.TypeDefinition
| _ -> ()
| _ -> ()
]
allBaseTypes x
[<AutoOpen>]
module FrameworkExt =
type Path with
static member GetFullPathSafe path =
try Path.GetFullPath path
with _ -> path
type Text.StringBuilder with
///Apply a predicate to the last character of the StringBuilder instance
member x.LastCharacterIs f =
if x.Length > 0 then f x.[x.Length - 1]
else false
///Apply a predicate to the first character of the StringBuilder instance
member x.FirstCharacterIs f =
if x.Length > 0 then f x.[0]
else false
/// Add some useful methods for creating strings from sequences
type System.String with
static member ofSeq s = new String(s |> Seq.toArray)
static member ofReversedSeq s = new String(s |> Seq.toArray |> Array.rev)
///Helper to return an IDisposable for a event on subscribe
type IDelegateEvent<'Del when 'Del :> Delegate> with
member this.Subscribe handler =
do this.AddHandler(handler)
{ new IDisposable with
member x.Dispose() =
this.RemoveHandler(handler) }
[<AutoOpen>]
module ConstraintExt =
type FSharpGenericParameterMemberConstraint with
member x.IsProperty =
(x.MemberIsStatic && x.MemberArgumentTypes.Count = 0) ||
(not x.MemberIsStatic && x.MemberArgumentTypes.Count = 1)
module AsyncChoice =
let inline ofOptionWith e =
Control.Async.map (Choice.ofOptionWith e)
[<AutoOpen>]
module AsyncChoiceCE =
type ExtCore.Control.AsyncChoiceBuilder with
member inline __.ReturnFrom (choice : Choice<'T, 'Error>) : Async<Choice<'T, 'Error>> = async.Return choice
member inline __.Bind (value : Choice<'T, 'Error>, binder : 'T -> Async<Choice<'U, 'Error>>) : Async<Choice<'U, 'Error>> =
async {
match value with
| Error error -> return Choice2Of2 error
| Success x -> return! binder x
}
module Async =
let inline startAsPlainTask (work : Async<unit>) =
System.Threading.Tasks.Task.Factory.StartNew(fun () -> work |> Async.RunSynchronously)
let inline awaitPlainTask (task: Task) =
let continuation (t : Task) : unit =
if t.IsFaulted then raise t.Exception
task.ContinueWith continuation |> Async.AwaitTask
[<AutoOpen>]
module AsyncTaskBind =
type Microsoft.FSharp.Control.AsyncBuilder with
member x.Bind(computation:Task<'T>, binder:'T -> Async<'R>) = x.Bind(Async.AwaitTask computation, binder)
member x.ReturnFrom(computation:Task<'T>) = x.ReturnFrom(Async.AwaitTask computation)
member x.Bind(computation:Task, binder:unit -> Async<unit>) = x.Bind(Async.awaitPlainTask computation, binder)
member x.ReturnFrom(computation:Task) = x.ReturnFrom(Async.awaitPlainTask computation)
|