diff --git a/src/Funogram.Generator/Methods/MethodsGenerator.fs b/src/Funogram.Generator/Methods/MethodsGenerator.fs index d4d752e..ff9bd41 100644 --- a/src/Funogram.Generator/Methods/MethodsGenerator.fs +++ b/src/Funogram.Generator/Methods/MethodsGenerator.fs @@ -69,7 +69,7 @@ let generateMakeMethodSignature apiType (fields: ApiTypeField[]) convertFn code fields |> Seq.fold (fun code tp -> let o = if tp.IsOptional then "?" else "" - let c = if fields.[0] <> tp then ", " else "" + let c = if fields[0] <> tp then ", " else "" let argName = Helpers.toCamelCase tp.OriginalName |> Helpers.fixReservedKeywords let argType = convertFn tp @@ -89,7 +89,7 @@ let generateMakeMethodInvocation apiType (fields: ApiTypeField[]) convertFn code fields |> Seq.fold (fun code tp -> - let c = if fields.[0] <> tp then ", " else "" + let c = if fields[0] <> tp then ", " else "" let argNameOriginal = Helpers.toCamelCase tp.OriginalName |> Helpers.fixReservedKeywords let argName = convertFn tp argNameOriginal @@ -105,7 +105,7 @@ let generateMakeMethodInvocation apiType (fields: ApiTypeField[]) convertFn code |> Code.print ")" let generateMakeMethodOverloads apiType (fields: ApiTypeField[]) code = - if fields.Length = 0 || (fields.[0].ConvertedFieldType <> "ChatId") then + if fields.Length = 0 || (fields[0].ConvertedFieldType <> "ChatId") then code else let convertFieldSignatureType replaceType (tp: ApiTypeField) = diff --git a/src/Funogram.Generator/Methods/MethodsParser.fs b/src/Funogram.Generator/Methods/MethodsParser.fs index 95b1171..b44fafc 100644 --- a/src/Funogram.Generator/Methods/MethodsParser.fs +++ b/src/Funogram.Generator/Methods/MethodsParser.fs @@ -93,12 +93,12 @@ let private isMethodSection (node: HtmlNode) = if node.Name() = "h4" then let text = Helpers.directInnerText node let onlyLetters = text |> Seq.forall Char.IsLetter - onlyLetters && text.Length > 0 && Char.IsLower text.[0] + onlyLetters && text.Length > 0 && Char.IsLower text[0] else false let inline private tryFindField (elements: HtmlNode list) (m: Map) name = - m |> Map.tryFind name |> Option.map (fun i -> Helpers.innerText elements.[i]) + m |> Map.tryFind name |> Option.map (fun i -> Helpers.innerText elements[i]) let inline private defaultFieldValue v = match v with diff --git a/src/Funogram.Generator/Types/TypesParser.fs b/src/Funogram.Generator/Types/TypesParser.fs index d1d05fd..a85ac2f 100644 --- a/src/Funogram.Generator/Types/TypesParser.fs +++ b/src/Funogram.Generator/Types/TypesParser.fs @@ -55,7 +55,7 @@ let private splitCaseNameAndType (typeName: string) (nameAndType: string) = let private isValidTypeNode (typeNodeInfo: ApiTypeNodeInfo) = let name = Helpers.innerText typeNodeInfo.TypeName - Char.IsUpper name.[0] && (name.Replace(" ", "").Length = name.Length) + Char.IsUpper name[0] && (name.Replace(" ", "").Length = name.Length) let private setConvertedFieldType (field: ApiTypeField) = { field with ConvertedFieldType = Helpers.convertTLTypeToFSharpType field.OriginalFieldType field.Description false } @@ -66,14 +66,14 @@ let private parseApiTypeFields apiTypeName (node: HtmlNode) = |> Seq.map (fun n -> n.Elements()) |> Seq.filter (fun e -> e.Length = 3) |> Seq.map (fun elements -> - let desc = Helpers.innerText elements.[2] + let desc = Helpers.innerText elements[2] let optionalIndex = desc.IndexOf("Optional. ") let trimmedDesc = if optionalIndex >= 0 then desc.Substring(10) else desc { - OriginalName = Helpers.innerText elements.[0] - ConvertedName = elements.[0] |> Helpers.innerText |> Helpers.toPascalCase + OriginalName = Helpers.innerText elements[0] + ConvertedName = elements[0] |> Helpers.innerText |> Helpers.toPascalCase Description = trimmedDesc - OriginalFieldType = Helpers.innerText elements.[1] + OriginalFieldType = Helpers.innerText elements[1] ConvertedFieldType = "" Optional = Some (optionalIndex >= 0) } |> setConvertedFieldType diff --git a/src/Funogram.Telegram/Bot.fs b/src/Funogram.Telegram/Bot.fs index f11f79c..cc10b10 100644 --- a/src/Funogram.Telegram/Bot.fs +++ b/src/Funogram.Telegram/Bot.fs @@ -50,21 +50,21 @@ let inline private isAllowedChar (c: char) = Char.IsLetter c || Char.IsDigit c | // returns -1 if the command is not valid otherwise index of last character let private validateCommand (text: string) = let rec iter (text: string) i len = - if i >= len || isAllowedChar text.[i] |> not then + if i >= len || isAllowedChar text[i] |> not then (i - 1) else iter text (i + 1) len - if text.Length <= 1 || text.[0] <> '/' then -1 + if text.Length <= 1 || text[0] <> '/' then -1 else iter text 1 text.Length let getTextForCommand (me: User) (textOriginal: string option) = match me.Username, textOriginal with - | Some username, Some text when text.Length > 0 && text.[0] = '/' -> + | Some username, Some text when text.Length > 0 && text[0] = '/' -> match validateCommand text with | -1 -> textOriginal | idx when text.Length = idx + 1 -> Some text - | idx when text.[idx + 1] = '@' && text.IndexOf(username, idx + 1) = idx + 2 -> + | idx when text[idx + 1] = '@' && text.IndexOf(username, idx + 1) = idx + 2 -> text.Remove(idx + 1, username.Length + 1) |> Some | _ -> textOriginal | _ -> textOriginal diff --git a/src/Funogram.Telegram/Directory.Build.props b/src/Funogram.Telegram/Directory.Build.props index 2df6873..4482412 100644 --- a/src/Funogram.Telegram/Directory.Build.props +++ b/src/Funogram.Telegram/Directory.Build.props @@ -1,6 +1,6 @@ - 7.0.0.2 + 7.0.0.4 Nikolay Matyushin Funogram.Telegram Funogram.Telegram diff --git a/src/Funogram.Telegram/Sscanf.fs b/src/Funogram.Telegram/Sscanf.fs index d58fc5e..6168f26 100644 --- a/src/Funogram.Telegram/Sscanf.fs +++ b/src/Funogram.Telegram/Sscanf.fs @@ -85,16 +85,16 @@ let sscanf (pf:PrintfFormat<_,_,_,_,'t>) s : 't = let matches = (groups, formatters) - ||> Seq.map2 (fun g f -> g.Value |> parsers.[f]) + ||> Seq.map2 (fun g f -> g.Value |> parsers[f]) |> Seq.toArray if matches.Length = 1 then - coerce matches.[0] typeof<'t> :?> 't + coerce matches[0] typeof<'t> :?> 't else let tupleTypes = FSharpType.GetTupleElements(typeof<'t>) let matches = (matches,tupleTypes) - ||> Array.map2 ( fun a b -> coerce a b) + ||> Array.map2 coerce FSharpValue.MakeTuple(matches, typeof<'t>) :?> 't @@ -123,11 +123,11 @@ let sscanfci (pf:PrintfFormat<_,_,_,_,'t>) s : 't = let matches = (groups, formatters) - ||> Seq.map2 (fun g f -> g.Value |> parsers.[f]) + ||> Seq.map2 (fun g f -> g.Value |> parsers[f]) |> Seq.toArray if matches.Length = 1 then - coerce matches.[0] typeof<'t> :?> 't + coerce matches[0] typeof<'t> :?> 't else let tupleTypes = FSharpType.GetTupleElements(typeof<'t>) let matches = (matches, tupleTypes) ||> Array.map2 ( fun a b -> coerce a b) diff --git a/src/Funogram.Tests/Constants.fs b/src/Funogram.Tests/Constants.fs index 8642029..748766c 100644 --- a/src/Funogram.Tests/Constants.fs +++ b/src/Funogram.Tests/Constants.fs @@ -8,7 +8,7 @@ open Funogram.Types module Constants = let private ok = sprintf """{"ok":true,"result":%s}""" - let testDate = System.DateTime(2117, 05, 28, 12, 47, 51, DateTimeKind.Utc) + let testDate = DateTime(2117, 05, 28, 12, 47, 51, DateTimeKind.Utc) let testDateUnix = 4651649271L let testForwardOrigin = MessageOrigin.HiddenUser( MessageOriginHiddenUser.Create( @@ -39,8 +39,8 @@ module Constants = let jsonTestEditResult3ApiString = """{"ok":true,"result":{"message_id":123,"from":{"id":321,"is_bot":true,"first_name":"FSharpBot","username":"FSharpBot"},"chat":{"id":123,"first_name":"Test","last_name":"Test","username":"test","type":"private"},"date":4651649271,"edit_date":4651649271,"text":"Updated"}}""" - let testMaskPosition = { MaskPosition.Point = MaskPoint.Eyes; XShift = 0.0; YShift = 0.0; Scale = 0.0 } - let jsonTestMaskPosition = """{"point":"eyes","x_shift":0,"y_shift":0,"scale":0}""" + let testMaskPosition = { MaskPosition.Point = MaskPoint.Eyes; XShift = 1.0; YShift = 2.0; Scale = 3.0 } + let jsonTestMaskPosition = """{"point":"eyes","x_shift":1,"y_shift":2,"scale":3}""" let jsonTestMaskPositionResult = ok jsonTestMaskPosition diff --git a/src/Funogram.Tests/Funogram.Tests.fsproj b/src/Funogram.Tests/Funogram.Tests.fsproj index 0bd0e34..4b89f2a 100644 --- a/src/Funogram.Tests/Funogram.Tests.fsproj +++ b/src/Funogram.Tests/Funogram.Tests.fsproj @@ -12,13 +12,16 @@ - - - + + + + all + runtime; build; native; contentfiles; analyzers; buildtransitive + - + \ No newline at end of file diff --git a/src/Funogram/Converters.fs b/src/Funogram/Converters.fs new file mode 100644 index 0000000..0ce3ee3 --- /dev/null +++ b/src/Funogram/Converters.fs @@ -0,0 +1,262 @@ +namespace Funogram + +open System +open System.Collections.Generic +open System.IO +open System.Runtime.CompilerServices +open System.Runtime.Serialization +open System.Text.Json +open System.Text.Json.Serialization +open TypeShape.Core +open TypeShape.Core.SubtypeExtensions + +[] +do () +module internal Converters = + open Funogram.StringUtils + + let private unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + let toUnix (x: DateTime) = (x.ToUniversalTime() - unixEpoch).TotalSeconds |> int64 + + let mkMemberSerializer (case: ShapeFSharpUnionCase<'DeclaringType>) = + let isFile = + case.Fields.Length = 2 + && case.Fields[0].Member.Type = typeof + && (case.Fields[1].Member.Type = typeof || case.Fields[1].Member.Type = typeof) + + if case.Fields.Length = 0 then + fun (writer: Utf8JsonWriter) _ _ -> + let name = toSnakeCase case.CaseInfo.Name + writer.WriteStringValue(name) + else + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, Utf8JsonWriter -> 'DeclaringType -> JsonSerializerOptions -> unit> with + member _.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = + fun writer value options -> + if isFile then + let str = box (shape.Get value) |> unbox + writer.WriteStringValue($"attach://{str}") + else + let v = shape.Get value + let converter = options.GetConverter(v.GetType()) + let c = converter :?> JsonConverter<'a> + c.Write(writer, v, options) + } + + [] + type IUnionDeserializer<'T> = + abstract member Deserialize: reader: byref * options: JsonSerializerOptions -> 'T + + type CaseFullDeserializer<'DeclaringType, 'Field>(shape: ShapeMember<'DeclaringType, 'Field>, init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, options: JsonSerializerOptions) = + let converter = options.GetConverter(typeof<'DeclaringType>) :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'DeclaringType>, options) |> shape.Set (init ()) + + type CaseNameDeserializer<'DeclaringType>(init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, _: JsonSerializerOptions) = + reader.Read() |> ignore + init () + + let mkMemberDeserializer (case: ShapeFSharpUnionCase<'DeclaringType>) (init: unit -> 'DeclaringType) = + if case.Fields.Length = 0 then + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, _) = + //reader.Read() |> ignore + init () + } + else + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, IUnionDeserializer<'DeclaringType>> with + member x.Visit (shape: ShapeMember<'DeclaringType, 'Field>) = + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, options) = + let converter = options.GetConverter(typeof<'Field>) + let converter = converter :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'Field>, options) |> shape.Set (init ()) + } + } + + type DiscriminatedUnionConverter<'a>() = + inherit JsonConverter<'a>() + + let shape = shapeof<'a> + let union = + match shape with + | Shape.FSharpUnion (:? ShapeFSharpUnion<'a> as union) -> union + | _ -> failwith "Unsupported type" + + let enumUnion = union.UnionCases |> Seq.forall (fun x -> x.Fields.Length = 0) + + let cases = + union.UnionCases + |> Seq.map (fun c -> + if c.Fields.Length = 0 then + let dataMember = + c.CaseInfo.GetCustomAttributes(typeof) + |> Seq.cast + |> Seq.filter (fun x -> String.IsNullOrEmpty(x.Name) |> not) + |> Seq.toArray + + let name = + if dataMember.Length > 0 + then dataMember[0].Name + else c.CaseInfo.Name |> toSnakeCase + (Set.ofList [name], None) + else + let tp = c.Fields[0].Member.Type + if tp.IsPrimitive then (Set.empty, Some tp) + else (tp.GetProperties() + |> Seq.map(fun x -> x.Name |> toSnakeCase) + |> Set.ofSeq, + None)) + |> Seq.toArray + + let serializers = + union.UnionCases + |> Seq.map mkMemberSerializer + |> Seq.toArray + + let deserializers = + union.UnionCases + |> Seq.map (fun case -> mkMemberDeserializer case case.CreateUninitialized) + |> Seq.toArray + + override x.Write(writer, value, options) = + let serialize = serializers[union.GetTag value] // all union cases + serialize writer value options + + member x.ReadCasesOnly(reader: byref) = + let mutable types: Type list = [] + let caseNames = List() + + let reader = reader // copy reader + let mutable loop = true + let mutable first = true + + if reader.TokenType = JsonTokenType.StartObject then + reader.Read() |> ignore + + while loop do + let token = reader.TokenType + if first && not enumUnion then + loop <- false + types <- + match token with + | JsonTokenType.True | JsonTokenType.False -> [typeof] + | JsonTokenType.String -> [typeof] + | JsonTokenType.Number -> [typeof;typeof;typeof;typeof] + | _ -> + types + + if types.Length > 0 then + loop <- false + + first <- false + + if enumUnion then + caseNames.Add(reader.GetString()) + reader.Read() |> ignore + loop <- false + else + match token with + | JsonTokenType.PropertyName -> + caseNames.Add(reader.GetString()) + | JsonTokenType.StartObject + | JsonTokenType.StartArray -> + reader.Skip() + | _ -> () + + loop <- reader.Read() + + caseNames, types + + override x.Read(reader, _, options) = + let jsonCaseNames, jsonCaseTypes = x.ReadCasesOnly(&reader) + + let idx = + cases + |> Array.tryFindIndex (fun (caseNames, tp) -> + (jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value)) + && jsonCaseNames |> Seq.forall (fun n -> + caseNames |> Set.contains n)) + + match idx with + | Some idx -> + deserializers[idx].Deserialize(&reader, options) + | None -> + // try to find most similar type + let item = + cases |> Array.maxBy (fun (caseNames, tp) -> + if jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value) then + jsonCaseNames |> Seq.sumBy (fun n -> if caseNames |> Set.contains n then 1 else 0) + else + -1 + ) + + let idx = cases |> Array.findIndex (fun x -> x = item) + deserializers[idx].Deserialize(&reader, options) + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type DiscriminatedUnionConverterFactory() = + inherit JsonConverterFactory() + + override x.CreateConverter(typeToConvert, _) = + let g = typedefof>.MakeGenericType(typeToConvert) + Activator.CreateInstance(g) :?> JsonConverter + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type UnixTimestampDateTimeConverter() = + inherit JsonConverter() + let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + + override x.Read(reader, _, _) = + let v = reader.GetInt64() |> float + unixEpoch.AddSeconds(v) + + override x.Write(writer, value, _) = + writer.WriteNumberValue(toUnix value) + + type OptionConverter<'T>() = + inherit JsonConverter>() + + override x.Read(reader, _, options) = + match reader.TokenType with + | JsonTokenType.Null -> + None + | _ -> + let converter = options.GetConverter(typeof<'T>) + let c = converter :?> JsonConverter<'T> + c.Read(&reader, typeof<'T>, options) |> Some + + override x.Write(writer, value, options) = + match value with + | Some v -> + let converter = options.GetConverter(typeof<'T>) + let c = converter :?> JsonConverter<'T> + c.Write(writer, v, options) + | None -> + writer.WriteNullValue() + + // The FSharpOptionTypeConverter in STJ seems to be broken + // There is no stable repro to check this, so I used my own Option converter + type OptionConverterFactory() = + inherit JsonConverterFactory() + + override x.CreateConverter(typeToConvert, _) = + let innerType = typeToConvert.GetGenericArguments()[0] + let optionConverterType = typedefof>.MakeGenericType(innerType) + Activator.CreateInstance(optionConverterType) :?> JsonConverter + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> true + | _ -> false + \ No newline at end of file diff --git a/src/Funogram/Funogram.fsproj b/src/Funogram/Funogram.fsproj index 18a1057..2af75de 100644 --- a/src/Funogram/Funogram.fsproj +++ b/src/Funogram/Funogram.fsproj @@ -3,7 +3,7 @@ netstandard2.0 - 2.0.10 + 3.0.0 Nikolay Matyushin Funogram Funogram is a functional Telegram Bot Api library for F# @@ -18,16 +18,16 @@ - + + + - - diff --git a/src/Funogram/Resolvers.fs b/src/Funogram/Resolvers.fs deleted file mode 100644 index eeba3e7..0000000 --- a/src/Funogram/Resolvers.fs +++ /dev/null @@ -1,227 +0,0 @@ -namespace Funogram - -open System -open System.IO -open System.Runtime.CompilerServices -open System.Runtime.Serialization -open System.Text -open Utf8Json - -[] -do () -module internal Resolvers = - - open TypeShape.Core - - let getSnakeCaseName (name: string) = - let chars = - seq { - let chars = name.ToCharArray() - for i in 0 .. chars.Length - 1 do - let c = chars.[i] - if Char.IsUpper(c) then - if i = 0 then - yield Char.ToLowerInvariant(c) - else if (Char.IsUpper(chars.[i - 1])) then - yield Char.ToLowerInvariant(c) - else - yield '_' - yield Char.ToLowerInvariant(c) - else yield c - } - String.Concat(chars).ToLower() - - let mkMemberSerializer (case: ShapeFSharpUnionCase<'DeclaringType>) = - let isFile = - case.Fields.Length = 2 - && case.Fields[0].Member.Type = typeof - && (case.Fields[1].Member.Type = typeof || case.Fields[1].Member.Type = typeof) - - if case.Fields.Length = 0 then - fun _ _ -> Encoding.UTF8.GetBytes(getSnakeCaseName case.CaseInfo.Name |> sprintf "\"%s\"") - else - case.Fields.[0].Accept { new IMemberVisitor<'DeclaringType, 'DeclaringType -> IJsonFormatterResolver -> byte[]> with - member _.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = - fun value resolver -> - let mutable myWriter = JsonWriter() - - if isFile then - let str = box (shape.Get value) |> unbox - myWriter.WriteString(sprintf "attach://%s" str) - else - resolver.GetFormatterWithVerify<'Field>() - .Serialize(&myWriter, shape.Get value, resolver) - myWriter.ToUtf8ByteArray() - } - - let mkMemberDeserializer (case: ShapeFSharpUnionCase<'DeclaringType>) (init: unit -> 'DeclaringType) = - if case.Fields.Length = 0 then - fun value offset _ -> - let mutable myReader = JsonReader(value, offset) - myReader.ReadNext() - let offset = myReader.GetCurrentOffsetUnsafe() - (init(), offset) - else - case.Fields.[0].Accept { new IMemberVisitor<'DeclaringType, byte[] -> int -> IJsonFormatterResolver -> ('DeclaringType * int)> with - member __.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = - fun value offset resolver -> - let mutable myReader = JsonReader(value, offset) - let v = - resolver.GetFormatterWithVerify<'Field>() - .Deserialize(&myReader, resolver) - let offset = myReader.GetCurrentOffsetUnsafe() - (shape.Set (init()) v, offset) - } - - type FunogramDiscriminatedUnionFormatter<'a>() = - - let shape = Core.shapeof<'a> - let union = - match shape with - | Shape.FSharpUnion (:? ShapeFSharpUnion<'a> as union) -> union - | _ -> failwith "Unsupported type" - - let enumUnion = union.UnionCases |> Seq.forall (fun x -> x.Fields.Length = 0) - - let cases = - union.UnionCases - |> Seq.map (fun c -> - if c.Fields.Length = 0 then - let dataMember = - c.CaseInfo.GetCustomAttributes(typeof) - |> Seq.cast - |> Seq.filter (fun x -> String.IsNullOrEmpty(x.Name) |> not) - |> Seq.toArray - - let name = - if dataMember.Length > 0 - then dataMember.[0].Name - else c.CaseInfo.Name |> getSnakeCaseName - (Set.ofList [name], None) - else - let tp = c.Fields.[0].Member.Type - if tp.IsPrimitive then (Set.empty, Some tp) - else (tp.GetProperties() - |> Seq.map(fun x -> x.Name |> getSnakeCaseName) - |> Set.ofSeq, - None)) - |> Seq.toArray - - let serializers = - union.UnionCases - |> Seq.map (fun case -> mkMemberSerializer case) - |> Seq.toArray - - let deserializers = - union.UnionCases - |> Seq.map (fun case -> mkMemberDeserializer case case.CreateUninitialized) - |> Seq.toArray - - // this serializer/deserializer is used to match union case by set of fields - interface IJsonFormatter<'a> with - member x.Serialize(writer, value, resolver) = - let serialize = serializers.[union.GetTag value] // all union cases - writer.WriteRaw(serialize value resolver) - - member x.Deserialize(reader, resolver) = - // read list of properties - let mutable loop = true - - let buffer = reader.GetBufferUnsafe() - let offset = reader.GetCurrentOffsetUnsafe() - - let propReader = JsonReader(buffer, offset) - let mutable readProperty = false - let mutable level = 0 - let mutable types: Type list = [] - - let (jsonCaseNames, jsonCaseTypes) = - (seq { - while loop do - let token = propReader.GetCurrentJsonToken() - - if level = 0 && token <> JsonToken.BeginObject && enumUnion |> not then - types <- - match token with - | JsonToken.True | JsonToken.False -> [typeof] - | JsonToken.String -> - [typeof] - | JsonToken.Number -> [typeof;typeof;typeof;typeof] - | _ -> failwith "Unknown type!" - loop <- false - else if enumUnion then - yield propReader.ReadString() - loop <- false - else - match token with - | JsonToken.BeginObject -> - level <- level + 1 - readProperty <- true - | JsonToken.EndObject -> - level <- level - 1 - | JsonToken.ValueSeparator -> - readProperty <- true - | JsonToken.None -> loop <- false - | _ -> () - - if readProperty && level = 1 then - propReader.ReadNext() - yield propReader.ReadPropertyName() - readProperty <- false - else if level = 0 then - loop <- false - else - readProperty <- false - propReader.ReadNext() - } |> Seq.toList, types) - - let idx = - cases - |> Array.tryFindIndex (fun (caseNames, tp) -> - (jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value)) - && jsonCaseNames |> Seq.forall (fun n -> - caseNames |> Set.contains n)) - match idx with - | Some idx -> - let value, newOffset = deserializers.[idx] buffer offset resolver - reader.AdvanceOffset(newOffset - offset) - value - | None -> - // try to find most similar type - let item = - cases |> Array.maxBy (fun (caseNames, tp) -> - if jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value) then - jsonCaseNames |> Seq.sumBy (fun n -> if caseNames |> Set.contains n then 1 else 0) - else - -1 - ) - - let idx = cases |> Array.findIndex (fun x -> x = item) - let value, newOffset = deserializers.[idx] buffer offset resolver - reader.AdvanceOffset(newOffset - offset) - value - // failwithf "Internal error: Cannot match type \"%s\" by fields. Please create issue on https://github.com/Dolfik1/Funogram/issues" typeof<'a>.FullName - - let private unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) - let toUnix (x: DateTime) = (x.ToUniversalTime() - unixEpoch).TotalSeconds |> int64 - - type FunogramUnixTimestampDateTimeFormatter() = - let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) - interface IJsonFormatter with - member x.Serialize(writer, value, _) = - writer.WriteInt64(toUnix value) - - member x.Deserialize(reader, _) = - let v = reader.ReadInt64() |> float - unixEpoch.AddSeconds(v) - - type FunogramResolver() = - interface IJsonFormatterResolver with - member x.GetFormatter<'a>(): IJsonFormatter<'a> = - match shapeof<'a> with - | Shape.FSharpOption _ -> null - | Shape.FSharpUnion _ -> - FunogramDiscriminatedUnionFormatter<'a>() :> IJsonFormatter<'a> - | _ -> null - - static member Instance = FunogramResolver() \ No newline at end of file diff --git a/src/Funogram/StringUtils.fs b/src/Funogram/StringUtils.fs new file mode 100644 index 0000000..e1668e3 --- /dev/null +++ b/src/Funogram/StringUtils.fs @@ -0,0 +1,24 @@ +module Funogram.StringUtils + +open System +open System.Linq.Expressions +open System.Reflection + +let toSnakeCase = + let assembly = Assembly.Load("System.Text.Json") + let fullName = "System.Text.Json" + "." + "JsonSnakeCaseLowerNamingPolicy" + let t = assembly.GetType(fullName, true, true) + let instance = Activator.CreateInstance(t) + + let createConvertNameFunc instance = + let t = instance.GetType() + let method = t.GetMethod("ConvertName", BindingFlags.Public ||| BindingFlags.Instance) + let instanceExpr = Expression.Constant(instance) + let paramExpr = Expression.Parameter(typeof) + let callExpr = Expression.Call(instanceExpr, method, paramExpr) + let lambda = Expression.Lambda>(callExpr, paramExpr) + lambda.Compile() + + // not good solution, but fastest + let fn = createConvertNameFunc instance + fn.Invoke \ No newline at end of file diff --git a/src/Funogram/Tools.fs b/src/Funogram/Tools.fs index 95841f8..598be01 100644 --- a/src/Funogram/Tools.fs +++ b/src/Funogram/Tools.fs @@ -5,9 +5,9 @@ open System.Net open System.Net.Http open System.Runtime.CompilerServices open System.Text +open System.Text.Json +open System.Text.Json.Serialization open Funogram.Types -open Utf8Json -open Utf8Json.Resolvers [] [] @@ -16,25 +16,20 @@ do () open System.Collections.Concurrent open System.IO open System.Linq.Expressions -open Funogram.Resolvers +open Funogram.Converters open TypeShape.Core -open Utf8Json.FSharp -let internal formatters: IJsonFormatter[] = [| - FunogramUnixTimestampDateTimeFormatter() -|] - -let internal resolvers: IJsonFormatterResolver[] =[| - FunogramResolver.Instance - FSharpResolver.Instance - StandardResolver.ExcludeNullSnakeCase -|] - -let internal resolver = - Resolvers.CompositeResolver.Create( - formatters, - resolvers - ) +let internal options = + let o = + JsonSerializerOptions( + WriteIndented = false, + PropertyNamingPolicy = JsonNamingPolicy.SnakeCaseLower, + DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull + ) + o.Converters.Add(DiscriminatedUnionConverterFactory()) + o.Converters.Add(UnixTimestampDateTimeConverter()) + o.Converters.Add(OptionConverterFactory()) + o let private getUrl (config: BotConfig) methodName = let botToken = sprintf "%s%s" (config.ApiEndpointUrl |> string) config.Token @@ -49,22 +44,22 @@ let internal getUnix (date: DateTime) = let internal parseJson<'a> (data: byte[]) = try - match JsonSerializer.Deserialize>(data, resolver) with + match JsonSerializer.Deserialize>(data, options) with | x when x.Ok && x.Result.IsSome -> Ok x.Result.Value | x when x.Description.IsSome && x.ErrorCode.IsSome -> Error { Description = x.Description.Value ErrorCode = x.ErrorCode.Value } - | _ -> + | x -> Error { Description = "Unknown error" ErrorCode = -1 } with ex -> - let json = System.Text.Encoding.UTF8.GetString data + let json = Encoding.UTF8.GetString data let message = sprintf "%s in %s" ex.Message json ArgumentException(message, ex) |> raise let internal parseJsonStream<'a> (data: Stream) = try - JsonSerializer.Deserialize<'a>(data, resolver) |> Ok + JsonSerializer.Deserialize<'a>(data, options) |> Ok with ex -> if data.CanSeek then data.Seek(0L, SeekOrigin.Begin) |> ignore @@ -72,7 +67,7 @@ let internal parseJsonStream<'a> (data: Stream) = let message = sprintf "%s in %s" ex.Message (sr.ReadToEnd()) ArgumentException(message, ex) :> Exception |> Result.Error else - Exception("Can't parse json") |> Result.Error + Exception("Unable to parse json") |> Result.Error let internal parseJsonStreamApiResponse<'a> (data: Stream) = match parseJsonStream> data with @@ -88,7 +83,7 @@ let internal parseJsonStreamApiResponse<'a> (data: Stream) = Error { Description = "Unknown error"; ErrorCode = -1 } [] -let toJson (o: 'a) = JsonSerializer.Serialize<'a>(o, resolver) +let toJson (o: 'a) = JsonSerializer.SerializeToUtf8Bytes<'a>(o, options) let private toJsonMethodInfo = System.Reflection.Assembly.GetExecutingAssembly() @@ -246,7 +241,7 @@ module Api = let casePrinters = cases |> Array.map mkUnionCasePrinter // generate printers for all union cases fun (u:'T) -> let tag : int = shape.GetTag u // get the underlying tag for the union case - casePrinters.[tag] u + casePrinters[tag] u | _ -> fun _ -> [||] let multipartSerializers = ConcurrentDictionary MultipartFormDataContent -> bool>() @@ -324,7 +319,7 @@ module Api = fun (x: 'T) prop data -> if String.IsNullOrEmpty(prop) then fieldPrinters - |> Array.map (fun (prop, fp) -> fp x (getSnakeCaseName prop) data) + |> Array.map (fun (prop, fp) -> fp x (StringUtils.toSnakeCase prop) data) |> Array.contains true else let json = toJson x @@ -384,7 +379,7 @@ module Api = else None if isEnum then - let name = getSnakeCaseName case.CaseInfo.Name + let name = StringUtils.toSnakeCase case.CaseInfo.Name fun _ (prop: string) (data: MultipartFormDataContent) -> data.Add(strf "%s" name, prop) $ true else @@ -406,7 +401,7 @@ module Api = let casePrinters = cases |> Array.map mkUnionCasePrinter // generate printers for all union cases fun (u:'T) -> let tag : int = shape.GetTag u // get the underlying tag for the union case - casePrinters.[tag] u + casePrinters[tag] u | _ -> fun _ _ _ -> false @@ -445,8 +440,8 @@ module Api = let url = getUrl config request.MethodName use ms = new MemoryStream() - JsonSerializer.Serialize(ms, request, resolver) - + JsonSerializer.Serialize(ms, request, options) + use content = new StreamContent(ms) let! result = client.PostAsync(url, content) |> Async.AwaitTask diff --git a/src/examples/Funogram.Examples.AnonChat/Program.fs b/src/examples/Funogram.Examples.AnonChat/Program.fs index 47e6e48..104c25a 100644 --- a/src/examples/Funogram.Examples.AnonChat/Program.fs +++ b/src/examples/Funogram.Examples.AnonChat/Program.fs @@ -62,7 +62,7 @@ let usersState = state elif state.SearchUsers.Length > 0 then let idx = rnd.Next(0, state.SearchUsers.Length - 1) - let newTalkerId = state.SearchUsers.[idx] + let newTalkerId = state.SearchUsers[idx] sendMessage from.Id anonFoundText ctx diff --git a/src/examples/Funogram.TestBot/Commands/Base.fs b/src/examples/Funogram.TestBot/Commands/Base.fs index 8ad9732..cf41c45 100644 --- a/src/examples/Funogram.TestBot/Commands/Base.fs +++ b/src/examples/Funogram.TestBot/Commands/Base.fs @@ -25,9 +25,10 @@ let defaultText = """⭐️Available test commands: /cmdscan stringA stringB - Test cmdScan, concatenate stringA and stringB""" let updateArrived (ctx: UpdateContext) = - let fromId () = ctx.Update.Message.Value.From.Value.Id - let wrap fn = fn ctx.Config (fromId ()) + let wrap fn = + let fromId () = ctx.Update.Message.Value.From.Value.Id + fn ctx.Config (fromId ()) let result = processCommands ctx [| @@ -55,4 +56,17 @@ let updateArrived (ctx: UpdateContext) = |] if result then - Api.sendMessage (fromId()) defaultText |> bot ctx.Config \ No newline at end of file + match ctx.Update.CallbackQuery with + | Some ({ Data = Some "callback2" } as c) -> + match c.Message with + | Some (MaybeInaccessibleMessage.Message msg) -> + let inlineKeyboardMarkup = InlineKeyboardMarkup.Create([| [| InlineKeyboardButton.Create("Changed!", callbackData = "Test") |] |]) + Req.EditMessageReplyMarkup.Make(msg.Chat.Id, msg.MessageId, replyMarkup = inlineKeyboardMarkup) + |> bot ctx.Config + | _ -> () + | _ -> () + + match ctx.Update.Message with + | Some { From = Some { Id = id } } -> + Api.sendMessage id defaultText |> bot ctx.Config + | _ -> () \ No newline at end of file diff --git a/src/examples/Funogram.TestBot/Commands/Markup.fs b/src/examples/Funogram.TestBot/Commands/Markup.fs index 983f45b..9c15229 100644 --- a/src/examples/Funogram.TestBot/Commands/Markup.fs +++ b/src/examples/Funogram.TestBot/Commands/Markup.fs @@ -18,7 +18,8 @@ let testRemoveKeyboard config chatId = let testInlineKeyboard config chatId = let keyboard = [| - [| InlineKeyboardButton.Create("Test", callbackData = "1234") |] + [| InlineKeyboardButton.Create("Test", callbackData = "callback1") |] + [| InlineKeyboardButton.Create("Replace", callbackData = "callback2") |] |] let markup = Markup.InlineKeyboardMarkup { InlineKeyboard = keyboard } sendMessageMarkup "That's inline keyboard!" markup config chatId \ No newline at end of file