|
| 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 |
0 commit comments