1	#Region "Microsoft.VisualBasic::ed9a194d8b1d9f3b218a5301062a798e, Microsoft.VisualBasic.Core\ComponentModel\DataSource\DataFramework.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 DataFramework
35	'
36	'         Properties: Flags, StringBuilders, StringParsers
37	'
38	'         Constructor: (+1 Overloads) Sub New
39	'         Function: DictionaryTable, getOrCache, (+2 Overloads) Schema, ValueTable
40	'         Delegate Function
41	'
42	'             Function: __initSchema, CreateObject, GetValue, IsComplexType, IsNumericType
43	'                       IsPrimitive, valueToString
44	'
45	'
46	'
47	' /********************************************************************************/
48
49	#End Region
50
51	Imports System.Data
52	Imports System.Reflection
53	Imports System.Runtime.CompilerServices
54	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel.SchemaMaps
55	Imports Microsoft.VisualBasic.Language
56	Imports Microsoft.VisualBasic.Language.Default
57	Imports Microsoft.VisualBasic.Scripting.Runtime.NumberConversionRoutines
58	Imports Microsoft.VisualBasic.Serialization
59
60	Namespace ComponentModel.DataSourceModel
61
62	''' <summary>
63	''' 在目标对象中必须要具有一个属性有自定义属性<see cref="DataFrameColumnAttribute"></see>
64	''' </summary>
65	''' <remarks></remarks>
66	Public Module DataFramework
67
68	''' <summary>
69	''' Controls for <see cref="PropertyAccess"/> on <see cref="PropertyInfo"/>
70	''' </summary>
71	''' <returns></returns>
72	Public ReadOnly Property Flags As IReadOnlyDictionary(Of PropertyAccess, Assert(Of PropertyInfo))
73
74	Sub New()
75	Flags = New Dictionary(Of PropertyAccess, Assert(Of PropertyInfo)) From {
76	_
77	{PropertyAccess.Readable, Function(p) p.CanRead},
78	{PropertyAccess.ReadWrite, Function(p) p.CanRead AndAlso p.CanWrite},
79	{PropertyAccess.Writeable, Function(p) p.CanWrite}
80	}
81	End Sub
82
83	''' <summary>
84	''' 获取类型之中的属性列表
85	''' </summary>
86	''' <typeparam name="T"></typeparam>
87	''' <param name="flag"></param>
88	''' <param name="nonIndex"><see cref="PropertyInfo.GetIndexParameters"/> IsNullOrEmpty</param>
89	''' <returns></returns>
90	Public Function Schema(Of T)(flag As PropertyAccess,
91	Optional nonIndex As Boolean = False,
92	Optional primitive As Boolean = False) As Dictionary(Of String, PropertyInfo)
93
94	With GetType(T).Schema(flag,, nonIndex)
95	If primitive Then
96	Return .Keys _
97	.Where(Function(k)
98	Return .ByRef(k).PropertyType.IsPrimitive
99	End Function) _
100	.ToDictionary(Function(key) key,
101	Function(key) .ByRef(key))
102	Else
103	Return .ByRef
104	End If
105	End With
106	End Function
107
108	''' <summary>
109	''' (instance) ``Public Property xxxxx As xxxxx``
110	''' </summary>
111	Public Const PublicProperty As BindingFlags = BindingFlags.Public Or BindingFlags.Instance
112	''' <summary>
113	''' (statics) ``Public Shared Property xxxx As xxxx``
114	''' </summary>
115	Public Const PublicShared As BindingFlags = BindingFlags.Public Or BindingFlags.Static
116
117	''' <summary>
118	''' 请注意：对于VisualBasic的My.Resources.Resources类型而言，里面的属性都是Friend Shared访问类型的，
119	''' 所以在解析内部资源管理器对象的时候应该要特别注意<paramref name="binds"/>参数值的设置，
120	''' 因为这个参数默认是<see cref="PublicProperty"/>
121	''' </summary>
122	''' <param name="type"></param>
123	''' <param name="flag"></param>
124	''' <param name="binds"></param>
125	''' <param name="nonIndex"><see cref="PropertyInfo.GetIndexParameters"/> IsNullOrEmpty</param>
126	''' <returns></returns>
127	<Extension>
128	Public Function Schema(type As Type, flag As PropertyAccess,
129	Optional binds As BindingFlags = PublicProperty,
130	Optional nonIndex As Boolean = False) As Dictionary(Of String, PropertyInfo)
131
132	Dim props As IEnumerable(Of PropertyInfo) =
133	type _
134	.GetProperties(binds) _
135	.ToArray
136
137	props = props _
138	.Where(Flags(flag).AsLambda) _
139	.ToArray
140
141	If nonIndex Then
142	props = props _
143	.Where(Function(p) p.GetIndexParameters.IsNullOrEmpty)
144	End If
145
146	Return props.ToDictionary(Function(x) x.Name)
147	End Function
148
149	ReadOnly alwaysTrue As DefaultValue(Of Assert(Of Object)) = New Assert(Of Object)(Function() True)
150
151	''' <summary>
152	''' 将对象之中的所有属性值都取出来以字符串的形式生成一个字典对象
153	''' </summary>
154	''' <typeparam name="T"></typeparam>
155	''' <param name="x"></param>
156	''' <param name="where">用来判断属性值是否应该被添加进入字典之中</param>
157	''' <returns></returns>
158	<Extension>
159	Public Function DictionaryTable(Of T)(x As T,
160	Optional primitiveType As Boolean = False,
161	Optional where As Assert(Of Object) = Nothing) As Dictionary(Of String, String)
162
163	Dim schema As Dictionary(Of String, PropertyInfo) = GetType(T).getOrCache
164	Dim table As New Dictionary(Of String, String)
165	Dim obj
166
167	where = where Or alwaysTrue
168
169	If primitiveType Then
170	For Each key As String In schema.Keys.ToArray
171	If Not schema(key).PropertyType.IsPrimitive Then
172	Call schema.Remove(key)
173	End If
174	Next
175	End If
176
177	For Each key As String In schema.Keys
178	obj = schema(key).GetValue(x)
179
180	If where(obj) Then
181	table(key) = Scripting.ToString(obj)
182	End If
183	Next
184
185	Return table
186	End Function
187
188	<MethodImpl(MethodImplOptions.AggressiveInlining)>
189	<Extension>
190	Public Function ValueTable(Of T)(x As T) As Dictionary(Of String, Object)
191	Return GetType(T).getOrCache _
192	.ToDictionary(Function(p) p.Key,
193	Function(p)
194	Return p.Value.GetValue(x)
195	End Function)
196	End Function
197
198	''' <summary>
199	''' Helper for <see cref="DictionaryTable(Of T)"/>
200	''' </summary>
201	''' <param name="type"></param>
202	''' <returns></returns>
203	<Extension>
204	Private Function getOrCache(type As Type) As Dictionary(Of String, PropertyInfo)
205	Static schemaCache As New Dictionary(Of Type, Dictionary(Of String, PropertyInfo))
206
207	If Not schemaCache.ContainsKey(type) Then
208	' Gets all object instance property and also
209	' the properties should be public access
210	' without index access
211	schemaCache(type) = type.Schema(
212	PropertyAccess.Readable,
213	PublicProperty,
214	nonIndex:=True
215	)
216	End If
217
218	Return New Dictionary(Of String, PropertyInfo)(schemaCache(type))
219	End Function
220
221	#If NET_40 = 0 Then
222
223	''' <summary>
224	''' Converts the .NET primitive types from string.(将字符串数据类型转换为其他的数据类型)
225	''' </summary>
226	''' <remarks></remarks>
227	Public ReadOnly Property StringParsers As New Dictionary(Of Type, IStringParser) From {
228	_
229	{GetType(String), Function(strValue As String) strValue},
230	{GetType(Boolean), AddressOf ParseBoolean},
231	{GetType(DateTime), Function(strValue As String) CType(strValue, DateTime)},
232	{GetType(Double), AddressOf Val},
233	{GetType(Integer), Function(strValue As String) CInt(strValue)},
234	{GetType(Long), Function(strValue As String) CLng(strValue)},
235	{GetType(Single), Function(s) CSng(Val(s))},
236	{GetType(Char), Function(s) s.FirstOrDefault}
237	}
238
239	''' <summary>
240	''' Object <see cref="Object.ToString"/> methods.
241	''' </summary>
242	''' <returns></returns>
243	Public ReadOnly Property StringBuilders As New Dictionary(Of Type, IStringBuilder) From {
244	_
245	{GetType(String), Function(s) If(s Is Nothing, "", CStr(s))},
246	{GetType(Boolean), AddressOf DataFramework.valueToString},
247	{GetType(DateTime), AddressOf DataFramework.valueToString},
248	{GetType(Double), AddressOf DataFramework.valueToString},
249	{GetType(Integer), AddressOf DataFramework.valueToString},
250	{GetType(Long), AddressOf DataFramework.valueToString},
251	{GetType(Byte), AddressOf DataFramework.valueToString},
252	{GetType(ULong), AddressOf DataFramework.valueToString},
253	{GetType(UInteger), AddressOf DataFramework.valueToString},
254	{GetType(Short), AddressOf DataFramework.valueToString},
255	{GetType(UShort), AddressOf DataFramework.valueToString},
256	{GetType(Char), AddressOf DataFramework.valueToString},
257	{GetType(Single), AddressOf DataFramework.valueToString},
258	{GetType(SByte), AddressOf DataFramework.valueToString}
259	}
260
261	Public Delegate Function CTypeDynamics(obj As Object, ConvertType As Type) As Object
262
263	''' <summary>
264	''' 这个函数是为了提供转换的方法给字典对象<see cref="StringBuilders"/>
265	''' </summary>
266	''' <param name="o">
267	''' 因为<see cref="StringBuilders"/>要求的是<see cref="IStringBuilder"/>，
268	''' 即<see cref="Object"/>类型转换为字符串，所以在这里就不适用T泛型了，而是直接
269	''' 使用<see cref="Object"/>类型
270	''' </param>
271	''' <returns></returns>
272	<MethodImpl(MethodImplOptions.AggressiveInlining)>
273	Private Function valueToString(o) As String
274	Return CStrSafe(o)
275	End Function
276
277	''' <summary>
278	''' Is one of the primitive type in the hash <see cref="StringBuilders"/>?
279	''' </summary>
280	''' <param name="type"></param>
281	''' <returns></returns>
282	<MethodImpl(MethodImplOptions.AggressiveInlining)>
283	Public Function IsPrimitive(type As Type) As Boolean
284	Return StringBuilders.ContainsKey(type)
285	End Function
286
287	<MethodImpl(MethodImplOptions.AggressiveInlining)>
288	<Extension>
289	Public Function IsNumericType(type As Type) As Boolean
290	Static numerics As Type() = {
291	GetType(Integer), GetType(Long), GetType(Short), GetType(Double), GetType(Byte),
292	GetType(UInteger), GetType(ULong), GetType(UShort), GetType(Single), GetType(SByte), GetType(Decimal)
293	}
294	Return numerics.Any(Function(num) num Is type)
295	End Function
296
297	''' <summary>
298	''' 如果目标类型的属性之中值包含有基础类型，则是一个非复杂类型，反之包含任意一个非基础类型，则是一个复杂类型
299	''' </summary>
300	''' <param name="type"></param>
301	''' <returns></returns>
302	<MethodImpl(MethodImplOptions.AggressiveInlining)>
303	<Extension>
304	Public Function IsComplexType(type As Type) As Boolean
305	Return Not type _
306	.Schema(PropertyAccess.NotSure, PublicProperty, True) _
307	.Values _
308	.Where(Function(t) Not IsPrimitive(t.PropertyType)) _
309	.FirstOrDefault Is Nothing
310	End Function
311	#End If
312
313	''' <summary>
314	''' Convert target data object collection into a datatable for the data source of the <see cref="System.Windows.Forms.DataGridView"></see>>.
315	''' (将目标对象集合转换为一个数据表对象，用作DataGridView控件的数据源)
316	''' </summary>
317	''' <typeparam name="T"></typeparam>
318	''' <param name="source"></param>
319	''' <returns></returns>
320	''' <remarks></remarks>
321	Public Function CreateObject(Of T)(source As IEnumerable(Of T)) As DataTable
322	Dim columns = __initSchema(GetType(T))
323	Dim table As New DataTable
324	Dim type As Type
325
326	For Each column In columns.Values
327	type = DirectCast(column.member, PropertyInfo).PropertyType
328	Call table.Columns.Add(column.Identity, type)
329	Next
330
331	Dim fields As IEnumerable(Of BindProperty(Of DataFrameColumnAttribute)) =
332	columns.Values
333
334	For Each row As T In source
335	Dim LQuery = LinqAPI.Exec(Of Object) _
336	_
337	() <= From column As BindProperty(Of DataFrameColumnAttribute)
338	In fields
339	Select column.GetValue(row)
340
341	Call table.Rows.Add(LQuery)
342	Next
343
344	Return table
345	End Function
346
347	''' <summary>
348	''' Retrive data from a specific datatable object.(从目标数据表中获取数据)
349	''' </summary>
350	''' <typeparam name="T"></typeparam>
351	''' <param name="DataTable"></param>
352	''' <returns></returns>
353	''' <remarks></remarks>
354	Public Function GetValue(Of T)(DataTable As DataTable) As T()
355	Dim Columns = __initSchema(GetType(T))
356	Dim rtvlData As T() = New T(DataTable.Rows.Count - 1) {}
357	Dim i As Integer = 0
358
359	Dim Schema As List(Of KeyValuePair(Of Integer, PropertyInfo)) =
360	New List(Of KeyValuePair(Of Integer, PropertyInfo))
361	For Each column As DataColumn In DataTable.Columns
362	Dim LQuery As BindProperty(Of DataFrameColumnAttribute) =
363	LinqAPI.DefaultFirst(Of BindProperty(Of DataFrameColumnAttribute)) <=
364	From schemaColumn As BindProperty(Of DataFrameColumnAttribute)
365	In Columns.Values
366	Where String.Equals(schemaColumn.Identity, column.ColumnName)
367	Select schemaColumn
368
369	If Not LQuery.IsNull Then
370	Call Schema.Add(New KeyValuePair(Of Integer, PropertyInfo)(column.Ordinal, LQuery.member))
371	End If
372	Next
373
374	For Each row As DataRow In DataTable.Rows
375	Dim obj As T = Activator.CreateInstance(Of T)()
376	For Each column In Schema
377	Dim value = row.Item(column.Key)
378	If IsDBNull(value) OrElse value Is Nothing Then
379	Continue For
380	End If
381	Call column.Value.SetValue(obj, value, Nothing)
382	Next
383
384	rtvlData(i) = obj
385	i += 1
386	Next
387	Return rtvlData
388	End Function
389
390	Private Function __initSchema(type As Type) As Dictionary(Of String, BindProperty(Of DataFrameColumnAttribute))
391	Dim dataType As Type = GetType(DataFrameColumnAttribute)
392	Dim props As PropertyInfo() = type.GetProperties
393	Dim Columns = (From [property] As PropertyInfo
394	In props
395	Let attrs As Object() = [property].GetCustomAttributes(dataType, True)
396	Where Not attrs.IsNullOrEmpty
397	Select colMaps =
398	DirectCast(attrs.First, DataFrameColumnAttribute), [property]
399	Order By colMaps.Index Ascending).AsList
400
401	For Each column In Columns
402	If String.IsNullOrEmpty(column.colMaps.Name) Then
403	Call column.colMaps.SetNameValue(column.property.Name)
404	End If
405	Next
406
407	Dim unIndexColumn = (From col
408	In Columns
409	Where col.colMaps.Index <= 0
410	Select col  ' 未建立索引的对象按照名称排序
411	Order By col.colMaps.Name Ascending).ToArray ' 由于在后面会涉及到修改list对象，所以在这里使用ToArray来隔绝域list的关系，避免出现冲突
412
413	For Each col In unIndexColumn
414	Call Columns.Remove(col)
415	Call Columns.Add(col) '将未建立索引的对象放置到列表的最末尾
416	Next
417
418	Return Columns.ToDictionary(
419	Function(x) x.colMaps.Name,
420	Function(x) New BindProperty(Of DataFrameColumnAttribute)(x.colMaps, x.property))
421	End Function
422	End Module
423	End Namespace