Skip to content

Commit 1463759

Browse files
committed
More variations in types
1 parent ad371b0 commit 1463759

File tree

6 files changed

+268
-7
lines changed

6 files changed

+268
-7
lines changed

FSharpPlus.sln

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -125,12 +125,14 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "workflows", "workflows", "{
125125
EndProject
126126
Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "ISSUE_TEMPLATE", "ISSUE_TEMPLATE", "{B9238B1E-C83C-4196-8C86-DA3E2CCDA309}"
127127
ProjectSection(SolutionItems) = preProject
128-
.github\ISSUE_TEMPLATE\config.yml = .github\ISSUE_TEMPLATE\config.yml
129128
.github\ISSUE_TEMPLATE\01_bug_report.yml = .github\ISSUE_TEMPLATE\01_bug_report.yml
130129
.github\ISSUE_TEMPLATE\02_api_proposal.yml = .github\ISSUE_TEMPLATE\02_api_proposal.yml
131130
.github\ISSUE_TEMPLATE\03_general_feature.yml = .github\ISSUE_TEMPLATE\03_general_feature.yml
131+
.github\ISSUE_TEMPLATE\config.yml = .github\ISSUE_TEMPLATE\config.yml
132132
EndProjectSection
133133
EndProject
134+
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "LikeOperator", "LikeOperator\LikeOperator.fsproj", "{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}"
135+
EndProject
134136
Global
135137
GlobalSection(SolutionConfigurationPlatforms) = preSolution
136138
Debug|Any CPU = Debug|Any CPU
@@ -229,6 +231,16 @@ Global
229231
{ACBBD11E-0746-4B9D-9CED-A90FE5824CE2}.Release|Any CPU.Build.0 = Release|Any CPU
230232
{ACBBD11E-0746-4B9D-9CED-A90FE5824CE2}.Test|Any CPU.ActiveCfg = Release|Any CPU
231233
{ACBBD11E-0746-4B9D-9CED-A90FE5824CE2}.Test|Any CPU.Build.0 = Release|Any CPU
234+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
235+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Debug|Any CPU.Build.0 = Debug|Any CPU
236+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Fable|Any CPU.ActiveCfg = Release|Any CPU
237+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Fable|Any CPU.Build.0 = Release|Any CPU
238+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Fable3|Any CPU.ActiveCfg = Release|Any CPU
239+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Fable3|Any CPU.Build.0 = Release|Any CPU
240+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Release|Any CPU.ActiveCfg = Release|Any CPU
241+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Release|Any CPU.Build.0 = Release|Any CPU
242+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Test|Any CPU.ActiveCfg = Debug|Any CPU
243+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC}.Test|Any CPU.Build.0 = Debug|Any CPU
232244
EndGlobalSection
233245
GlobalSection(SolutionProperties) = preSolution
234246
HideSolutionNode = FALSE
@@ -246,6 +258,7 @@ Global
246258
{F4D5D32F-D47A-4727-8965-80A4BB7A29DD} = {A6A6AF7D-D6E3-442D-9B1E-58CC91879BE1}
247259
{877F7C02-2F44-4314-AA00-3F5C4FFEC187} = {153F4C68-EF70-4CF2-AA64-73482955999F}
248260
{B9238B1E-C83C-4196-8C86-DA3E2CCDA309} = {153F4C68-EF70-4CF2-AA64-73482955999F}
261+
{6CEA411C-B69A-B022-94E8-EA1F6FC312CC} = {ED8079DD-2B06-4030-9F0F-DC548F98E1C4}
249262
EndGlobalSection
250263
GlobalSection(ExtensibilityGlobals) = postSolution
251264
SolutionGuid = {789B5FFA-7891-4F60-831E-42C3C5ED2C51}

LikeOperator/LikeOperator.fsproj

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,17 @@
1+
<Project Sdk="Microsoft.NET.Sdk">
2+
3+
<PropertyGroup>
4+
<OutputType>Exe</OutputType>
5+
<TargetFramework>net9.0</TargetFramework>
6+
</PropertyGroup>
7+
8+
<ItemGroup>
9+
<None Include="Parsing.fs" />
10+
<Compile Include="Program.fs" />
11+
</ItemGroup>
12+
13+
<ItemGroup>
14+
<ProjectReference Include="..\src\FSharpPlus\FSharpPlus.fsproj" />
15+
</ItemGroup>
16+
17+
</Project>

LikeOperator/Parsing.fs

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
1+
namespace FSharpPlus
2+
3+
#if !FABLE_COMPILER
4+
5+
[<AutoOpen>]
6+
module Parsing =
7+
#nowarn "0042" // retype
8+
9+
module internal Prelude =
10+
open System
11+
12+
let inline flip f x y = f y x
13+
let inline const' k _ = k
14+
let inline tupleToOption x = match x with true, value -> Some value | _ -> None
15+
let inline opaqueId x = Unchecked.defaultof<_>; x
16+
17+
let inline retype (x: 'T) : 'U =
18+
#if !FABLE_COMPILER
19+
(# "" x: 'U #)
20+
#else
21+
unbox<'U> x
22+
#endif
23+
open Prelude
24+
#warnon "0042"
25+
26+
open System
27+
open System.Text.RegularExpressions
28+
open FSharpPlus
29+
open FSharpPlus.Internals
30+
31+
let inline private getGroups (pf: PrintfFormat<_,_,_,_,_>) s =
32+
let formatters = [|"%A"; "%b"; "%B"; "%c"; "%d"; "%e"; "%E"; "%f"; "%F"; "%g"; "%G"; "%i"; "%M"; "%o"; "%O"; "%s"; "%u"; "%x"; "%X"|]
33+
let formatStr = replace "%%" "%" pf.Value
34+
let constants = split formatters formatStr
35+
let regex = Regex ("^" + String.Join ("(.*?)", constants |> Array.map Regex.Escape) + "$")
36+
printfn $"{regex}"
37+
let getGroup x =
38+
let groups =
39+
regex.Match(x).Groups
40+
|> Seq.cast<Group>
41+
|> Seq.skip 1
42+
groups
43+
|> Seq.map (fun g -> g.Value)
44+
|> Seq.toArray
45+
(getGroup s, getGroup pf.Value) ||> Array.zipShortest
46+
47+
let inline private conv (destType: System.Type) (b: int) (s: string) =
48+
match destType with
49+
| t when t = typeof<byte> -> Convert.ToByte (s, b) |> box
50+
| t when t = typeof<uint16> -> Convert.ToUInt16 (s, b) |> box
51+
| t when t = typeof<uint32> -> Convert.ToUInt32 (s, b) |> box
52+
| t when t = typeof<uint64> -> Convert.ToUInt64 (s, b) |> box
53+
| t when t = typeof<sbyte> -> Convert.ToSByte (s, b) |> box
54+
| t when t = typeof<int16> -> Convert.ToInt16 (s, b) |> box
55+
| t when t = typeof<int> -> Convert.ToInt32 (s, b) |> box
56+
| t when t = typeof<int64> -> Convert.ToInt64 (s, b) |> box
57+
| _ -> invalidOp (sprintf "Type conversion from string to type %A with base %i is not supported" destType b)
58+
59+
let inline private parse (s: string, f: string) : 'r =
60+
match f with
61+
| "%B" -> conv typeof<'r> 2 s |> string |> parse
62+
| "%o" -> conv typeof<'r> 8 s |> string |> parse
63+
| "%x" | "%X" -> conv typeof<'r> 16 s |> string |> parse
64+
| _ -> parse s
65+
66+
let inline private tryParse (s: string, f: string) : 'r option =
67+
match f with
68+
| "%B" -> Option.protect (conv typeof<'r> 2) s |> Option.map string |> Option.bind tryParse
69+
| "%o" -> Option.protect (conv typeof<'r> 8) s |> Option.map string |> Option.bind tryParse
70+
| "%x" | "%X" -> Option.protect (conv typeof<'r> 16) s |> Option.map string |> Option.bind tryParse
71+
| _ -> tryParse s
72+
73+
type ParseArray =
74+
static member inline ParseArray (_: 't , _: obj) = fun (g: (string * string) []) -> (parse (g.[0])) : 't
75+
76+
static member inline Invoke (g: (string * string) []) =
77+
let inline call_2 (a: ^a, b: ^b) = ((^a or ^b) : (static member ParseArray: _*_ -> _) b, a) g
78+
let inline call (a: 'a) = call_2 (a, Unchecked.defaultof<'r>) : 'r
79+
call Unchecked.defaultof<ParseArray>
80+
81+
static member inline ParseArray (t: 't, _: ParseArray) = fun (g: (string * string) []) ->
82+
let _f _ = Constraints.whenNestedTuple t : ('t1*'t2*'t3*'t4*'t5*'t6*'t7*'tr)
83+
let (t1: 't1) = parse (g.[0])
84+
let (t2: 't2) = parse (g.[1])
85+
let (t3: 't3) = parse (g.[2])
86+
let (t4: 't4) = parse (g.[3])
87+
let (t5: 't5) = parse (g.[4])
88+
let (t6: 't6) = parse (g.[5])
89+
let (t7: 't7) = parse (g.[6])
90+
let (tr: 'tr) = ParseArray.Invoke (g.[7..])
91+
Tuple<_,_,_,_,_,_,_,_> (t1, t2, t3, t4, t5, t6, t7, tr) |> retype : 't
92+
93+
static member inline ParseArray (_: unit , _: ParseArray) = fun (_: (string * string) []) -> ()
94+
static member inline ParseArray (_: Tuple<'t1> , _: ParseArray) = fun (g: (string * string) []) -> Tuple<_> (parse g.[0]) : Tuple<'t1>
95+
static member inline ParseArray (_: Id<'t1> , _: ParseArray) = fun (g: (string * string) []) -> Id<_> (parse g.[0])
96+
static member inline ParseArray (_: 't1*'t2 , _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1]
97+
static member inline ParseArray (_: 't1*'t2'*'t3 , _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1], parse g.[2]
98+
static member inline ParseArray (_: 't1*'t2'*'t3*'t4 , _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1], parse g.[2], parse g.[3]
99+
static member inline ParseArray (_: 't1*'t2'*'t3*'t4*'t5 , _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1], parse g.[2], parse g.[3], parse g.[4]
100+
static member inline ParseArray (_: 't1*'t2'*'t3*'t4*'t5*'t6 , _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1], parse g.[2], parse g.[3], parse g.[4], parse g.[5]
101+
static member inline ParseArray (_: 't1*'t2'*'t3*'t4*'t5*'t6*'t7, _: ParseArray) = fun (g: (string * string) []) -> parse g.[0], parse g.[1], parse g.[2], parse g.[3], parse g.[4], parse g.[5], parse g.[6]
102+
103+
let inline private tryParseElemAt i (g: (string * string) []) =
104+
if i < Array.length g then tryParse (g.[i])
105+
else None
106+
107+
type TryParseArray =
108+
static member inline TryParseArray (_:'t, _:obj) = fun (g: (string * string) []) -> tryParseElemAt 0 g : 't option
109+
110+
static member inline Invoke (g: (string * string) []) =
111+
let inline call_2 (a: ^a, b: ^b) = ((^a or ^b) : (static member TryParseArray: _*_ -> _) b, a) g
112+
let inline call (a: 'a) = call_2 (a, Unchecked.defaultof<'r>) : 'r option
113+
call Unchecked.defaultof<TryParseArray>
114+
115+
static member inline TryParseArray (t: 't, _: TryParseArray) = fun (g: (string * string) []) ->
116+
let _f _ = Constraints.whenNestedTuple t : ('t1*'t2*'t3*'t4*'t5*'t6*'t7*'tr)
117+
let (t1: 't1 option) = tryParseElemAt 0 g
118+
let (t2: 't2 option) = tryParseElemAt 1 g
119+
let (t3: 't3 option) = tryParseElemAt 2 g
120+
let (t4: 't4 option) = tryParseElemAt 3 g
121+
let (t5: 't5 option) = tryParseElemAt 4 g
122+
let (t6: 't6 option) = tryParseElemAt 5 g
123+
let (t7: 't7 option) = tryParseElemAt 6 g
124+
let (tr: 'tr option) = if g.Length > 7 then TryParseArray.Invoke (g.[7..]) else None
125+
match t1, t2, t3, t4, t5, t6, t7, tr with
126+
| Some t1, Some t2, Some t3, Some t4, Some t5, Some t6, Some t7, Some tr -> Some (Tuple<_,_,_,_,_,_,_,_> (t1, t2, t3, t4, t5, t6, t7, tr) |> retype : 't)
127+
| _ -> None
128+
129+
static member inline TryParseArray (_: unit , _: TryParseArray) = fun (_: (string * string) []) -> ()
130+
static member inline TryParseArray (_: Tuple<'t1> , _: TryParseArray) = fun (g: (string * string) []) -> Tuple<_> <!> tryParseElemAt 0 g : Tuple<'t1> option
131+
static member inline TryParseArray (_: Id<'t1> , _: TryParseArray) = fun (g: (string * string) []) -> Id<_> <!> tryParseElemAt 0 g
132+
static member inline TryParseArray (_: 't1*'t2 , _: TryParseArray) = fun (g: (string * string) []) -> tuple2 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g
133+
static member inline TryParseArray (_: 't1*'t2'*'t3 , _: TryParseArray) = fun (g: (string * string) []) -> tuple3 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g <*> tryParseElemAt 2 g
134+
static member inline TryParseArray (_: 't1*'t2'*'t3*'t4 , _: TryParseArray) = fun (g: (string * string) []) -> tuple4 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g <*> tryParseElemAt 2 g <*> tryParseElemAt 3 g
135+
static member inline TryParseArray (_: 't1*'t2'*'t3*'t4*'t5 , _: TryParseArray) = fun (g: (string * string) []) -> tuple5 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g <*> tryParseElemAt 2 g <*> tryParseElemAt 3 g <*> tryParseElemAt 4 g
136+
static member inline TryParseArray (_: 't1*'t2'*'t3*'t4*'t5*'t6 , _: TryParseArray) = fun (g: (string * string) []) -> tuple6 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g <*> tryParseElemAt 2 g <*> tryParseElemAt 3 g <*> tryParseElemAt 4 g <*> tryParseElemAt 5 g
137+
static member inline TryParseArray (_: 't1*'t2'*'t3*'t4*'t5*'t6*'t7, _: TryParseArray) = fun (g: (string * string) []) -> tuple7 <!> tryParseElemAt 0 g <*> tryParseElemAt 1 g <*> tryParseElemAt 2 g <*> tryParseElemAt 3 g <*> tryParseElemAt 4 g <*> tryParseElemAt 5 g <*> tryParseElemAt 6 g
138+
139+
140+
/// Gets a tuple with the result of parsing each element of a string array.
141+
let inline parseArray (source: string []) : '``(T1 * T2 * ... * Tn)`` = ParseArray.Invoke (Array.map (fun x -> (x, "")) source)
142+
143+
/// Gets a tuple with the result of parsing each element of a formatted text.
144+
let inline sscanf (pf: PrintfFormat<_,_,_,_,'``(T1 * T2 * ... * Tn)``>) s : '``(T1 * T2 * ... * Tn)`` = getGroups pf s |> ParseArray.Invoke
145+
146+
/// Gets a tuple with the result of parsing each element of a formatted text from the Console.
147+
let inline scanfn pf : '``(T1 * T2 * ... * Tn)`` = sscanf pf (Console.ReadLine ())
148+
149+
/// Gets a tuple with the result of parsing each element of a string array. Returns None in case of failure.
150+
let inline tryParseArray (source: string []) : '``(T1 * T2 * ... * Tn)`` option = TryParseArray.Invoke (Array.map (fun x -> (x, "")) source)
151+
152+
/// Gets a tuple with the result of parsing each element of a formatted text. Returns None in case of failure.
153+
let inline trySscanf (pf: PrintfFormat<_,_,_,_,'``(T1 * T2 * ... * Tn)``>) s : '``(T1 * T2 * ... * Tn)`` option = getGroups pf s |> TryParseArray.Invoke
154+
155+
/// Gets a tuple with the result of parsing each element of a formatted text from the Console. Returns None in case of failure.
156+
let inline tryScanfn pf : '``(T1 * T2 * ... * Tn)`` option = trySscanf pf (Console.ReadLine ())
157+
158+
#endif

LikeOperator/Program.fs

Lines changed: 73 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,73 @@
1+
2+
open System
3+
open System.Text.RegularExpressions
4+
5+
let getGroups (pf: PrintfFormat<_,_,_,_,_>) str =
6+
let format = pf.Value
7+
let regex = System.Text.StringBuilder "^"
8+
let mutable groups = FSharp.Core.CompilerServices.ArrayCollector()
9+
let mutable i = 0
10+
while i < String.length format do
11+
match format[i] with
12+
| '%' ->
13+
let mutable j = i + 1
14+
while
15+
match format[j] with
16+
| ' ' | '+' | '-' | '*' | '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9' -> true
17+
| _ -> false
18+
do j <- j + 1
19+
if format[j] <> '%' then groups.Add format[i..j] // %% does not capture a group
20+
i <- j
21+
match format[j] with
22+
| 'A' | 'O' -> "(.*?)"
23+
| 'b' -> "([Tt][Rr][Uu][Ee]|[Ff][Aa][Ll][Ss][Ee])"
24+
| 'B' -> "([01]+)"
25+
| 'c' -> "(.)"
26+
| 'd' | 'i' -> "([+-]?[0-9]+)"
27+
| 'e' | 'E' | 'f' | 'F' | 'g' | 'G' | 'M' -> "([+-]?[0-9.]+(?:[eE][+-]?[0-9]+)?)"
28+
| 'o' -> "([0-7]+)"
29+
| 'u' -> "([0-9]+)"
30+
| 's' -> "(.*?)"
31+
| 'x' | 'X' -> "([0-9a-fA-F]+)"
32+
| '%' -> "%"
33+
| x -> failwith $"Unknown specifier: {x}"
34+
|> regex.Append
35+
| '\\' | '*' | '+' | '?' | '|' | '{' | '[' | '(' | ')' | '^' | '$' | '.' | '#' | ' ' as escape ->
36+
regex.Append('\\').Append escape
37+
| c -> regex.Append c
38+
|> ignore
39+
i <- i + 1
40+
regex.Append '$'
41+
|> string
42+
|> Regex
43+
|> _.Match(str)
44+
|> fun m ->
45+
if not m.Success then [||] else
46+
m.Groups
47+
|> Seq.cast<Group>
48+
|> Seq.skip 1
49+
|> Seq.map _.Value
50+
|> Seq.toArray
51+
|> Array.zip <| groups.Close()
52+
let inline (|Like|_|) format s =
53+
let x = getGroups format s
54+
FSharpPlus.Parsing.trySscanf format s
55+
56+
match "ab" with Like "%c" _ -> failwith "wrong match" | Like "%c%c" ('a', 'b') -> () | _ -> failwith "didn't match"
57+
match "abc" with Like "%c%c" ('a', 'b') -> failwith "wrong match" | Like "%c%c%c%s" ('a', 'b', 'c', "") -> () | _ -> failwith "didn't match"
58+
match "(%hello)" with
59+
| Like "%d" _ | Like "%f" _ | Like "%x" _ -> failwith "wrong match"
60+
| Like "%%(%%%s)" _ | Like "(%%%sa" _ | Like "(%%hel%c" _ | Like "%%hell%c)" _ -> failwith "wrong match"
61+
| Like "(%%%s)" "hello" -> ()
62+
| _ -> failwith "didn't match"
63+
match "test--this-gg" with Like "%s--%s-%s" ("test", "this", "gg") -> () | _ -> failwith "didn't match"
64+
match "1 2.1 3.4 .3 43.2e32 0 f f" with Like "%f %F %g %G %e %E %c %c" (1f, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f') -> () | _ -> failwith "didn't match"
65+
match "1 2.1 3.4 .3 43.2e32 0 f f f" with Like "%f %F %g %G %e %E %c %c %c" (1f, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f', 'f') -> () | _ -> failwith "didn't match"
66+
match "1 2.1 3.4 .3 43.2e32 0 f f ff" with Like "%B %F %g %G %e %E %c %c %c%c" (1, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f', 'f', 'f') -> () | _ -> failwith "didn't match"
67+
match "1 2.1 3.4 .3 43.2e32 0 f f fff" with Like "%o %F %g %G %e %E %c %c %c%c%c" (1, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f', 'f', 'f', 'f') -> () | _ -> failwith "didn't match"
68+
match "1 2.1 3.4 .3 43.2e32 0 f f fff16" with Like "%x %F %g %G %e %E %c %c %c%c%c%i" (1, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f', 'f', 'f', 'f', 16) -> () | _ -> failwith "didn't match"
69+
match "1 2.1 3.4 .3 43.2e32 0 f f fff16 17" with Like "%X %F %g %G %e %E %c %c %c%c%c%i %f" (1, 2.1, 3.4, 0.3, 43.2e32, 0., 'f', 'f', 'f', 'f', 'f', 16, 17.) -> () | _ -> failwith "didn't match"
70+
match "13 43 AA 77A" with Like "%x %X %x %o%X" (0x13, 0x43, 0xAA, 0o77, 0xA) -> () | _ -> failwith "didn't match"
71+
match "13 43 AA 77A" with Like "%B%x %X %x %o%X" (0b1, 0x3, 0x43, 0xAA, 0o77, 0xA) -> () | _ -> failwith "didn't match"
72+
match "111AAA" with Like "%B%s" (0b111, "AAA") -> () | _ -> failwith "didn't match"
73+
match "100700 100 100" with Like "%B%o %x %X" (0b100, 0o700, 0x100, 0x100) -> () | _ -> failwith "didn't match"

global.json

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
{
22
"sdk": {
33
"version": "8.0.0",
4-
"rollForward": "latestFeature",
4+
"rollForward": "latestMajor",
55
"allowPrerelease": true
66
},
77

0 commit comments

Comments
 (0)