1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233 | with Ada.Characters.Handling;
with Ada.Containers.Indefinite_Ordered_Maps;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Containers.Indefinite_Vectors;
package AAA.Strings with Preelaborate is
function Camel_To_Mixed (S : String) return String;
-- Converts ThisThing into This_Thing
function Contains (Full : String; Sub : String) return Boolean;
function Has_Prefix (Full : String; Prefix : String) return Boolean;
function Has_Suffix (Full : String; Suffix : String) return Boolean;
function Head (S : String; Separator : Character) return String;
-- if S contains Separator, the lhs is returned. Otherwise Str is returned.
function Head (S : String; Separator : String) return String;
-- if S contains Separator, the lhs is returned. Otherwise Str is returned.
function Tail (S : String; Separator : Character) return String;
-- If S contains Separator, the rhs is returned. Otherwise "".
function Tail (S : String; Separator : String) return String;
-- If S contains Separator, the rhs is returned. Otherwise "".
function To_Lower_Case (S : String) return String
renames Ada.Characters.Handling.To_Lower;
function To_Upper_Case (S : String) return String
renames Ada.Characters.Handling.To_Upper;
function To_Mixed_Case (S : String) return String;
function Trim (S : String; Target : Character := ' ') return String;
-- Remove Target at S extremes
function Crunch (Text : String) return String;
-- Remove consecutive spaces
function Replace (Text : String;
Match : String;
Subst : String)
return String;
-- Replace every occurrence of Match in Text by Subst
type Halves is (Head, Tail);
function Split (Text : String;
Separator : Character;
Side : Halves := Head;
From : Halves := Head;
Count : Positive := 1;
Raises : Boolean := True) return String;
-- Split in two at seeing Count times the separator
-- Start the search according to From, and return Side at that point
-- If not enough separators are seen then raises or whole string
function Shorten (Text : String;
Max_Length : Natural;
Trim_Side : Halves := Head)
return String with
Pre => Max_Length >= 5;
-- Replaces the given end with "(...)" if the text is too long
----------
-- Maps --
----------
package Maps is new Ada.Containers.Indefinite_Ordered_Maps (String, String);
type Map is new Maps.Map with null record;
Empty_Map : constant Map;
----------
-- Sets --
----------
package Sets is new Ada.Containers.Indefinite_Ordered_Sets (String);
type Set is new Sets.Set with null record;
Empty_Set : constant Set;
-------------
-- Vectors --
-------------
-- A standard vector of strings, for reuse across AAA where string arrays
-- are needed.
package Vectors is new Ada.Containers.Indefinite_Vectors (Positive, String);
type Vector is new Vectors.Vector with null record;
Empty_Vector : constant Vector;
function Append (V : Vector;
S : String) return Vector;
-- Returns a copy of V with S appended at the end
function Append (L, R : Vector) return Vector;
-- Append R at the end of L.
overriding
function "&" (V : Vector;
S : String) return Vector
renames Append;
overriding
function "&" (L : Vector;
R : Vector) return Vector
renames Append;
overriding
function "&" (L : String;
R : Vector) return Vector;
overriding
function "=" (L : Vector;
R : Vector) return Boolean;
procedure Append_Line (V : in out Vector;
S : String;
C : Ada.Containers.Count_Type := 1)
renames Append;
procedure Append_To_Last_Line (V : in out Vector; S : String);
function Append_To_Last_Line (V : Vector;
S : String)
return Vector;
-- Appends S to the last line in V. Does *not* add a new line. If V is
-- empty, then a vector with a single line equal to S is returned.
function Count (V : Vector) return Natural;
-- FSM do I hate the Containers.Count_Type...
function Flatten (V : Vector;
Separator : String := " ")
return String;
-- Concatenate all elements
function Flatten (V : Vector;
Separator : Character)
return String;
-- Likewise, using a Character
function Indent (V : Vector;
Spaces : String := " ")
return Vector;
function New_Line (V : Vector) return Vector;
-- Append an empty line to V and return it in a new vector
procedure New_Line (V : in out Vector);
-- Append new line to V
procedure Prepend (V : in out Vector; S : Set'Class);
function Split (S : String;
Separator : Character;
Trim : Boolean := False)
return Vector;
-- Split a string in substrings at Separator positions. A Separator at
-- S'First or S'Last will result in an empty string also being included.
-- If Trim, whitespace is removed around entries.
function Tail (V : Vector;
Allow_Empty : Boolean := False)
return Vector with Pre =>
not V.Is_Empty
or else Allow_Empty
or else raise Constraint_Error with "Cannot take tail of empty vector";
-- Return V without its first element. If Allow_Empty, tail of an empty
-- vector will be another empty vector.
not overriding
function To_Vector (S : String) return Vector;
procedure Write (V : Vector;
Filename : String;
Separator : String := ASCII.LF & "");
-- Dump contents to a given file
function Diff (A, B : AAA.Strings.Vector;
A_Name : String := "A";
B_Name : String := "B";
Skip_Header : Boolean := False)
return AAA.Strings.Vector;
-- Return a vector containing a unified diff of A against B.
--
-- The result contains an optional header:
-- --- <A_Name>
-- +++ <B_Name>
private
overriding
function "&" (L : String;
R : Vector) return Vector
is (To_Vector (L) & R);
function Contains (Full : String; Sub : String) return Boolean
is (for some I in Full'Range =>
I + Sub'Length - 1 in Full'Range and then
Full (I .. I + Sub'Length - 1) = Sub);
Empty_Map : constant Map := (Maps.Empty_Map with null record);
Empty_Set : constant Set := (Sets.Empty_Set with null record);
Empty_Vector : constant Vector := (Vectors.Empty_Vector with null record);
----------------
-- Has_Prefix --
----------------
function Has_Prefix (Full, Prefix : String) return Boolean is
(Full'Length >= Prefix'Length
and then Full (Full'First .. Full'First + Prefix'Length - 1) = Prefix);
----------------
-- Has_Suffix --
----------------
function Has_Suffix (Full, Suffix : String) return Boolean is
(Full'Length >= Suffix'Length
and then Full (Full'Last - Suffix'Length + 1 .. Full'Last) = Suffix);
end AAA.Strings;
|