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