1-module(syntax_tools_SUITE_test_module).
2
3-export([foo1/1,foo2/3,start_child/2]).
4
5-export([len/1,equal/2,concat/2,chr/2,rchr/2,str/2,rstr/2,
6	 span/2,cspan/2,substr/2,substr/3,tokens/2,chars/2,chars/3]).
7-export([copies/2,words/1,words/2,strip/1,strip/2,strip/3,
8	 sub_word/2,sub_word/3,left/2,left/3,right/2,right/3,
9	 sub_string/2,sub_string/3,centre/2,centre/3, join/2]).
10-export([to_upper/1, to_lower/1]).
11
12-import(lists,[reverse/1,member/2]).
13
14
15%% @type some_type() = map()
16%% @type some_other_type() = {a, #{ list() => term()}}
17
18-type some_type() :: map().
19-type some_other_type() :: {'a', #{ list() => term()} }.
20
21-spec foo1(Map :: #{ 'a' => integer(), 'b' => term()}) -> term().
22
23%% @doc Gets value from map.
24
25foo1(#{ a:= 1, b := V}) -> V.
26
27%% @spec foo2(some_type(), Type2 :: some_other_type(), map()) -> Value
28%% @doc Gets value from map.
29
30-spec foo2(
31    Type1 :: some_type(),
32    Type2 :: some_other_type(),
33    Map :: #{ get => 'value', 'value' => binary()}) -> binary().
34
35foo2(Type1, {a,#{ "a" := _}}, #{get := value, value := B}) when is_map(Type1) -> B.
36
37%% from supervisor 18.0
38
39-type child()    :: 'undefined' | pid().
40-type child_id() :: term().
41-type mfargs()   :: {M :: module(), F :: atom(), A :: [term()] | undefined}.
42-type modules()  :: [module()] | 'dynamic'.
43-type restart()  :: 'permanent' | 'transient' | 'temporary'.
44-type shutdown() :: 'brutal_kill' | timeout().
45-type worker()   :: 'worker' | 'supervisor'.
46-type sup_ref()  :: (Name :: atom())
47                  | {Name :: atom(), Node :: node()}
48                  | {'global', Name :: atom()}
49                  | {'via', Module :: module(), Name :: any()}
50                  | pid().
51-type child_spec() :: #{name => child_id(),     % mandatory
52			start => mfargs(),      % mandatory
53			restart => restart(),   % optional
54			shutdown => shutdown(), % optional
55			type => worker(),       % optional
56			modules => modules()}   % optional
57                    | {Id :: child_id(),
58                       StartFunc :: mfargs(),
59                       Restart :: restart(),
60                       Shutdown :: shutdown(),
61                       Type :: worker(),
62                       Modules :: modules()}.
63
64-type startchild_err() :: 'already_present'
65			| {'already_started', Child :: child()} | term().
66-type startchild_ret() :: {'ok', Child :: child()}
67                        | {'ok', Child :: child(), Info :: term()}
68			| {'error', startchild_err()}.
69
70
71-spec start_child(SupRef, ChildSpec) -> startchild_ret() when
72      SupRef :: sup_ref(),
73      ChildSpec :: child_spec() | (List :: [term()]).
74start_child(Supervisor, ChildSpec) ->
75    {Supervisor,ChildSpec}.
76
77
78%% From string.erl
79%% Robert's bit
80
81%% len(String)
82%%  Return the length of a string.
83
84-spec len(String) -> Length when
85      String :: string(),
86      Length :: non_neg_integer().
87
88len(S) -> length(S).
89
90%% equal(String1, String2)
91%%  Test if 2 strings are equal.
92
93-spec equal(String1, String2) -> boolean() when
94      String1 :: string(),
95      String2 :: string().
96
97equal(S, S) -> true;
98equal(_, _) -> false.
99
100%% concat(String1, String2)
101%%  Concatenate 2 strings.
102
103-spec concat(String1, String2) -> String3 when
104      String1 :: string(),
105      String2 :: string(),
106      String3 :: string().
107
108concat(S1, S2) -> S1 ++ S2.
109
110%% chr(String, Char)
111%% rchr(String, Char)
112%%  Return the first/last index of the character in a string.
113
114-spec chr(String, Character) -> Index when
115      String :: string(),
116      Character :: char(),
117      Index :: non_neg_integer().
118
119chr(S, C) when is_integer(C) -> chr(S, C, 1).
120
121chr([C|_Cs], C, I) -> I;
122chr([_|Cs], C, I) -> chr(Cs, C, I+1);
123chr([], _C, _I) -> 0.
124
125-spec rchr(String, Character) -> Index when
126      String :: string(),
127      Character :: char(),
128      Index :: non_neg_integer().
129
130rchr(S, C) when is_integer(C) -> rchr(S, C, 1, 0).
131
132rchr([C|Cs], C, I, _L) ->			%Found one, now find next!
133    rchr(Cs, C, I+1, I);
134rchr([_|Cs], C, I, L) ->
135    rchr(Cs, C, I+1, L);
136rchr([], _C, _I, L) -> L.
137
138%% str(String, SubString)
139%% rstr(String, SubString)
140%% index(String, SubString)
141%%  Return the first/last index of the sub-string in a string.
142%%  index/2 is kept for backwards compatibility.
143
144-spec str(String, SubString) -> Index when
145      String :: string(),
146      SubString :: string(),
147      Index :: non_neg_integer().
148
149str(S, Sub) when is_list(Sub) -> str(S, Sub, 1).
150
151str([C|S], [C|Sub], I) ->
152    case prefix(Sub, S) of
153	true -> I;
154	false -> str(S, [C|Sub], I+1)
155    end;
156str([_|S], Sub, I) -> str(S, Sub, I+1);
157str([], _Sub, _I) -> 0.
158
159-spec rstr(String, SubString) -> Index when
160      String :: string(),
161      SubString :: string(),
162      Index :: non_neg_integer().
163
164rstr(S, Sub) when is_list(Sub) -> rstr(S, Sub, 1, 0).
165
166rstr([C|S], [C|Sub], I, L) ->
167    case prefix(Sub, S) of
168	true -> rstr(S, [C|Sub], I+1, I);
169	false -> rstr(S, [C|Sub], I+1, L)
170    end;
171rstr([_|S], Sub, I, L) -> rstr(S, Sub, I+1, L);
172rstr([], _Sub, _I, L) -> L.
173
174prefix([C|Pre], [C|String]) -> prefix(Pre, String);
175prefix([], String) when is_list(String) -> true;
176prefix(Pre, String) when is_list(Pre), is_list(String) -> false.
177
178%% span(String, Chars) -> Length.
179%% cspan(String, Chars) -> Length.
180
181-spec span(String, Chars) -> Length when
182      String :: string(),
183      Chars :: string(),
184      Length :: non_neg_integer().
185
186span(S, Cs) when is_list(Cs) -> span(S, Cs, 0).
187
188span([C|S], Cs, I) ->
189    case member(C, Cs) of
190	true -> span(S, Cs, I+1);
191	false -> I
192    end;
193span([], _Cs, I) -> I.
194
195-spec cspan(String, Chars) -> Length when
196      String :: string(),
197      Chars :: string(),
198      Length :: non_neg_integer().
199
200cspan(S, Cs) when is_list(Cs) -> cspan(S, Cs, 0).
201
202cspan([C|S], Cs, I) ->
203    case member(C, Cs) of
204	true -> I;
205	false -> cspan(S, Cs, I+1)
206    end;
207cspan([], _Cs, I) -> I.
208
209%% substr(String, Start)
210%% substr(String, Start, Length)
211%%  Extract a sub-string from String.
212
213-spec substr(String, Start) -> SubString when
214      String :: string(),
215      SubString :: string(),
216      Start :: pos_integer().
217
218substr(String, 1) when is_list(String) ->
219    String;
220substr(String, S) when is_integer(S), S > 1 ->
221    substr2(String, S).
222
223-spec substr(String, Start, Length) -> SubString when
224      String :: string(),
225      SubString :: string(),
226      Start :: pos_integer(),
227      Length :: non_neg_integer().
228
229substr(String, S, L) when is_integer(S), S >= 1, is_integer(L), L >= 0 ->
230    substr1(substr2(String, S), L).
231
232substr1([C|String], L) when L > 0 -> [C|substr1(String, L-1)];
233substr1(String, _L) when is_list(String) -> [].	     %Be nice!
234
235substr2(String, 1) when is_list(String) -> String;
236substr2([_|String], S) -> substr2(String, S-1).
237
238%% tokens(String, Seperators).
239%%  Return a list of tokens seperated by characters in Seperators.
240
241-spec tokens(String, SeparatorList) -> Tokens when
242      String :: string(),
243      SeparatorList :: string(),
244      Tokens :: [Token :: nonempty_string()].
245
246tokens(S, Seps) ->
247    tokens1(S, Seps, []).
248
249tokens1([C|S], Seps, Toks) ->
250    case member(C, Seps) of
251	true -> tokens1(S, Seps, Toks);
252	false -> tokens2(S, Seps, Toks, [C])
253    end;
254tokens1([], _Seps, Toks) ->
255    reverse(Toks).
256
257tokens2([C|S], Seps, Toks, Cs) ->
258    case member(C, Seps) of
259	true -> tokens1(S, Seps, [reverse(Cs)|Toks]);
260	false -> tokens2(S, Seps, Toks, [C|Cs])
261    end;
262tokens2([], _Seps, Toks, Cs) ->
263    reverse([reverse(Cs)|Toks]).
264
265-spec chars(Character, Number) -> String when
266      Character :: char(),
267      Number :: non_neg_integer(),
268      String :: string().
269
270chars(C, N) -> chars(C, N, []).
271
272-spec chars(Character, Number, Tail) -> String when
273      Character :: char(),
274      Number :: non_neg_integer(),
275      Tail :: string(),
276      String :: string().
277
278chars(C, N, Tail) when N > 0 ->
279    chars(C, N-1, [C|Tail]);
280chars(C, 0, Tail) when is_integer(C) ->
281    Tail.
282
283%% Torbjörn's bit.
284
285%%% COPIES %%%
286
287-spec copies(String, Number) -> Copies when
288      String :: string(),
289      Copies :: string(),
290      Number :: non_neg_integer().
291
292copies(CharList, Num) when is_list(CharList), is_integer(Num), Num >= 0 ->
293    copies(CharList, Num, []).
294
295copies(_CharList, 0, R) ->
296    R;
297copies(CharList, Num, R) ->
298    copies(CharList, Num-1, CharList++R).
299
300%%% WORDS %%%
301
302-spec words(String) -> Count when
303      String :: string(),
304      Count :: pos_integer().
305
306words(String) -> words(String, $\s).
307
308-spec words(String, Character) -> Count when
309      String :: string(),
310      Character :: char(),
311      Count :: pos_integer().
312
313words(String, Char) when is_integer(Char) ->
314    w_count(strip(String, both, Char), Char, 0).
315
316w_count([], _, Num) -> Num+1;
317w_count([H|T], H, Num) -> w_count(strip(T, left, H), H, Num+1);
318w_count([_H|T], Char, Num) -> w_count(T, Char, Num).
319
320%%% SUB_WORDS %%%
321
322-spec sub_word(String, Number) -> Word when
323      String :: string(),
324      Word :: string(),
325      Number :: integer().
326
327sub_word(String, Index) -> sub_word(String, Index, $\s).
328
329-spec sub_word(String, Number, Character) -> Word when
330      String :: string(),
331      Word :: string(),
332      Number :: integer(),
333      Character :: char().
334
335sub_word(String, Index, Char) when is_integer(Index), is_integer(Char) ->
336    case words(String, Char) of
337	Num when Num < Index ->
338	    [];
339	_Num ->
340	    s_word(strip(String, left, Char), Index, Char, 1, [])
341    end.
342
343s_word([], _, _, _,Res) -> reverse(Res);
344s_word([Char|_],Index,Char,Index,Res) -> reverse(Res);
345s_word([H|T],Index,Char,Index,Res) -> s_word(T,Index,Char,Index,[H|Res]);
346s_word([Char|T],Stop,Char,Index,Res) when Index < Stop ->
347    s_word(strip(T,left,Char),Stop,Char,Index+1,Res);
348s_word([_|T],Stop,Char,Index,Res) when Index < Stop ->
349    s_word(T,Stop,Char,Index,Res).
350
351%%% STRIP %%%
352
353-spec strip(string()) -> string().
354
355strip(String) -> strip(String, both).
356
357-spec strip(String, Direction) -> Stripped when
358      String :: string(),
359      Stripped :: string(),
360      Direction :: left | right | both.
361
362strip(String, left) -> strip_left(String, $\s);
363strip(String, right) -> strip_right(String, $\s);
364strip(String, both) ->
365    strip_right(strip_left(String, $\s), $\s).
366
367-spec strip(String, Direction, Character) -> Stripped when
368      String :: string(),
369      Stripped :: string(),
370      Direction :: left | right | both,
371      Character :: char().
372
373strip(String, right, Char) -> strip_right(String, Char);
374strip(String, left, Char) -> strip_left(String, Char);
375strip(String, both, Char) ->
376    strip_right(strip_left(String, Char), Char).
377
378strip_left([Sc|S], Sc) ->
379    strip_left(S, Sc);
380strip_left([_|_]=S, Sc) when is_integer(Sc) -> S;
381strip_left([], Sc) when is_integer(Sc) -> [].
382
383strip_right([Sc|S], Sc) ->
384    case strip_right(S, Sc) of
385	[] -> [];
386	T  -> [Sc|T]
387    end;
388strip_right([C|S], Sc) ->
389    [C|strip_right(S, Sc)];
390strip_right([], Sc) when is_integer(Sc) ->
391    [].
392
393%%% LEFT %%%
394
395-spec left(String, Number) -> Left when
396      String :: string(),
397      Left :: string(),
398      Number :: non_neg_integer().
399
400left(String, Len) when is_integer(Len) -> left(String, Len, $\s).
401
402-spec left(String, Number, Character) -> Left when
403      String :: string(),
404      Left :: string(),
405      Number :: non_neg_integer(),
406      Character :: char().
407
408left(String, Len, Char) when is_integer(Char) ->
409    Slen = length(String),
410    if
411	Slen > Len -> substr(String, 1, Len);
412	Slen < Len -> l_pad(String, Len-Slen, Char);
413	Slen =:= Len -> String
414    end.
415
416l_pad(String, Num, Char) -> String ++ chars(Char, Num).
417
418%%% RIGHT %%%
419
420-spec right(String, Number) -> Right when
421      String :: string(),
422      Right :: string(),
423      Number :: non_neg_integer().
424
425right(String, Len) when is_integer(Len) -> right(String, Len, $\s).
426
427-spec right(String, Number, Character) -> Right when
428      String :: string(),
429      Right :: string(),
430      Number :: non_neg_integer(),
431      Character :: char().
432
433right(String, Len, Char) when is_integer(Char) ->
434    Slen = length(String),
435    if
436	Slen > Len -> substr(String, Slen-Len+1);
437	Slen < Len -> r_pad(String, Len-Slen, Char);
438	Slen =:= Len -> String
439    end.
440
441r_pad(String, Num, Char) -> chars(Char, Num, String).
442
443%%% CENTRE %%%
444
445-spec centre(String, Number) -> Centered when
446      String :: string(),
447      Centered :: string(),
448      Number :: non_neg_integer().
449
450centre(String, Len) when is_integer(Len) -> centre(String, Len, $\s).
451
452-spec centre(String, Number, Character) -> Centered when
453      String :: string(),
454      Centered :: string(),
455      Number :: non_neg_integer(),
456      Character :: char().
457
458centre(String, 0, Char) when is_list(String), is_integer(Char) ->
459    [];                       % Strange cases to centre string
460centre(String, Len, Char) when is_integer(Char) ->
461    Slen = length(String),
462    if
463	Slen > Len -> substr(String, (Slen-Len) div 2 + 1, Len);
464	Slen < Len ->
465	    N = (Len-Slen) div 2,
466	    r_pad(l_pad(String, Len-(Slen+N), Char), N, Char);
467	Slen =:= Len -> String
468    end.
469
470%%% SUB_STRING %%%
471
472-spec sub_string(String, Start) -> SubString when
473      String :: string(),
474      SubString :: string(),
475      Start :: pos_integer().
476
477sub_string(String, Start) -> substr(String, Start).
478
479-spec sub_string(String, Start, Stop) -> SubString when
480      String :: string(),
481      SubString :: string(),
482      Start :: pos_integer(),
483      Stop :: pos_integer().
484
485sub_string(String, Start, Stop) -> substr(String, Start, Stop - Start + 1).
486
487%% ISO/IEC 8859-1 (latin1) letters are converted, others are ignored
488%%
489
490to_lower_char(C) when is_integer(C), $A =< C, C =< $Z ->
491    C + 32;
492to_lower_char(C) when is_integer(C), 16#C0 =< C, C =< 16#D6 ->
493    C + 32;
494to_lower_char(C) when is_integer(C), 16#D8 =< C, C =< 16#DE ->
495    C + 32;
496to_lower_char(C) ->
497    C.
498
499to_upper_char(C) when is_integer(C), $a =< C, C =< $z ->
500    C - 32;
501to_upper_char(C) when is_integer(C), 16#E0 =< C, C =< 16#F6 ->
502    C - 32;
503to_upper_char(C) when is_integer(C), 16#F8 =< C, C =< 16#FE ->
504    C - 32;
505to_upper_char(C) ->
506    C.
507
508-spec to_lower(String) -> Result when
509                  String :: io_lib:latin1_string(),
510                  Result :: io_lib:latin1_string()
511	    ; (Char) -> CharResult when
512                  Char :: char(),
513                  CharResult :: char().
514
515to_lower(S) when is_list(S) ->
516    [to_lower_char(C) || C <- S];
517to_lower(C) when is_integer(C) ->
518    to_lower_char(C).
519
520-spec to_upper(String) -> Result when
521                  String :: io_lib:latin1_string(),
522                  Result :: io_lib:latin1_string()
523	    ; (Char) -> CharResult when
524                  Char :: char(),
525                  CharResult :: char().
526
527to_upper(S) when is_list(S) ->
528    [to_upper_char(C) || C <- S];
529to_upper(C) when is_integer(C) ->
530    to_upper_char(C).
531
532-spec join(StringList, Separator) -> String when
533      StringList :: [string()],
534      Separator :: string(),
535      String :: string().
536
537join([], Sep) when is_list(Sep) ->
538    [];
539join([H|T], Sep) ->
540    H ++ lists:append([Sep ++ X || X <- T]).
541