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
234
235
236
237
238
239
240
241
242
243
244
245
246
|
-- |
-- Module : HsIndex.Sorting
-- Copyright : Jean-Luc JOULIN 2018-2019
-- License : General Public Licence (GPLv3)
-- Maintainer : Jean-Luc JOULIN <jean-luc-joulin@orange.fr>
-- Stability : alpha
-- Portability : portable
-- The functions to sort data types.
module HsIndex.Sorting where
import Data.List
import Data.Char
import HsIndex.Types
import HsIndex.Functions
import qualified Data.Text as T
-- | Generate the equivalent name of 'IndexItem's.
--
--
equivItems :: Bool -- ^ Case sensitivity.
-> LangDef -- ^ Lists of chars in each sections.
-> [IndexItem]
-> [IndexItem]
equivItems _ _ [] = []
equivItems False cha (x : xs)
| T.head equi `elem` map toUpper (lstLetters cha) = x { itemEqui = (Letters, equi),itemContent = equivSubItems False cha (itemContent x) } : equivItems False cha xs
| T.head equi `elem` map toUpper (lstNumbers cha) = x { itemEqui = (Numbers, equi),itemContent = equivSubItems False cha (itemContent x) } : equivItems False cha xs
| otherwise = case lstSymbols cha of
Nothing -> x { itemEqui = (Symbols, equi) } : equivItems False cha xs
Just ch -> if T.head equi `elem` map toUpper ch
then x { itemEqui = (Symbols, equi) } : equivItems False cha xs
else equivItems False cha xs
where
equi =
T.toUpper $ if snd (itemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (itemName x)
else snd (itemEqui x)
equivItems True cha (x : xs)
| T.head equi `elem` lstLetters cha = x { itemEqui = (Letters, equi),itemContent = equivSubItems True cha (itemContent x) } : equivItems True cha xs
| T.head equi `elem` lstNumbers cha = x { itemEqui = (Numbers, equi),itemContent = equivSubItems True cha (itemContent x) } : equivItems True cha xs
| otherwise = case lstSymbols cha of
Nothing -> x { itemEqui = (Symbols, equi) } : equivItems True cha xs
Just ch -> if T.head equi `elem` ch
then x { itemEqui = (Symbols, equi) } : equivItems True cha xs
else equivItems True cha xs
where
equi =
if snd (itemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (itemName x)
else snd (itemEqui x)
equivSubItems :: Bool -- ^ Case sensitivity.
-> LangDef -- ^ Lists of chars in each sections.
-> [IndexSubItem]
-> [IndexSubItem]
equivSubItems _ _ [] = []
equivSubItems False cha (x : xs)
| T.head equi `elem` map toUpper (lstLetters cha) = x { subItemEqui = (Letters, equi),subItemContent = equivSubSubItems False cha (subItemContent x) } : equivSubItems False cha xs
| T.head equi `elem` map toUpper (lstNumbers cha) = x { subItemEqui = (Numbers, equi),subItemContent = equivSubSubItems False cha (subItemContent x) } : equivSubItems False cha xs
| otherwise = case lstSymbols cha of
Nothing -> x { subItemEqui = (Symbols, equi) } : equivSubItems False cha xs
Just ch -> if T.head equi `elem` map toUpper ch
then x { subItemEqui = (Symbols, equi) } : equivSubItems False cha xs
else equivSubItems False cha xs
where
equi = T.toUpper $ if snd (subItemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (subItemName x)
else snd (subItemEqui x)
equivSubItems True cha (x : xs)
| T.head equi `elem` lstLetters cha = x { subItemEqui = (Letters, equi),subItemContent = equivSubSubItems True cha (subItemContent x) } : equivSubItems True cha xs
| T.head equi `elem` lstNumbers cha = x { subItemEqui = (Numbers, equi),subItemContent = equivSubSubItems True cha (subItemContent x) } : equivSubItems True cha xs
| otherwise = case lstSymbols cha of
Nothing -> x { subItemEqui = (Symbols, equi) } : equivSubItems True cha xs
Just ch -> if T.head equi `elem` ch
then x { subItemEqui = (Symbols, equi) } : equivSubItems True cha xs
else equivSubItems True cha xs
where
equi = if snd (subItemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (subItemName x)
else snd (subItemEqui x)
equivSubSubItems :: Bool -- ^ Case sensitivity.
-> LangDef -- ^ Lists of chars in each sections.
-> [IndexSubSubItem]
-> [IndexSubSubItem]
equivSubSubItems _ _ [] = []
equivSubSubItems False cha (x : xs)
| T.head equi `elem` map toUpper (lstLetters cha)
= x { subSubItemEqui = (Letters, equi) } : equivSubSubItems False cha xs
| T.head equi `elem` map toUpper (lstNumbers cha)
= x { subSubItemEqui = (Numbers, equi) } : equivSubSubItems False cha xs
| otherwise
= case lstSymbols cha of
Nothing -> x { subSubItemEqui = (Symbols, equi) } : equivSubSubItems False cha xs
Just ch -> if T.head equi `elem` map toUpper ch
then x { subSubItemEqui = (Symbols, equi) } : equivSubSubItems False cha xs
else equivSubSubItems False cha xs
where
equi = T.toUpper $ if snd (subSubItemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (subSubItemName x)
else snd (subSubItemEqui x)
equivSubSubItems True cha (x : xs)
| T.head equi `elem` lstLetters cha = x { subSubItemEqui = (Letters, equi) } : equivSubSubItems True cha xs
| T.head equi `elem` lstNumbers cha = x { subSubItemEqui = (Numbers, equi) } : equivSubSubItems True cha xs
| otherwise = case lstSymbols cha of
Nothing -> x { subSubItemEqui = (Symbols, equi) } : equivSubSubItems True cha xs
Just ch -> if T.head equi `elem` ch
then x { subSubItemEqui = (Symbols, equi) } : equivSubSubItems True cha xs
else equivSubSubItems True cha xs
where
equi = if snd (subSubItemEqui x) == T.empty
then substituteCharInString (lstSubs cha) (subSubItemName x)
else snd (subSubItemEqui x)
sortItems :: Bool
-> LangDef -- ^ The list of 'Char's for each section.
-> [IndexItem]
-> [IndexItem]
sortItems True cha lst = sortBy (\a b -> compareBySection True cha (itemEqui a) (itemEqui b)) nlst
where nlst = map (\itm -> itm { itemContent = sortSubItems True cha (itemContent itm) }) lst
sortItems False cha lst = sortBy (\a b -> compareBySection False cha ( itemEqui a) ( itemEqui b)) nlst
where nlst = map (\itm -> itm { itemContent = sortSubItems False cha (itemContent itm) }) lst
sortSubItems :: Bool
-> LangDef -- ^ The list of 'Char's for each section.
-> [IndexSubItem]
-> [IndexSubItem]
sortSubItems True cha lst = sortBy (\a b -> compareBySection True cha (subItemEqui a) (subItemEqui b)) nlst
where nlst = map (\itm -> itm { subItemContent = sortSubSubItems True cha (subItemContent itm) }) lst
sortSubItems False cha lst = sortBy (\a b -> compareBySection False cha (subItemEqui a) (subItemEqui b)) nlst
where nlst = map (\itm -> itm { subItemContent = sortSubSubItems False cha (subItemContent itm) }) lst
sortSubSubItems :: Bool
-> LangDef -- ^ The list of 'Char's for each section.
-> [IndexSubSubItem]
-> [IndexSubSubItem]
sortSubSubItems True cha lst = sortBy (\a b -> compareBySection True cha (subSubItemEqui a) (subSubItemEqui b)) lst
sortSubSubItems False cha lst = sortBy (\a b -> compareBySection False cha (subSubItemEqui a) (subSubItemEqui b)) lst
-- | compareBySection two items according to :
--
-- 1. The 'Section' they belongs to. The section order is given in argument.
--
-- 2. Their alphabetical order given by a list of 'Char's.
--
compareBySection :: Bool
-> LangDef -- ^ The list of 'Char's for each section.
-> (Section, T.Text) -- ^ The first item to compareBySection.
-> (Section, T.Text) -- ^ The second index to compareBySection.
-> Ordering -- ^ The 'Ordering'.
compareBySection cas cha (seca, stra) (secb, strb) = case (ind_a, ind_b) of
(Just ia, Just ib) | ia == ib -> if cas
then compareByString (genListChar cha) (T.unpack stra) (T.unpack strb)
else compareByString' (genListChar cha) (T.unpack stra) (T.unpack strb)
| ia < ib -> LT
| otherwise -> GT
where
recu
| seca == Letters = if cas
then compareByString (lstLetters cha) (T.unpack stra) (T.unpack strb)
else compareByString' (lstLetters cha) (T.unpack stra) (T.unpack strb)
| seca == Numbers = if cas
then compareByString (lstNumbers cha) (T.unpack stra) (T.unpack strb)
else compareByString' (lstNumbers cha) (T.unpack stra) (T.unpack strb)
| seca == Symbols = case lstSymbols cha of
Nothing -> EQ -- error "No list of symbols defined"
Just ch -> if cas
then compareByString ch (T.unpack stra) (T.unpack strb)
else compareByString' ch (T.unpack stra) (T.unpack strb)
(Nothing, _ ) -> error ""
(_ , Nothing) -> error ""
where
ind_a = elemIndex seca (lstSecOrder cha)
ind_b = elemIndex secb (lstSecOrder cha)
compareByString' ord stra strb = compareByString (map toUpper ord) (map toUpper stra) (map toUpper strb)
-- | Compare two 'String's according to a list of 'Char'.
compareByString :: String -- ^ The list of Char's giving the order.
-> String -- ^ The first 'String' to compare.
-> String -- ^ The second 'String' to compare.
-> Ordering -- ^ The 'Ordering' result.
compareByString ordlst [] [] = EQ
compareByString ordlst [] (b : bx) = LT -- GT
compareByString ordlst (a : ax) [] = GT -- LT
compareByString ordlst (a : ax) (b : bx) = case (ind_a, ind_b) of
-- If both char are presents in the ordering list, we compare their indexes
(Just ia, Just ib) | ia == ib -> compareByString ordlst ax bx -- Same indexes, we compare the next chars
| ia < ib -> LT
| otherwise -> GT
(Nothing, Nothing) -> compareByString ordlst ax bx -- compare a b
(Nothing, _ ) -> LT
(_ , Nothing) -> GT
where
ind_a = elemIndex a ordlst -- Seek the char index of the first string in the ordering list
ind_b = elemIndex b ordlst -- Seek the char index of the second string in the ordering list
-- | Generate the concatenated list of Char of all Sections in
-- the sorting order.
genListChar cha = genListChar' cha (lstSecOrder cha)
where
genListChar' _ [] = ""
genListChar' cha (Letters : xs) = lstLetters cha ++ genListChar' cha xs
genListChar' cha (Numbers : xs) = lstNumbers cha ++ genListChar' cha xs
genListChar' cha (Symbols : xs) = case lstSymbols cha of
Nothing -> genListChar' cha xs
Just str -> str ++ genListChar' cha xs
|