1	#Region "Microsoft.VisualBasic::c7f002a9b977f8b60c3e3492b6a7f209, Microsoft.VisualBasic.Core\ComponentModel\Settings\SimpleConfig.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	'     Class SimpleConfig
35	'
36	'         Properties: Name, TypeInfo
37	'
38	'         Constructor: (+1 Overloads) Sub New
39	'         Function: GenerateConfigurations, ToString, TryParse
40	'
41	'
42	' /********************************************************************************/
43
44	#End Region
45
46	Imports System.Reflection
47	Imports System.Runtime.CompilerServices
48	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel.DataFramework
49	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel.SchemaMaps
50	Imports Microsoft.VisualBasic.Language
51	Imports typeSchema = System.Reflection.TypeInfo
52
53	Namespace ComponentModel.Settings
54
55	#If NET_40 = 0 Then
56
57	<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=True)>
58	Public Class SimpleConfig : Inherits Attribute
59	Dim _ToLower As Boolean
60
61	Public Shared ReadOnly Property TypeInfo As Type = GetType(SimpleConfig)
62	Public ReadOnly Property Name As String
63
64	<MethodImpl(MethodImplOptions.AggressiveInlining)>
65	Sub New(Optional Name As String = "", Optional toLower As Boolean = True)
66	Me._Name = Name
67	Me._ToLower = toLower
68	End Sub
69
70	''' <summary>
71	''' Display <see cref="Name"/>
72	''' </summary>
73	''' <returns></returns>
74	Public Overrides Function ToString() As String
75	Return Name
76	End Function
77
78	''' <summary>
79	'''
80	''' </summary>
81	''' <typeparam name="T"></typeparam>
82	''' <typeparam name="TConfig"></typeparam>
83	''' <param name="canRead">向文件之中写数据的时候，需要设置为真</param>
84	''' <param name="canWrite">从文件之中读取数据的时候，需要设置为真</param>
85	''' <returns></returns>
86	''' <remarks></remarks>
87	Public Shared Iterator Function TryParse(Of T As Class, TConfig As SimpleConfig)(canRead As Boolean, canWrite As Boolean) As IEnumerable(Of BindProperty(Of TConfig))
88	Dim type As typeSchema = GetType(T)
89	Dim configType As Type = GetType(TConfig)
90	Dim properties = type.GetProperties(BindingFlags.Instance Or BindingFlags.Public)
91	Dim LQuery = LinqAPI.Exec(Of BindProperty(Of TConfig)) _
92	_
93	() <= From [property] As PropertyInfo
94	In properties
95	Let attrs As Object() = [property].GetCustomAttributes(
96	attributeType:=configType,
97	inherit:=True)
98	Let info As Type = [property].PropertyType
99	Where Not attrs.IsNullOrEmpty AndAlso StringParsers.ContainsKey(info)
100	Let attr = DirectCast(attrs.First, TConfig)
101	Select New BindProperty(Of TConfig)(attr, [property])
102
103	If LQuery.IsNullOrEmpty Then
104	Return
105	End If
106
107	For Each line As BindProperty(Of TConfig) In LQuery
108	Dim [property] As PropertyInfo = DirectCast(line.member, PropertyInfo)
109
110	If [property].CanRead AndAlso [property].CanWrite Then
111	' 同时满足可读和可写的属性直接添加
112	GoTo INSERT
113	End If
114
115	' 从这里开始的属性都是只读属性或者只写属性
116	If canRead = True Then
117	If [property].CanRead = False Then
118	Continue For
119	End If
120	End If
121	If canWrite = True Then
122	If [property].CanWrite = False Then
123	Continue For
124	End If
125	End If
126	INSERT:
127	If String.IsNullOrEmpty(line.field._Name) Then
128	If line.field._ToLower Then
129	line.field._Name = line.Identity.ToLower
130	Else
131	line.field._Name = line.Identity
132	End If
133	End If
134
135	' 这里为什么会出现重复的键名？？？
136	Yield New BindProperty(Of TConfig)(line.field, [property])
137	Next
138	End Function
139
140	''' <summary>
141	''' 从类型实体生成配置文件数据
142	''' </summary>
143	''' <typeparam name="T"></typeparam>
144	''' <param name="target"></param>
145	''' <returns></returns>
146	''' <remarks>类型实体之中的简单属性，只要具备可读属性即可被解析出来</remarks>
147	Public Shared Iterator Function GenerateConfigurations(Of T As Class)(target As T) As IEnumerable(Of String)
148	Dim type As Type = GetType(T)
149	Dim schema = TryParse(Of T, SimpleConfig)(canRead:=True, canWrite:=False).ToArray
150	Dim mlen As Integer = Aggregate cfg As SimpleConfig
151	In schema.Select(Function(x) x.field)
152	Let l = Len(cfg._Name)
153	Into Max(l)
154
155	Dim bufs As New List(Of String)
156
157	For Each [property] As BindProperty(Of SimpleConfig) In schema
158	Dim blank As New String(" ", mlen - Len([property].field._Name) + 2)
159	Dim Name As String = [property].field._Name & blank
160	Dim value As String = Scripting.ToString([property].GetValue(target))
161
162	Yield $"{Name}= {value}"
163	Next
164	End Function
165	End Class
166
167	#End If
168
169	End Namespace