summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/HsIndex/Functions.hs
blob: 344a1c515ef773babdabf87ec33bf0f98c96cd3e (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
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      :  HsIndex.Files
-- Copyright   :  Jean-Luc JOULIN 2018-2020
-- License     :  General Public Licence (GPLv3)
-- Maintainer  :  Jean-Luc JOULIN  <jean-luc-joulin@orange.fr>
-- Stability   :  alpha
-- Portability :  portable
-- This module provide miscellaneous functions for comparing
-- and cutting list of IndexItem


 

module HsIndex.Functions (
      splitIndex
    , concatPagesItems
    , substituteCharInString
    -- ~ , upperLower
    , upperLower
    , lowerUpper
    , replaUpper
    , substituted
    , literalNewLine
    , replaUpperLower
    , sepArobase
    ) where


import           HsIndex.Types
import           Data.List
import           Data.Char
import           HsIndex.Show
import qualified Data.Text                     as T


-- | Convert a list of 'IndexItem's into an 'Index' by splitting the liste
-- according to the first letter of the equivalent name and section (layer 1).
--
-- The input list of 'IndexItem' must be sorted with 'sortItems' before
-- using this function.
--
splitIndex :: IndexStyle  -- ^ The style of the 'Index'.
           -> [IndexItem] -- ^ List of 'IndexItem's to sort in a 'Index'.
           -> Index       -- ^ The final index.
splitIndex style []           = []
splitIndex style lst@(x : xs) = if null d
    then splitIndex style f
    else IndexSection tit (splitIndex' style d) : splitIndex style f
    where
        -- ~ (d, f) = span (\c -> areItemsEqual False (itemEqui c) (itemEqui x)) lst
        (d, f) = partition (\c -> areItemsEqual False (itemEqui c) (itemEqui x)) lst
        tit    = showHeading1 style (itemEqui (head d))


-- | Test if layer 1 equivalent names of two items are equals.
areItemsEqual :: Bool              -- ^ Test is Case sensitive
              -> (Section, T.Text) -- ^ First equivalent name to compare.
              -> (Section, T.Text) -- ^ Second equivalent name to compare.
              -> Bool
areItemsEqual True  (Letters, a) (Letters, b) = T.take 1 a == T.take 1 b -- Test if the first letters are the same (Case sensitive)
areItemsEqual False (Letters, a) (Letters, b) = T.toUpper (T.take 1 a) == T.toUpper (T.take 1 b) -- Test if the first letters are the same (Case sensitive)
areItemsEqual _     (Numbers, a) (Numbers, b) = True                 -- Numbers are always number in L1
areItemsEqual _     (Symbols, a) (Symbols, b) = True                 -- Symbols are always symbols in L1
areItemsEqual _     _            _            = False


-- | Convert a list of 'IndexItem's into an 'Index' by splitting the liste
-- according to the first two letters of the equivalent name and section (layer 2).
--
-- The input list of 'IndexItem' must be sorted with 'sortItems' before
-- using this function.
--
splitIndex' :: IndexStyle        -- ^ The style of the 'Index'.
            -> [IndexItem]       -- ^ List of 'IndexItem's to sort in a 'Index'.
            -> [IndexSubSection]
splitIndex' style []           = []
splitIndex' style lst@(x : xs) = if null d
    then splitIndex' style f 
    else IndexSubSection tit d : splitIndex' style f
    where
      -- ~ (d, f) = span (\c -> areItemsEqual' False (itemEqui c) (itemEqui x)) lst
      (d, f) = partition (\c -> areItemsEqual' False (itemEqui c) (itemEqui x)) lst
      tit    = showHeading2 style (itemEqui (head d))


-- | Test if layer 2 equivalent names of two items are equals.
areItemsEqual' True  (Letters, a) (Letters, b) = T.take 2 a == T.take 2 b -- Test if the two first letters are the same (Case sensitive)
areItemsEqual' True  (Numbers, a) (Numbers, b) = T.take 1 a == T.take 1 b -- Test if the first numbers are the same (Case sensitive)
areItemsEqual' True  (Symbols, a) (Symbols, b) = T.take 1 a == T.take 1 b -- Test if the first symbols are the same (Case sensitive)
areItemsEqual' False (Letters, a) (Letters, b) = T.toUpper (T.take 2 a) == T.toUpper (T.take 2 b) -- Test if the two first letters are the same (Case insensitive)
areItemsEqual' False (Numbers, a) (Numbers, b) = T.toUpper (T.take 1 a) == T.toUpper (T.take 1 b) -- Test if the first numbers are the same (Case insensitive)
areItemsEqual' False (Symbols, a) (Symbols, b) = T.toUpper (T.take 1 a) == T.toUpper (T.take 1 b) -- Test if the first symbols are the same (Case insensitive)
areItemsEqual' _     _            _            = False


-- | Extract the first letters of a string after letters substitutions.
firstLetters :: Int 
             -> T.Text
             -> T.Text
firstLetters  n  ""  = error "no letters"
firstLetters  n  str = T.take n str


-- | Substitute the string "\\n" into a String by a '\n' newline character.
literalNewLine :: T.Text -> T.Text
literalNewLine str = T.replace (T.pack "\\\\n") (T.pack "\n") str



-- | Concatenate pages numbers of entries.
--
-- Pages numbers are sorted and filtered to get each page number once.
concatPagesItems :: [IndexItem] 
                 -> [IndexItem]
concatPagesItems []                                       = []
concatPagesItems lst@(IndexItem nam equ com pag sub : xs) = IndexItem nam equ com pages subentries : concatPagesItems a
    where
        (p, a)     = partition (\e -> itemName e == nam) xs
        pages      = nub $ sort $ concat $ pag : map itemPages p
        subentries = concatPagesSubItems $ concat $ sub : map itemContent p


-- | Concatenate pages numbers of subentries.
--
-- Pages numbers are sorted and filtered to get each page number once.
concatPagesSubItems :: [IndexSubItem] 
                    -> [IndexSubItem]
concatPagesSubItems []                                             = []
concatPagesSubItems lst@(IndexSubItem nam equ com pag subsub : xs) = IndexSubItem nam equ com pages subsubentries
    : concatPagesSubItems a
    where
        (p, a)        = partition (\e -> subItemName e == nam) xs
        pages         = nub $ sort $ concat $ pag : map subItemPages p
        subsubentries = concatPagesSubSubItems $ concat $ subsub : map subItemContent p


-- | Concatenate pages numbers of subsubentries.
--
-- Pages numbers are sorted and filtered to get each page number once.
concatPagesSubSubItems :: [IndexSubSubItem] 
                       -> [IndexSubSubItem]
concatPagesSubSubItems []                                         = []
concatPagesSubSubItems lst@(IndexSubSubItem nam equ com pag : xs) = IndexSubSubItem nam equ com pages
    : concatPagesSubSubItems a
    where
        (p, a) = partition (\e -> subSubItemName e == nam) xs
        pages  = nub $ sort $ concat $ pag : map subSubItemPages p


-- | Substitute 'Char's listed in the 'CharSubs' list in a String
--
-- >>> substituteCharInString [CharSubs 'œ' "oe"] "oeil"
--
substituteCharInString :: [(Char,String)] -- ^ The list of substitutions
                       -> T.Text          -- ^ The string where to perform substitutions
                       -> T.Text
substituteCharInString repl  text = replaces repl  text


-- | Set the substitutions to uppercase.
replaUpper :: [(Char, String)] -> [(Char, String)]
replaUpper = map (\(a, b) -> (toUpper a, map toUpper b))

-- | Set the substitutions to lowercase.
replaLower :: [(Char, String)] -> [(Char, String)]
replaLower = map (\(a, b) -> (toLower a, map toLower b))





upperLower []       = []
upperLower (x : xs) = toUpper x : toLower x : upperLower xs


lowerUpper []       = []
lowerUpper (x : xs) = toLower x : toUpper x : lowerUpper xs


replaUpperLower lst = replaUpper lst ++ replaLower lst


substituted (a, b) = a -- TODO A supprimer


replaces repl text = foldl (\t (r, s) -> T.replace (T.pack [r]) (T.pack s) t) text repl


sepArobase str | null item = (str, "")
               | otherwise = (tail item, equ)
    where
        equ  = takeWhile (/= '@') str
        item = dropWhile (/= '@') str