summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/HsIndex/Show.hs
blob: 6bab73245cc4b57178505cfc13e0cd0332a97bf0 (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
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      :  HsIndex.Show
-- 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 display data types.

-- This module provide functions to 

module HsIndex.Show
  (
    -- * Function to show the whole index.
    showIndex
  , showHeading1
  , showHeading2

    -- * Function to show a style.
  , showStyle
  , showLangDef
  ) where


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





-- | Convert a 'IndexStyle' into String
--
-- This string is readable by hsindex.
--
showStyle style = unlines
    [ "preamble " ++ show (idxPreamble style)
    , "postamble " ++ show (idxPostamble style)
    , "headings_flag " ++ showStyleHeading (idxHeadingFlag0 style)
    , "heading_prefix " ++ show (idxHeadingPreL0 style)
    , "heading_suffix " ++ show (idxHeadingSufL0 style)
    , "headings_flag1 " ++ showStyleHeading (idxHeadingFlag1 style)
    , "heading_prefix1 " ++ show (idxHeadingPreL1 style)
    , "heading_suffix1 " ++ show (idxHeadingSufL1 style)
    , "symhead_positive " ++ show (idxSymhead style)
    , "numhead_positive " ++ show (idxNumhead style)
    , "group_skip " ++ show (idxGroupSkip0 style)
    , "group_skip1 " ++ show (idxGroupSkip1 style)
    , "item_0 " ++ show (idxItem0 style)
    , "item_1 " ++ show (idxItem1 style)
    , "item_2 " ++ show (idxItem2 style)
    , "item_01 " ++ show (idxItem01 style)
    , "item_12 " ++ show (idxItem12 style)
    , "delim_0 " ++ show (idxDelim0 style)
    , "delim_1 " ++ show (idxDelim1 style)
    , "delim_2 " ++ show (idxDelim2 style)
    , "delim_n " ++ show (idxDelimn style)
    , "delim_r " ++ show (idxDelimr style)
    , "encap_infix " ++ show (idxEncapPre style)
    , "encap_suffix " ++ show (idxEncapSuf style)
    ]


-- | Convert 'Heading' into 'String'.
showStyleHeading None      = "None"
showStyleHeading UpperCase = "UpperCase"
showStyleHeading LowerCase = "LowerCase"


showLangDef def = unlines $ ["LETTERS", lstLetters def] ++ if null (lstNumbers def)
    then []
    else
        ["NUMBERS", lstNumbers def]

        ++ case lstSymbols def of
               Nothing  -> []
               Just sym -> ["SYMBOLS", sym]
        ++ if null (lstSubs def) then [] else ["SUBSTITUTIONS"] ++ subS (lstSubs def)

    where
        subS []            = []
        subS ((a, b) : xs) = (a : "->" ++ b) : subS xs


-- | convert an index into a 'Text'
showIndex :: IndexStyle     -- ^ The index style.
          -> Bool           -- ^ Automatic conversion to pages ranges
          -> [IndexSection] -- ^ The list of section of the index.
          -> T.Text         -- ^ The output string in the LaTeX format.
showIndex style rng lst = T.concat [idxPreamble style, showIndexSections style rng lst, idxPostamble style]


-- | convert list of 'IndexSection' into a 'Text' readable with LaTeX.
showIndexSections :: IndexStyle     -- ^ The index style.
                  -> Bool           -- ^ Automatic conversion to pages ranges
                  -> [IndexSection] -- ^ The list of section of the index.
                  -> T.Text         -- ^ The output string in the LaTeX format.
showIndexSections style _   []  = T.empty
showIndexSections style rng lst = T.intercalate (idxGroupSkip0 style) (map (showIndexSection style rng) lstf)
    where lstf = filter (\(IndexSection tit sub) -> not (null sub)) lst


showIndexSection :: IndexStyle -> Bool -> IndexSection -> T.Text
showIndexSection style rng (IndexSection "" sub) =
    showIndexSubSections style rng sub
showIndexSection style rng (IndexSection tit []) =
    T.concat [idxHeadingPreL0 style, tit, idxHeadingSufL0 style]
showIndexSection style rng (IndexSection tit sub) = T.concat
    [ idxHeadingPreL0 style
    , tit
    , idxHeadingSufL0 style
    , showIndexSubSections style rng sub
    ]


-- | convert list of 'IndexSubSection' into a 'Text' readable with LaTeX.
showIndexSubSections :: IndexStyle        -- ^ The index style.
                     -> Bool              -- ^ Automatic conversion to pages ranges
                     -> [IndexSubSection] -- ^ The list of subsection of the index.
                     -> T.Text            -- ^ The output string in the LaTeX format.
showIndexSubSections style _   []  = ""
showIndexSubSections style rng lst = T.intercalate
    (idxGroupSkip1 style)
    (map (showIndexSubSection style rng) lstf)
    where lstf = filter (\(IndexSubSection tit ent) -> not (null ent)) lst


showIndexSubSection :: IndexStyle -> Bool -> IndexSubSection -> T.Text
showIndexSubSection style rng (IndexSubSection "" ent) =
    showIndexItems style rng ent
showIndexSubSection style _   (IndexSubSection tit []) =
    T.concat [idxHeadingPreL1 style, tit, idxHeadingSufL1 style]
showIndexSubSection style rng (IndexSubSection tit ent) = T.concat
    [ idxHeadingPreL1 style
    , tit
    , idxHeadingSufL1 style
    , showIndexItems style rng ent
    ]


-- | Convert a list of 'IndexItem' into a 'Text' readable with LaTeX.
showIndexItems :: IndexStyle  -- ^ The index style.
               -> Bool        -- ^ Automatic conversion to pages ranges
               -> [IndexItem] -- ^ The list of items of the index.
               -> T.Text      -- ^ The output string in the LaTeX format.
showIndexItems style _   []                              = ""
showIndexItems style rng (IndexItem n _ com p  []  : xs) = T.concat
    [ idxItem0 style
    , n
    , idxDelim0 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexItems style rng xs
    ]
showIndexItems style rng (IndexItem n _ _   [] sub : xs) = T.concat
    [ idxItem0 style
    , n
    , showIndexSubItems style rng sub
    , showIndexItems style rng xs
    ]
showIndexItems style rng (IndexItem n _ com p  sub : xs) = T.concat
    [ idxItem0 style
    , n
    , idxDelim0 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubItems style rng sub
    , showIndexItems style rng xs
    ]


-- | Convert an 'IndexSubItem' into a 'Text' readable with LaTeX.
--
-- This function is a transition between entry and its subentries.
showIndexSubItems :: IndexStyle     -- ^ The index style.
          -> Bool  -- ^ Automatic conversion to pages ranges
             -> [IndexSubItem] -- ^ The list of subitems of the index.
             -> T.Text         -- ^ The output string in the LaTeX format.
showIndexSubItems style _   []                                    = ""
showIndexSubItems style rng (IndexSubItem n _ com p  []     : xs) = T.concat
    [ idxItem01 style
    , n
    , idxDelim1 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubItems' style rng xs
    ]
showIndexSubItems style rng (IndexSubItem n _ _   [] subsub : xs) = T.concat
    [ idxItem01 style
    , n
    , showIndexSubSubItems style rng subsub
    , showIndexSubItems' style rng xs
    ]
showIndexSubItems style rng (IndexSubItem n _ com p  subsub : xs) = T.concat
    [ idxItem01 style
    , n
    , idxDelim1 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubSubItems style rng subsub
    , showIndexSubItems' style rng xs
    ]


-- | Convert an 'IndexItem' into a 'Text' readable with LaTeX.
showIndexSubItems' :: IndexStyle -> Bool -> [IndexSubItem] -> T.Text
showIndexSubItems' style _   []                                    = ""
showIndexSubItems' style rng (IndexSubItem n _ com p  []     : xs) = T.concat
    [ idxItem1 style
    , n
    , idxDelim1 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubItems' style rng xs
    ]
showIndexSubItems' style rng (IndexSubItem n _ _   [] subsub : xs) = T.concat
    [ idxItem1 style
    , n
    , showIndexSubSubItems style rng subsub
    , showIndexSubItems' style rng xs
    ]
showIndexSubItems' style rng (IndexSubItem n _ com p  subsub : xs) = T.concat
    [ idxItem1 style
    , n
    , idxDelim1 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubSubItems style rng subsub
    , showIndexSubItems' style rng xs
    ]


-- | Convert an 'IndexSubSubItem' into a 'Text' readable with LaTeX.
--
-- This function is a transition between subentries and its subsubentries.

showIndexSubSubItems :: IndexStyle        -- ^ The index style.
                     -> Bool              -- ^ Automatic conversion to pages ranges
                     -> [IndexSubSubItem] -- ^ The list of subsubitems of the index.
                     -> T.Text            -- ^ The output string in the LaTeX format.
showIndexSubSubItems style _   []                               = ""
showIndexSubSubItems style rng (IndexSubSubItem n _ com p : xs) = T.concat
    [ idxItem12 style
    , n
    , idxDelim2 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubSubItems' style rng xs
    ]


-- | Convert an 'IndexSubSubItem' into a 'Text' usable with LaTeX.
showIndexSubSubItems' :: IndexStyle -> Bool -> [IndexSubSubItem] -> T.Text
showIndexSubSubItems' style _   []                               = ""
showIndexSubSubItems' style rng (IndexSubSubItem n _ com p : xs) = T.concat
    [ idxItem2 style
    , n
    , idxDelim2 style
    , showPageRange style com (if rng then 3 else 1000) p
    , showIndexSubSubItems' style rng xs
    ]









-- | Return the string of the heading (Layer 1) according to the style and 
-- the equivalent name of an item.
showHeading1 :: IndexStyle        -- ^ The index style.
             -> (Section, T.Text) -- ^ The equivalent name.
             -> T.Text
showHeading1 sty (Letters, a) | idxHeadingFlag0 sty == UpperCase = T.toUpper (T.take 1 a)
                              | idxHeadingFlag0 sty == LowerCase = T.toLower (T.take 1 a)
                              | otherwise                        = T.empty

showHeading1 sty (Numbers, a) | idxHeadingFlag0 sty == UpperCase = idxNumhead sty
                              | idxHeadingFlag0 sty == LowerCase = idxNumhead sty
                              | otherwise                        = T.empty

showHeading1 sty (Symbols, a) | idxHeadingFlag0 sty == UpperCase = idxSymhead sty
                              | idxHeadingFlag0 sty == LowerCase = idxSymhead sty
                              | otherwise                        = T.empty


-- | Return the string of the heading (Layer 1) according to the style and 
-- the equivalent name of an item.
showHeading2 :: IndexStyle        -- ^ The index style.
             -> (Section, T.Text) -- ^ The equivalent name.
             -> T.Text
showHeading2 sty (Letters, a) | idxHeadingFlag1 sty == UpperCase = T.toUpper (T.take 2 a)
                              | idxHeadingFlag1 sty == LowerCase = T.toLower (T.take 2 a)
                              | otherwise                        = T.empty

showHeading2 sty (Numbers, a) | idxHeadingFlag1 sty == UpperCase = T.take 1 a
                              | idxHeadingFlag1 sty == LowerCase = T.take 1 a
                              | otherwise                        = T.empty

showHeading2 sty (Symbols, a) | idxHeadingFlag1 sty == UpperCase = T.take 1 a
                              | idxHeadingFlag1 sty == LowerCase = T.take 1 a
                              | otherwise                        = T.empty


groupedBySuccessors []           = []
groupedBySuccessors lst@(x : xs) = map fst ok : groupedBySuccessors (map fst nok)
    where
        lstC      = [x ..]
        (ok, nok) = span (\(a, b) -> a == b) $ zip lst lstC


showPageRange style com n nums = if com == T.empty
  then T.intercalate (idxDelimn style) (map showRange grps)
  else T.intercalate (idxDelimn style) (map showRangeCom grps)
  where
    showRangeCom gr = if length gr >= n
      then T.concat ["\\", com, idxEncapPre style, T.pack $ show (head gr), idxDelimr style, T.pack $ show (last gr), idxEncapSuf style]
      else T.intercalate (idxDelimn style) (map (\v -> T.concat ["\\", com, idxEncapPre style, T.pack $ show v, idxEncapSuf style]) gr)

    showRange gr = if length gr >= n
      then T.concat [T.pack $ show (head gr), idxDelimr style, T.pack $ show (last gr)]
      else T.intercalate (idxDelimn style) (map (\v -> T.concat [T.pack $ show v]) gr)

    grps = groupedBySuccessors nums