1 #Region "Microsoft.VisualBasic::e5dbeaec1a44c005764fd668cd6e4c81, Microsoft.VisualBasic.Core\Serialization\JSON\JsonSerialization.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     '     Module JsonContract
35     
36     '         Function: EnsureDate, GetJson, GetObjectJson, LoadJsonFile, LoadJSONObject
37     '                   (+3 Overloads) LoadObject, MatrixJson, RemoveJsonNullItems, WriteLargeJson
38     
39     '         Sub: writeJsonInternal
40     
41     
42     ' /********************************************************************************/
43
44 #End Region
45
46 Imports System.IO
47 Imports System.Runtime.CompilerServices
48 Imports System.Runtime.Serialization.Json
49 Imports System.Text
50 Imports System.Text.RegularExpressions
51 Imports System.Web.Script.Serialization
52 Imports Microsoft.VisualBasic.CommandLine.Reflection
53 Imports Microsoft.VisualBasic.Language
54 Imports Microsoft.VisualBasic.Linq
55 Imports Microsoft.VisualBasic.Scripting.MetaData
56 Imports Microsoft.VisualBasic.Text
57 Imports Factory = System.Runtime.Serialization.Json.DataContractJsonSerializer
58 Imports r = System.Text.RegularExpressions.Regex
59
60 Namespace Serialization.JSON
61
62     ''' <summary>
63     ''' Only works on the Public visible type.
64     ''' (使用.NET系统环境之中自带的框架进行JSON序列化和反序列化)
65     ''' </summary>
66     <Package("Json.Contract")> Public Module JsonContract
67
68         <Extension>
69         Public Function MatrixJson(matrix As Double()()) As String
70             Dim rows = matrix.Select(Function(row) $"[ {row.JoinBy("")} ]")
71             Dim json = $"[ {rows.JoinBy("," & ASCII.LF)} ]"
72             Return json
73         End Function
74
75         ''' <summary>
76         ''' 使用<see cref="ScriptIgnoreAttribute"/>来屏蔽掉不想序列化的属性
77         ''' </summary>
78         ''' <param name="obj"></param>
79         ''' <param name="type"></param>
80         ''' <returns></returns>
81         <ExportAPI("Get.Json")>
82         <Extension>
83         Public Function GetObjectJson(type As Type, obj As Object,
84                                       Optional indent As Boolean = True,
85                                       Optional simpleDict As Boolean = True,
86                                       Optional knownTypes As IEnumerable(Of Type) = NothingAs String
87
88             Using ms As New MemoryStream()
89                 Call ms.writeJsonInternal(
90                     obj:=obj,
91                     type:=type,
92                     simpleDict:=simpleDict,
93                     knownTypes:=knownTypes
94                 )
95
96                 If indent Then
97                     Return Formatter.Format(Encoding.UTF8.GetString(ms.ToArray()))
98                 Else
99                     Return Encoding.UTF8.GetString(ms.ToArray())
100                 End If
101             End Using
102         End Function
103
104         <MethodImpl(MethodImplOptions.AggressiveInlining)>
105         <Extension>
106         Private Sub writeJsonInternal(output As Stream, obj As Object, type As Type, simpleDict As Boolean, knownTypes As IEnumerable(Of Type))
107             If simpleDict Then
108                 Dim settings As New DataContractJsonSerializerSettings With {
109                     .UseSimpleDictionaryFormat = True,
110                     .SerializeReadOnlyTypes = True,
111                     .KnownTypes = knownTypes _
112                         .SafeQuery _
113                         .ToArray
114                 }
115                 Call New Factory(type, settings).WriteObject(output, obj)
116             Else
117                 Call New Factory(type).WriteObject(output, obj)
118             End If
119         End Sub
120
121         ''' <summary>
122         ''' 将目标对象保存为json文件
123         ''' </summary>
124         ''' <typeparam name="T"></typeparam>
125         ''' <param name="obj"></param>
126         ''' <param name="path"></param>
127         ''' <returns></returns>
128         <Extension>
129         Public Function WriteLargeJson(Of T)(obj As T, path$, Optional simpleDict As Boolean = TrueAs Boolean
130             Using ms As FileStream = path.Open(, doClear:=True)
131                 Call ms.writeJsonInternal(obj, GetType(T), simpleDict, Nothing)
132             End Using
133
134             Return True
135         End Function
136
137         ''' <summary>
138         ''' 有些javascript程序(例如highcharts.js)要求json里面不可以出现null的属性,可以使用这个方法进行移除
139         ''' </summary>
140         ''' <param name="json"></param>
141         ''' <returns></returns>
142         <MethodImpl(MethodImplOptions.AggressiveInlining)>
143         <Extension>
144         Public Function RemoveJsonNullItems(json As StringAs String
145             Return r.Replace(json, """[^""]+""[:]\s*null\s*,?", "", RegexICSng)
146         End Function
147
148         ''' <summary>
149         ''' Gets the json text value of the target object, the attribute <see cref="ScriptIgnoreAttribute"/> 
150         ''' can be used for block the property which is will not serialize to the text.
151         ''' (使用<see cref="ScriptIgnoreAttribute"/>来屏蔽掉不想序列化的属性)
152         ''' </summary>
153         ''' <typeparam name="T"></typeparam>
154         ''' <param name="obj"></param>
155         ''' <returns></returns>
156         ''' <remarks>
157         ''' 2016-11-9 对字典进行序列化的时候,假若对象类型是从字典类型继承而来的,则新的附加属性并不会被序列化,只会序列化字典本身
158         ''' </remarks>
159         ''' 
160         <MethodImpl(MethodImplOptions.AggressiveInlining)>
161         <Extension> Public Function GetJson(Of T)(obj As T,
162                                                   Optional indent As Boolean = False,
163                                                   Optional simpleDict As Boolean = True,
164                                                   Optional knownTypes As IEnumerable(Of Type) = NothingAs String
165             Return GetType(T).GetObjectJson(obj, indent, simpleDict, knownTypes)
166         End Function
167
168         ''' <summary>
169         ''' 
170         ''' </summary>
171         ''' <param name="json">null -> Nothing</param>
172         ''' <param name="type"></param>
173         ''' <returns></returns>
174         <ExportAPI("LoadObject")>
175         <Extension>
176         Public Function LoadObject(json$,
177                                    type As Type,
178                                    Optional simpleDict As Boolean = True,
179                                    Optional throwEx As Boolean = True,
180                                    Optional ByRef exception As Exception = NothingAs Object
181
182             If String.Equals(json, "null"StringComparison.OrdinalIgnoreCase) Then
183                 Return Nothing
184             End If
185
186             Using MS As New MemoryStream(Encoding.UTF8.GetBytes(json))
187                 Dim settings As New DataContractJsonSerializerSettings With {
188                     .UseSimpleDictionaryFormat = simpleDict,
189                     .SerializeReadOnlyTypes = True
190                 }
191                 Dim ser As New DataContractJsonSerializer(type, settings)
192                 Dim de As Func(Of Object) = Function() ser.ReadObject(MS)
193                 Dim obj = TryCatch(de, $"Incorrect JSON string format => >>>{json}<<<", throwEx, exception)
194                 Return obj
195             End Using
196         End Function
197
198         <Extension>
199         Public Function LoadJSONObject(jsonStream As Stream, type As Type, Optional simpleDict As Boolean = TrueAs Object
200             If jsonStream Is Nothing Then
201                 Return Nothing
202             Else
203                 Dim settings As New DataContractJsonSerializerSettings With {
204                     .UseSimpleDictionaryFormat = simpleDict,
205                     .SerializeReadOnlyTypes = True
206                 }
207                 Return New DataContractJsonSerializer(type, settings) _
208                     .ReadObject(jsonStream)
209             End If
210         End Function
211
212         ''' <summary>
213         ''' 从文本文件或者文本内容之中进行JSON反序列化
214         ''' </summary>
215         ''' <param name="json">This string value can be json text or json file path.</param>
216         <Extension> Public Function LoadObject(Of T)(json$,
217                                                      Optional simpleDict As Boolean = True,
218                                                      Optional throwEx As Boolean = True,
219                                                      Optional ByRef exception As Exception = NothingAs T
220             Dim text$ = json.SolveStream(Encodings.UTF8)
221             Dim value As Object = text.LoadObject(GetType(T), simpleDict, throwEx, exception)
222             Dim obj As T = DirectCast(value, T)
223             Return obj
224         End Function
225
226         ''' <summary>
227         ''' XML CDATA to json
228         ''' </summary>
229         ''' <typeparam name="T"></typeparam>
230         ''' <param name="json"></param>
231         ''' <param name="simpleDict"></param>
232         ''' <returns></returns>
233         ''' 
234         <MethodImpl(MethodImplOptions.AggressiveInlining)>
235         <Extension>
236         Public Function LoadObject(Of T As New)(json As XElement, Optional simpleDict As Boolean = TrueAs T
237             Return json.Value.LoadObject(Of T)(simpleDict:=simpleDict)
238         End Function
239
240         Public Function LoadJsonFile(Of T)(file As StringOptional encoding As Encoding = NothingOptional simpleDict As Boolean = TrueAs T
241             Dim json As String = IO.File.ReadAllText(file, If(encoding Is Nothing, Encoding.Default, encoding))
242             Return json.LoadObject(Of T)(simpleDict)
243         End Function
244
245         Const JsonLongTime$ = "\d+-\d+-\d+T\d+:\d+:\d+\.\d+"
246
247         Public Function EnsureDate(json$, Optional propertyName$ = NothingAs String
248             Dim pattern$ = $"""{JsonLongTime}"""
249
250             If Not propertyName.StringEmpty Then
251                 pattern = $"""{propertyName}""\s*:\s*" & pattern
252             End If
253
254             Dim dates = r.Matches(json, pattern, RegexICSng)
255             Dim sb As New StringBuilder(json)
256             Dim [date] As Date
257
258             For Each m As Match In dates
259                 Dim s$ = m.Value
260
261                 If Not propertyName.StringEmpty Then
262                     With r.Replace(s, $"""{propertyName}""\s*:", "", RegexICSng) _
263                         .Trim _
264                         .Trim(ASCII.Quot)
265
266                         [date] = Date.Parse(.ByRef)
267                     End With
268                     sb.Replace(s, $"""{propertyName}"":" & [date].GetJson)
269                 Else
270                     [date] = Date.Parse(s.Trim(ASCII.Quot))
271                     sb.Replace(s, [date].GetJson)
272                 End If
273             Next
274
275             Return sb.ToString
276         End Function
277     End Module
278 End Namespace