summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/HsIndex/Sorting.hs
blob: 4a332599476d55673b34f18182846d47cacfa276 (plain)
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