summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/HsIndex/Show.hs
diff options
context:
space:
mode:
Diffstat (limited to 'indexing/hsindex/src/HsIndex/Show.hs')
-rw-r--r--indexing/hsindex/src/HsIndex/Show.hs324
1 files changed, 324 insertions, 0 deletions
diff --git a/indexing/hsindex/src/HsIndex/Show.hs b/indexing/hsindex/src/HsIndex/Show.hs
new file mode 100644
index 0000000000..6bab73245c
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Show.hs
@@ -0,0 +1,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
+
+