summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src
diff options
context:
space:
mode:
Diffstat (limited to 'indexing/hsindex/src')
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/English.hs34
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/French.hs108
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/German.hs76
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/Russian.hs73
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/SubsIEC.hs128
-rw-r--r--indexing/hsindex/src/HsIndex/CharLists/Symbols.hs30
-rw-r--r--indexing/hsindex/src/HsIndex/Files.hs156
-rw-r--r--indexing/hsindex/src/HsIndex/Functions.hs206
-rw-r--r--indexing/hsindex/src/HsIndex/Parser.hs542
-rw-r--r--indexing/hsindex/src/HsIndex/Show.hs324
-rw-r--r--indexing/hsindex/src/HsIndex/Sorting.hs246
-rw-r--r--indexing/hsindex/src/HsIndex/Types.hs205
-rw-r--r--indexing/hsindex/src/hsindex.hs395
13 files changed, 2523 insertions, 0 deletions
diff --git a/indexing/hsindex/src/HsIndex/CharLists/English.hs b/indexing/hsindex/src/HsIndex/CharLists/English.hs
new file mode 100644
index 0000000000..27adf8186e
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/English.hs
@@ -0,0 +1,34 @@
+-- |
+-- Module : HsIndex.CharLists.English
+-- 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 letters, numbers and symbol definition for the english language.
+
+
+module HsIndex.CharLists.English where
+
+import HsIndex.Types
+import HsIndex.Functions
+import HsIndex.CharLists.Symbols
+import HsIndex.CharLists.French
+
+
+
+ordEnglish = lstLatinLetter
+
+ordEnglishUpperLower = upperLower lstLatinLetter
+
+
+-- |
+langDefEnglish :: LangDef
+langDefEnglish = LangDef
+ { lstLetters = lstSpace ++ ordEnglishUpperLower
+ , lstNumbers = lstDigit
+ , lstSymbols = Nothing
+ , lstSubs = subsFrenchUpperLower++subsSymb
+ , lstSecOrder = [Symbols, Numbers, Letters]
+ }
+
diff --git a/indexing/hsindex/src/HsIndex/CharLists/French.hs b/indexing/hsindex/src/HsIndex/CharLists/French.hs
new file mode 100644
index 0000000000..a2b54e0a54
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/French.hs
@@ -0,0 +1,108 @@
+-- |
+-- Module : HsIndex.CharLists.French
+-- 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 letters, numbers and symbol definition for the french language.
+
+
+module HsIndex.CharLists.French where
+
+import HsIndex.Functions
+import HsIndex.CharLists.Symbols
+import HsIndex.Types
+
+lstSubsLatin = take 1
+
+
+ordFrench = lstLatinLetter
+
+ordFrenchUpperLower = upperLower lstLatinLetter
+
+
+
+
+lstLatinLetter =
+ [ 'a'
+ , 'b'
+ , 'c'
+ , 'd'
+ , 'e'
+ , 'f'
+ , 'g'
+ , 'h'
+ , 'i'
+ , 'j'
+ , 'k'
+ , 'l'
+ , 'm'
+ , 'n'
+ , 'o'
+ , 'p'
+ , 'q'
+ , 'r'
+ , 's'
+ , 't'
+ , 'u'
+ , 'v'
+ , 'w'
+ , 'x'
+ , 'y'
+ , 'z'
+ ]
+
+
+subsFrenchUpperLower = replaUpperLower subsFrench
+
+
+
+
+subsFrench =
+ [ ('à', "a")
+ , ('â', "a")
+ , ('å', "a")
+ , ('ä', "a")
+
+ , ('ç', "c")
+
+ , ('é', "e")
+ , ('è', "e")
+ , ('ê', "e")
+ , ('ë', "e")
+
+ , ('î', "i")
+ , ('ï', "i")
+
+ , ('ô', "o")
+ , ('ö', "o")
+
+ , ('ù', "u")
+ , ('û', "u")
+ , ('ü', "u")
+
+
+ , ('æ', "ae")
+ , ('œ', "oe")
+ ]
+
+
+subsSymb =
+ [ ('-', " ")
+ , ('_', " ")
+ , ('\\', " ")
+ ]
+
+
+
+langDefFrench = LangDef
+ { lstLetters = lstSpace ++ ordFrenchUpperLower -- ++ (map substituted subsFrenchUpperLower)
+ , lstNumbers = lstDigit
+ , lstSymbols = Nothing
+ , lstSubs = subsFrenchUpperLower++subsSymb
+ , lstSecOrder = [Symbols, Numbers, Letters]
+ }
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/CharLists/German.hs b/indexing/hsindex/src/HsIndex/CharLists/German.hs
new file mode 100644
index 0000000000..cb7df65686
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/German.hs
@@ -0,0 +1,76 @@
+-- |
+-- Module : HsIndex.CharLists.German
+-- 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 letters, numbers and symbol definition for the german language.
+
+
+module HsIndex.CharLists.German where
+
+
+import HsIndex.Functions
+import HsIndex.Types
+import HsIndex.CharLists.Symbols
+import HsIndex.CharLists.French ( lstLatinLetter )
+
+
+
+ordGerman = lstLatinLetter
+
+ordGermanLowerUpper = lowerUpper lstLatinLetter
+
+lstGermanLetter =
+ [ 'a'
+ , 'b'
+ , 'c'
+ , 'd'
+ , 'e'
+ , 'f'
+ , 'g'
+ , 'h'
+ , 'i'
+ , 'j'
+ , 'k'
+ , 'l'
+ , 'm'
+ , 'n'
+ , 'o'
+ , 'p'
+ , 'q'
+ , 'r'
+ , 's'
+ , 'ß'
+ , 't'
+ , 'u'
+ , 'v'
+ , 'w'
+ , 'x'
+ , 'y'
+ , 'z'
+ ]
+
+
+charSubsGerman =
+ [ ('æ', "ae")
+ , ('ä', "a")
+ , ('ö', "o")
+ , ('ß', "ss")
+ , ('ü', "u")
+ ]
+
+
+
+
+langDefGerman = LangDef
+ { lstLetters = lstSpace ++ ordGermanLowerUpper -- ++ map substituted charSubsGerman
+ , lstNumbers = lstDigit
+ , lstSymbols = Nothing
+ , lstSubs = charSubsGerman
+ , lstSecOrder = [Symbols, Letters, Numbers]
+ }
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/CharLists/Russian.hs b/indexing/hsindex/src/HsIndex/CharLists/Russian.hs
new file mode 100644
index 0000000000..1e9c3c96dc
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/Russian.hs
@@ -0,0 +1,73 @@
+-- |
+-- Module : HsIndex.CharLists.Russian
+-- 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 letters, numbers and symbol definition for the russian language.
+
+
+module HsIndex.CharLists.Russian where
+
+import HsIndex.Functions
+import HsIndex.Types
+import HsIndex.CharLists.Symbols
+
+ordRussian = lstCyrillic
+
+ordRussianUpperLower = upperLower lstCyrillic
+
+-- | List of cyrillic characters.
+lstCyrillic =
+ [ 'а'
+ , 'б'
+ , 'в'
+ , 'г'
+ , 'д'
+ , 'е'
+ , 'ё'
+ , 'ж'
+ , 'з'
+ , 'и'
+ , 'й'
+ , 'к'
+ , 'л'
+ , 'м'
+ , 'н'
+ , 'о'
+ , 'п'
+ , 'р'
+ , 'с'
+ , 'т'
+ , 'у'
+ , 'ф'
+ , 'х'
+ , 'ц'
+ , 'ч'
+ , 'ш'
+ , 'щ'
+ , 'ъ'
+ , 'ы'
+ , 'ь'
+ , 'э'
+ , 'ю'
+ , 'я'
+ ]
+
+
+
+
+
+lettersRussian = lstCyrillic
+
+langDefRussian = LangDef
+ { lstLetters = lstSpace ++ ordRussianUpperLower
+ , lstNumbers = lstDigit
+ , lstSymbols = Nothing
+ , lstSubs = []
+ , lstSecOrder = [Symbols, Numbers, Letters]
+ }
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/CharLists/SubsIEC.hs b/indexing/hsindex/src/HsIndex/CharLists/SubsIEC.hs
new file mode 100644
index 0000000000..33813a6ce8
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/SubsIEC.hs
@@ -0,0 +1,128 @@
+-- |
+-- Module : HsIndex.CharLists.SubsIEC
+-- 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 list of imakeidx IEC substitution hard-coded for all languages.
+
+
+module HsIndex.CharLists.SubsIEC where
+
+
+-- | List of characters substitutions for parsing the 'imakeindex' output file.
+lstLaTeXSubs =
+ [ ("'e" , 'é')
+ , ("`e" , 'è')
+ , ("^e" , 'ê')
+ , ("\"e" , 'ë')
+ , ("`a" , 'à')
+ , ("^a" , 'â')
+ , ("\"a" , 'ä')
+ , ("\"\\i" , 'ï')
+ , ("^\\i " , 'î')
+ , ("^u" , 'û')
+ , ("\"u" , 'ü')
+ , ("^o" , 'ô')
+ , ("\"o" , 'ö')
+ , ("'E" , 'É')
+ , ("`E" , 'È')
+ , ("^E" , 'Ê')
+ , ("\"E" , 'Ë')
+ , ("`A" , 'À')
+ , ("^A" , 'Â')
+ , ("\"A" , 'Ä')
+ , ("\"\\I" , 'Ï')
+ , ("^\\I " , 'Î')
+ , ("^U" , 'Û')
+ , ("\"U" , 'Ü')
+ , ("^O" , 'Ô')
+ , ("\"O" , 'Ö')
+ , ("r a" , 'å')
+ , ("ae" , 'æ')
+ , ("oe" , 'œ')
+ , ("c c" , 'ç')
+ , ("ss" , 'ß')
+ , ("r A" , 'Å')
+ , ("AE" , 'Æ')
+ , ("OE" , 'Œ')
+ , ("cyra" , 'а')
+ , ("cyrb" , 'б')
+ , ("cyrv" , 'в')
+ , ("cyrg" , 'г')
+ , ("cyrd" , 'д')
+ , ("cyre" , 'е')
+ , ("cyryo" , 'ё')
+ , ("cyrzh" , 'ж')
+ , ("cyrz" , 'з')
+ , ("cyri" , 'и')
+ , ("cyrishrt", 'й')
+ , ("cyrk" , 'к')
+ , ("cyrl" , 'л')
+ , ("cyrm" , 'м')
+ , ("cyrn" , 'н')
+ , ("cyro" , 'о')
+ , ("cyrp" , 'п')
+ , ("cyrr" , 'р')
+ , ("cyrs" , 'с')
+ , ("cyrt" , 'т')
+ , ("cyru" , 'у')
+ , ("cyrf" , 'ф')
+ , ("cyrh" , 'х')
+ , ("cyrc" , 'ц')
+ , ("cyrch" , 'ч')
+ , ("cyrsh" , 'ш')
+ , ("cyrshch" , 'щ')
+ , ("cyrhrdsn", 'ъ')
+ , ("cyrery" , 'ы')
+ , ("cyrsftsn", 'ь')
+ , ("cyrerev" , 'э')
+ , ("cyryu" , 'ю')
+ , ("cyrya" , 'я')
+ , ("CYRA" , 'А')
+ , ("CYRB" , 'Б')
+ , ("CYRV" , 'В')
+ , ("CYRG" , 'Г')
+ , ("CYRD" , 'Д')
+ , ("CYRE" , 'Е')
+ , ("CYRYO" , 'Ё')
+ , ("CYRZH" , 'Ж')
+ , ("CYRZ" , 'З')
+ , ("CYRI" , 'И')
+ , ("CYRISHRT", 'Й')
+ , ("CYRK" , 'К')
+ , ("CYRL" , 'Л')
+ , ("CYRM" , 'М')
+ , ("CYRN" , 'Н')
+ , ("CYRO" , 'О')
+ , ("CYRP" , 'П')
+ , ("CYRR" , 'Р')
+ , ("CYRS" , 'С')
+ , ("CYRT" , 'Т')
+ , ("CYRU" , 'У')
+ , ("CYRF" , 'Ф')
+ , ("CYRH" , 'Х')
+ , ("CYRC" , 'Ц')
+ , ("CYRCH" , 'Ч')
+ , ("CYRSH" , 'Ш')
+ , ("CYRSHCH" , 'Щ')
+ , ("CYRHRDSN", 'Ъ')
+ , ("CYRERY" , 'Ы')
+ , ("CYRSFTSN", 'Ь')
+ , ("CYREREV" , 'Э')
+ , ("CYRYU" , 'Ю')
+ , ("CYRYA" , 'Я')
+
+
+ , ("textquoteleft" , '‘')
+ , ("textquoteright" , '’')
+ , ("nobreakspace" , ' ')
+
+
+ ]
+
+
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/CharLists/Symbols.hs b/indexing/hsindex/src/HsIndex/CharLists/Symbols.hs
new file mode 100644
index 0000000000..813bacfbde
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/CharLists/Symbols.hs
@@ -0,0 +1,30 @@
+-- |
+-- Module : HsIndex.CharLists.Symbols
+-- 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 list of symbols for all languages.
+
+
+module HsIndex.CharLists.Symbols where
+
+
+-- | Allowed symbols.
+allowedSymb = " &~\"'()[]{}<>*+/`^#@°=$£µ%§:;.,?"
+
+-- | Forbidden symbols.
+--
+-- These symbols
+forbiddenSymb = "!|\n\r" -- "!|{}\n\r"
+
+-- | The hyphens symbols.
+lstHyph = "-_"
+
+-- | List of digits.
+lstDigit = "0123456789"
+
+lstSpace = " "
+
+
diff --git a/indexing/hsindex/src/HsIndex/Files.hs b/indexing/hsindex/src/HsIndex/Files.hs
new file mode 100644
index 0000000000..5f1d15c3ea
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Files.hs
@@ -0,0 +1,156 @@
+--
+-- GNU General Public License (GPLv3)
+--
+-- THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) “AS IS” AND ANY EXPRESS OR
+-- IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+-- OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+-- IN NO EVENT SHALL THE AUTHOR(S) BE LIABLE FOR ANY DIRECT, INDIRECT,
+-- INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+-- BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+-- USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
+-- ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+-- (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
+-- THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+-- |
+-- Module : HsIndex.Files
+-- Copyright : Jean-Luc JOULIN 2018-2019
+-- License : General Public Licence (GPLv3)
+-- Maintainer : Jean-Luc JOULIN <jean-luc-joulin@orange.fr>
+-- Stability : alpha
+-- Portability : portable
+-- Module for reading input and style files.
+--
+-- This module also provide the function to write output file.
+--
+
+
+
+
+module HsIndex.Files
+ (
+ -- * Read functions
+ readIndexFile
+ , readStyleFile
+ , readDefinitionFile
+ , readAllFile
+
+ -- * Writing function
+ , writeIndex
+ )
+ where
+
+import Data.Char
+import HsIndex.Functions
+import HsIndex.Show
+import HsIndex.Parser
+import HsIndex.Types
+import Text.Parsec
+import Text.Parsec.String
+import System.Directory ( doesFileExist )
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Functor.Identity
+
+
+-- | Read an index input file.
+readIndexFile :: FilePath -- ^ The path to the index file.
+ -> ParsecT String () Identity t -- ^ The parser to apply on the file to extract datas.
+ -> (t -> IO ()) -- ^ List of operations to perform on parsed datas.
+ -> IO ()
+readIndexFile fidx parsfun fun = do
+ e <- doesFileExist fidx
+ if e
+ then do
+ f <- readFile fidx
+ case parse parsfun "(stdin)" f of
+ Left err -> do
+ putStrLn $ "/!\\ ERROR reading Index file : " ++ fidx
+ print err
+ Right resu -> fun resu
+ else
+ putStrLn
+ $ "/!\\ ERROR the Index file : "
+ ++ fidx
+ ++ " does not exist !\n"
+
+
+-- | Read a style input file
+--
+-- If no path is provided for the style file, the standard style 'styleBasic' is applied.
+--
+readStyleFile :: IndexType -- ^ The type of style.
+ -> (IndexStyle -> IO ()) -- ^ Operations to apply with the parsed style.
+ -> IO ()
+readStyleFile StyleBasic fun = do
+ putStrLn "Using the default basic style"
+ fun styleBasic
+
+readStyleFile StyleDouble fun = do
+ putStrLn "Using the default double letters style"
+ fun styleDoubleHeading
+
+
+
+readStyleFile (Stylecustom fsty) fun = do
+ e <- doesFileExist fsty
+ if e
+ then do
+ f <- readFile fsty
+ case parse (parseStyleFile styleBasic) "(stdin)" f of
+ Left err -> do
+ putStrLn $ "/!\\ ERROR reading Style file : " ++ fsty
+ print err
+ Right resu -> fun resu
+ else
+ putStrLn
+ $ "/!\\ ERROR the Style file : "
+ ++ fsty
+ ++ " does not exist !\n"
+
+
+-- | Read a language definition input file.
+readDefinitionFile :: FilePath -- ^ The path to the definition file.
+ -> (LangDef -> IO ()) -- ^ Operations to apply with the parsed style.
+ -> IO ()
+readDefinitionFile fdef fun = do
+ e <- doesFileExist fdef
+ if e
+ then do
+ f <- readFile fdef
+ case runParser (parseLanguageFile) emptyPermState "(stdin)" f of
+ Left err -> do
+ putStrLn $ "/!\\ ERROR reading Definition file : " ++ fdef
+ print err
+ Right resu -> fun resu
+ else
+ putStrLn
+ $ "/!\\ ERROR the Definition file : "
+ ++ fdef
+ ++ " does not exist !\n"
+
+
+-- | Read both an index input file and style file.
+--
+-- If no path is provided for the style file, the standard style 'styleBasic' is applied.
+--
+readAllFile :: FilePath -- ^ The path to the index file.
+ -> IndexType -- ^ The type of index.
+ -> ParsecT String () Identity t -- ^ The parser to apply on the index file.
+ -> (t -> IndexStyle -> IO ()) -- ^ Operations to apply with the parsed index data and style.
+ -> IO ()
+readAllFile fidx mbfsty parsfun fun =
+ readIndexFile fidx parsfun (readStyleFile mbfsty . fun)
+
+
+-- | Write the sorted entries in a output file with the format provided in the `IndexStyle`.
+writeIndex :: FilePath -- ^ The path to the output file
+ -> IndexStyle -- ^ The style file.
+ -> Bool -- ^ Automatic conversion to pages ranges
+ -> Index -- ^ The index.
+ -> IO ()
+writeIndex file style rng sec = do
+ putStrLn $ "Writing index to File : " ++ file
+ T.writeFile file $ showIndex style rng sec
+
+
diff --git a/indexing/hsindex/src/HsIndex/Functions.hs b/indexing/hsindex/src/HsIndex/Functions.hs
new file mode 100644
index 0000000000..344a1c515e
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Functions.hs
@@ -0,0 +1,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
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/Parser.hs b/indexing/hsindex/src/HsIndex/Parser.hs
new file mode 100644
index 0000000000..35063ab43b
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Parser.hs
@@ -0,0 +1,542 @@
+-- |
+-- Module : HsIndex.Parser
+-- Copyright : Jean-Luc JOULIN 2018-2020
+-- License : General Public Licence (GPLv3)
+-- Maintainer : Jean-Luc JOULIN <jean-luc-joulin@orange.fr>
+-- Stability : alpha
+-- Portability : portable
+-- The parsing functions for the hsindex program.
+
+
+
+module HsIndex.Parser
+ (
+ -- * Parsing the index file
+
+
+ -- * Parsing the style file
+
+
+ -- * Parsing the custom language definition file
+ --
+ -- ** Description of a custom file
+ --
+ -- A custom language can be defined with a specific file.
+ -- This file must respect the following format and contain in any order :
+ --
+ -- 1. A mandatory ordered list of letters describing the alphabet.
+ --
+ -- > LETTERS
+ -- > abcdefghijkl
+ --
+ -- 2. An optional ordered list of numbers.
+ --
+ -- > NUMBERS
+ -- > 0123456789
+ --
+ -- 3. An optional ordered list of symbols.
+ --
+ -- > SYMBOLS
+ -- > 0123456789
+ --
+ -- 4. An optional substitution list. This list describe the character substitutions
+ -- to perform before sorting the words.
+ --
+ -- > SUBSTITUTIONS
+ -- > œ->oe
+ -- > à->a
+ -- > ê->e
+ --
+ -- ** example of custom file
+ --
+ --
+ styleBasic
+ , styleDoubleHeading
+ , parseStyleFile
+ , parseLanguageFile
+ , parseIndexFile
+ , emptyDef
+ ) where
+
+
+import Data.Char
+import Data.Functor.Identity
+import Data.Functor
+import HsIndex.CharLists.French
+import HsIndex.CharLists.Russian
+import HsIndex.CharLists.SubsIEC
+import HsIndex.CharLists.Symbols
+import HsIndex.Functions
+ ( literalNewLine
+ -- ~ , upperLower
+ -- ~ , replaUpperLower
+ , sepArobase
+ )
+import HsIndex.Types
+import qualified Data.Text as T
+import Text.Parsec
+import Text.Parsec.Perm
+import Text.Parsec.Text
+
+
+
+-- | The default 'IndexStyle' applied to an index.
+--
+-- This default style have :
+--
+-- * Basic preamble and postamble
+--
+-- * Uppercase Layer 0 heading
+--
+-- * No Layer 1 heading
+--
+styleBasic = IndexStyle
+ { idxPreamble = T.pack "\\begin{theindex}\n"
+ , idxPostamble = T.pack "\n\n\\end{theindex}\n"
+ , idxHeadingFlag0 = UpperCase
+ , idxHeadingFlag1 = None
+ , idxHeadingPreL0 = T.pack "{\\vspace{1.5cm}\\huge{\\textbf{"
+ , idxHeadingSufL0 = T.pack "}}\\hfill}\\nopagebreak\n"
+ , idxHeadingPreL1 = T.pack "" -- TODO Remplacer par empty
+ , idxHeadingSufL1 = T.pack ""
+ , idxSymhead = T.pack "Symbols"
+ , idxNumhead = T.pack "Numbers"
+ , idxGroupSkip0 = T.pack "\n \\indexspace\n" -- "\n\n \\indexspace\n"
+ , idxGroupSkip1 = T.pack ""
+ , idxItem0 = T.pack "\n \\item "
+ , idxItem1 = T.pack "\n \\subitem "
+ , idxItem2 = T.pack "\n \\subsubitem "
+ , idxItem01 = T.pack "\n \\subitem "
+ , idxItem12 = T.pack "\n \\subsubitem "
+ , idxDelim0 = T.pack ", " -- \\hfill
+ , idxDelim1 = T.pack ", "
+ , idxDelim2 = T.pack ", "
+ , idxDelimn = T.pack ", "
+ , idxDelimr = T.pack "--"
+ , idxEncapPre = T.pack "{"
+ , idxEncapSuf = T.pack "}"
+ }
+
+
+-- | Another 'IndexStyle' applied to an index.
+--
+-- This default style have :
+--
+-- * Basic preamble and postamble
+--
+-- * Uppercase Layer 0 headings
+--
+-- * Uppercase Layer 1 headings
+--
+styleDoubleHeading = IndexStyle
+ { idxPreamble = T.pack "\\begin{theindex}\n"
+ , idxPostamble = T.pack "\n\n\\end{theindex}\n"
+ , idxHeadingFlag0 = UpperCase
+ , idxHeadingFlag1 = UpperCase
+ , idxHeadingPreL0 = T.pack "{\\vspace{1.5cm}\\huge{\\textbf{"
+ , idxHeadingSufL0 = T.pack "}}\\hfill}\\nopagebreak\n\n"
+ , idxHeadingPreL1 = T.pack "\n{\\vspace{0.5cm}\\large{\\textbf{"
+ , idxHeadingSufL1 = T.pack "}}\\hfill}\\nopagebreak"
+ , idxSymhead = T.pack "Symbols"
+ , idxNumhead = T.pack "Numbers"
+ , idxGroupSkip0 = T.pack "\n\n \\indexspace\n"
+ , idxGroupSkip1 = T.pack "\n\n \\indexspace\n"
+ , idxItem0 = T.pack "\n \\item "
+ , idxItem1 = T.pack "\n \\subitem "
+ , idxItem2 = T.pack "\n \\subsubitem "
+ , idxItem01 = T.pack "\n \\subitem "
+ , idxItem12 = T.pack "\n \\subsubitem "
+ , idxDelim0 = T.pack ", " -- \\hfill
+ , idxDelim1 = T.pack ", "
+ , idxDelim2 = T.pack ", "
+ , idxDelimn = T.pack ", "
+ , idxDelimr = T.pack "--"
+ , idxEncapPre = T.pack "{"
+ , idxEncapSuf = T.pack "}"
+ }
+
+
+-- | Parse a style file
+--
+-- A style file can contain several optional keywords definition to set the design
+-- of an index.
+--
+-- Keywords can be :
+--
+-- [preamble] To set the beginning of the index.
+--
+--
+-- [postamble] To set the end of the index.
+--
+parseStyleFile :: IndexStyle -- ^ The default 'Style' to use.
+ -> ParsecT String () Identity IndexStyle -- ^ The new 'Style' parsed.
+parseStyleFile sty = do
+ emptyLines -- Possibles emptylines at the beginning of the file
+ sty <- permute
+ ( IndexStyle -- all possible permutations
+ <$?> (idxPreamble sty , try $ parseStyleDef "preamble") -- Parse the preamble
+ <|?> (idxPostamble sty , try $ parseStyleDef "postamble")
+ <|?> (idxHeadingFlag0 sty, try $ parseStyleDefHead "headings_flag")
+ <|?> (idxHeadingFlag1 sty, try $ parseStyleDefHead "headings_flag1")
+ <|?> (idxHeadingPreL0 sty, try $ parseStyleDef "heading_prefix")
+ <|?> (idxHeadingSufL0 sty, try $ parseStyleDef "heading_suffix")
+ <|?> (idxHeadingPreL1 sty, try $ parseStyleDef "heading_prefix1")
+ <|?> (idxHeadingSufL1 sty, try $ parseStyleDef "heading_suffix1")
+ <|?> (idxSymhead sty , try $ parseStyleDef "symhead_positive")
+ <|?> (idxNumhead sty , try $ parseStyleDef "numhead_positive")
+ <|?> (idxGroupSkip0 sty , try $ parseStyleDef "group_skip")
+ <|?> (idxGroupSkip1 sty , try $ parseStyleDef "group_skip1")
+ <|?> (idxItem0 sty , try $ parseStyleDef "item_0")
+ <|?> (idxItem1 sty , try $ parseStyleDef "item_1")
+ <|?> (idxItem2 sty , try $ parseStyleDef "item_2")
+ <|?> (idxItem01 sty , try $ parseStyleDef "item_01")
+ <|?> (idxItem12 sty , try $ parseStyleDef "item_12")
+ <|?> (idxDelim0 sty , try $ parseStyleDef "delim_0")
+ <|?> (idxDelim1 sty , try $ parseStyleDef "delim_1")
+ <|?> (idxDelim2 sty , try $ parseStyleDef "delim_2")
+ <|?> (idxDelimn sty , try $ parseStyleDef "delim_n")
+ <|?> (idxDelimr sty , try $ parseStyleDef "delim_r")
+ <|?> (idxEncapPre sty , try $ parseStyleDef "encap_infix")
+ <|?> (idxEncapSuf sty , try $ parseStyleDef "encap_suffix")
+
+ )
+ eof -- the end of file
+ return sty
+
+
+-- | Parse many empty lines.
+emptyLines = many emptyLine
+
+
+-- | Parse an empty line.
+emptyLine = do
+ many (oneOf " \t") -- possibly some spaces and tabulations.
+ endOfLineP -- The end of line
+
+
+-- | Parse a style definition
+--
+-- > item_0 "my style definition"
+--
+parseStyleDef :: String -- ^ The name of the style
+ -> ParsecT String () Identity T.Text -- ^ The definition of the style.
+parseStyleDef str = do
+ string str
+ many1 (char ' ')
+ def <- between (char '"') (char '"') (many1 $ noneOf "\r\n\t\"")
+ many (char ' ')
+ endOfLineP
+ emptyLines
+ return (literalNewLine $ T.pack def)
+
+
+
+parseStyleDefHead str = try (parseStyleDefHeadNum str)
+ <|> try (parseStyleDefHeadNone str)
+ <|> try (parseStyleDefHeadUpper str)
+ <|> (parseStyleDefHeadLower str)
+
+
+
+parseStyleDefHeadNone :: String -> ParsecT String () Identity Heading
+parseStyleDefHeadNone str = do
+ string str
+ many1 (char ' ')
+ s <- string "None"
+ many (char ' ')
+ endOfLineP
+ emptyLines
+ return None
+
+
+parseStyleDefHeadUpper :: String -> ParsecT String () Identity Heading
+parseStyleDefHeadUpper str = do
+ string str
+ many1 (char ' ')
+ s <- string "Upper"
+ many (char ' ')
+ endOfLineP
+ emptyLines
+ return UpperCase
+
+
+parseStyleDefHeadLower :: String -> ParsecT String () Identity Heading
+parseStyleDefHeadLower str = do
+ string str
+ many1 (char ' ')
+ s <- string "Lower"
+ many (char ' ')
+ endOfLineP
+ emptyLines
+ return LowerCase
+
+
+parseStyleDefHeadNum :: String -> ParsecT String () Identity Heading
+parseStyleDefHeadNum str = do
+ string str
+ many1 (char ' ')
+ s <- option ' ' (char '-')
+ h <- many1 digit
+ many (char ' ')
+ endOfLineP
+ emptyLines
+ return (val2Heading (read (s : h)))
+
+
+
+val2Heading 0 = None
+val2Heading n = if n > 0
+ then UpperCase
+ else LowerCase
+
+
+-- | Try to parse a IeC LaTeX substitution.
+-- Return the associated character if succeed.
+lstParseIeC lst = try $ do
+ string "\\IeC"
+ many (char ' ')
+ choice $ map (\(s, r) ->
+ (try $ do
+ braces $ do
+ many (char ' ')
+ char '\\'
+ string s
+ many (char ' ')
+ return r
+ )) lst
+
+
+
+
+-- | Parse a number
+parseNumber :: ParsecT String () Identity Char
+parseNumber = try digit
+
+-- | Parse a symbol
+parseSymbol :: ParsecT String () Identity Char
+parseSymbol = try (oneOf allowedSymb)
+
+
+-- | Parse an hyphen character
+parseHyph :: ParsecT String () Identity Char
+parseHyph = try (oneOf lstHyph)
+
+
+parseAnything :: ParsecT String () Identity Char
+parseAnything = try (noneOf forbiddenSymb)
+
+
+
+braces = between (char '{') (char '}')
+
+braces' = between (char '{') (try $ do char '}';lookAhead (char '{' ))
+
+
+-- | Parse a single entry command from "imakeidx" LaTeX package.
+parseIDX :: ParsecT String () Identity Char -> ParsecT String () Identity IndexItem
+parseIDX pars = do
+ string "\\indexentry"
+ many (char ' ')
+ ((itm,itmE),com) <- braces'
+ (do
+ itm <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ com <- option "" $ try $do
+ char '|'
+ optional (char '(')
+ many (notFollowedBy (do char '}';char '{') >> parseAnything)
+ return (itm,com)
+ )
+ many (char ' ')
+ n <- braces (many1 digit)
+ return (IndexItem (T.pack itm) (Letters, T.pack itmE) (T.pack com) [read n] [])
+
+
+-- | Parse a entry command containing a subentry from "imakeidx" LaTeX package.
+parseIDXSub :: ParsecT String () Identity Char -> ParsecT String () Identity IndexItem
+parseIDXSub pars = do
+ string "\\indexentry"
+ many (char ' ')
+ ((itm,itmE), (sub,subE),com) <- braces'
+ (do
+ itm <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ char '!'
+ sub <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ -- ~ string "|hyperpage"
+ com <- option "" $ try $do
+ char '|'
+ optional (char '(')
+ many (notFollowedBy (do char '}';char '{') >> parseAnything)
+ return (itm, sub,com)
+ )
+ many (char ' ')
+ n <- braces (many1 digit)
+ return (IndexItem (T.pack itm) (Letters, T.pack itmE) T.empty [] [IndexSubItem (T.pack sub) (Letters, T.pack subE) (T.pack com) [read n] []])
+
+
+-- | Parse a entry command containing a subsubentry from "imakeidx" LaTeX package.
+parseIDXSubSub :: ParsecT String () Identity Char -> ParsecT String () Identity IndexItem
+parseIDXSubSub pars = do
+ string "\\indexentry"
+ many (char ' ')
+ ((itm,itmE), (sub,subE), (ssub,ssubE),com) <- braces'
+ (do
+ itm <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ char '!'
+ sub <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ char '!'
+ ssub <- sepArobase <$> many1 (notFollowedBy (do char '}';char '{') >> pars)
+ -- ~ string "|hyperpage"
+ com <- option "" $ try $ do
+ char '|'
+ optional (char '(')
+ many (notFollowedBy (do char '}';char '{') >> parseAnything)
+ return (itm, sub, ssub,com)
+ )
+ many (char ' ')
+ n <- braces (many1 digit)
+ return (IndexItem (T.pack itm) (Letters, T.pack itmE) T.empty [] [IndexSubItem (T.pack sub) (Letters, T.pack subE) T.empty [] [IndexSubSubItem (T.pack ssub) (Letters, T.pack ssubE) (T.pack com) [read n]]])
+
+
+-- | Parse all possible forms of entry from "imakeidx" LaTeX package.
+parseIndexItem pars = try (parseIDXSubSub pars)
+ <|> try (parseIDXSub pars)
+ <|> parseIDX pars
+
+
+parseIndexFile :: ParsecT String () Identity [IndexItem]
+parseIndexFile = do
+ emptyLines
+ itms <- endBy (parseIndexItem parseCharL) endOfLineP
+ emptyLines
+ eof
+ return itms
+
+
+
+
+-- | Parse a end of line in both UNIX and WINDOWS format.
+-- ~ endOfLineP :: ParsecT String () Identity String
+endOfLineP = try (string "\n") -- Fin de ligne Unix/Linux (LF : Line feed)
+ <|> try (string "\r\n") -- Fin de ligne Windows (CRLF : Carriage return Line feed)
+
+
+
+-- | Standard parser for chars.
+--
+-- Try to parse :
+--
+-- 1. The specific char output from the "imakeidx" LaTeX package.
+--
+-- 2. Numbers
+--
+-- 3.
+parseCharL :: ParsecT String () Identity Char
+parseCharL = lstParseIeC lstLaTeXSubs
+ <|> parseAnything
+
+
+
+
+-- | Parse a file containing the lists of chars defining a language.
+--
+parseLanguageFile :: ParsecT String PermState Identity LangDef
+parseLanguageFile = do
+ emptyLines -- Possibles emptylines at the beginning of the file
+ -- ~ putState emptyPermState
+ def <- permute
+ ( (\a b c d -> LangDef a b c d []) -- all possible permutations
+ <$$> try (parseCharDefLetters ) -- <$$>
+ <|?> ([], try $ parseCharDefNumbers )
+ <|?> (Nothing, try $ parseCharDefSymbols )
+ <|?> ([], try $ parseSubstitutions )
+ )
+ eof -- the end of file
+ stat <- getState
+ return def{lstSecOrder=order stat}
+
+
+-- | Parse a char list definition.
+--
+-- A char list is defined by:
+--
+-- * A title
+--
+-- * A list of chars describing the sorting order of letters of this language.
+--
+parseCharDefLetters = do
+ string "LETTERS"
+ endOfLineP
+ chrs <- many (noneOf "\n\t")
+ endOfLineP
+ emptyLines
+ modifyState (\st -> st{order=order st++[Letters]})
+ return ( chrs)
+
+
+parseCharDefNumbers = do
+ string "NUMBERS"
+ endOfLineP
+ chrs <- many (noneOf "\n\t")
+ endOfLineP
+ emptyLines
+ modifyState (\st -> st{order=order st++[Numbers]})
+ return ( chrs)
+
+
+-- | Parse a char list definition.
+--
+-- A char list is defined by:
+--
+-- * A title
+--
+-- * A list of chars describing the sorting order of letters of this language.
+--
+parseCharDefSymbols = do
+ string "SYMBOLS"
+ endOfLineP
+ chrs <- many (noneOf "\n\t")
+ endOfLineP
+ emptyLines
+ modifyState (\st -> st{order=order st++[Symbols]})
+ return (Just ( chrs))
+
+
+-- | Parse a list of substitutions
+--
+-- A substitution give an equivalent string to a char. A list of substitution is defined by :
+--
+-- * A title
+--
+-- * A list of substitutions :
+--
+-- > œ->oe
+-- > à->a
+-- > ê->e
+--
+-- note: The arrow -> musn't be preceded or followed by spaces.
+--
+-- A special char can be substituted by a space with the following substitution.
+--
+-- > _->
+-- > -->
+--
+parseSubstitutions = do
+ string "SUBSTITUTIONS"
+ endOfLineP
+ repl <- many1 parseSubstitution
+ emptyLines
+ return repl -- (replaUpperLower repl)
+
+parseSubstitution = do
+ cha <- noneOf "\r\n\t"
+ string "->"
+ str <- many1 (noneOf "\r\n\t")
+ -- many (char ' ')
+ endOfLineP
+ return (cha, str)
+
+
+-- | The empty list of chars.
+emptyDef = LangDef [] [] Nothing [] []
+
+
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
+
+
diff --git a/indexing/hsindex/src/HsIndex/Sorting.hs b/indexing/hsindex/src/HsIndex/Sorting.hs
new file mode 100644
index 0000000000..4a33259947
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Sorting.hs
@@ -0,0 +1,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
+
+
+
+
+
+
+
+
+
diff --git a/indexing/hsindex/src/HsIndex/Types.hs b/indexing/hsindex/src/HsIndex/Types.hs
new file mode 100644
index 0000000000..cc7340d7d2
--- /dev/null
+++ b/indexing/hsindex/src/HsIndex/Types.hs
@@ -0,0 +1,205 @@
+-- |
+-- Module : HsIndex.Types
+-- Copyright : Jean-Luc JOULIN 2018-2020
+-- License : General Public Licence (GPLv3)
+-- Maintainer : Jean-Luc JOULIN <jean-luc-joulin@orange.fr>
+-- Stability : alpha
+-- Portability : portable
+-- The definition of main types for HsIndex.
+
+
+
+
+module HsIndex.Types where
+
+
+import Text.Parsec
+import Text.Parsec.String
+
+import Data.Char
+import qualified Data.Text as T
+
+--
+-- The main data structure of an index is made like this
+--
+-- * Section ""
+--
+-- * Subsection ""
+--
+-- * Entry "" [4]
+--
+-- * Entry "" [17,12]
+--
+-- * SubEntry "" [21]
+--
+-- * SubSubEntry "" [22]
+--
+-- * SubEntry "" [29]
+--
+-- * Subsection ""
+--
+--
+-- * Section B"
+--
+-- * ....
+--
+-- * ....
+--
+--
+-- Sections are made to store SubSections starting with the same first letter.
+--
+-- SubSections are made to store Entries starting with the same two letters.
+--
+-- Entry is made to store a word, it's pages numbers and a list of SubEntries. It's equivalent to "imakeidx" items.
+--
+-- SubEntry is made to store a word, it's pages numbers and a list of SubSubEntries. It's equivalent to "imakeidx" subitems.
+--
+-- SubSubEntry is made to store a word and it's pages numbers. It's equivalent to "imakeidx" subsubitems.
+--
+--
+-- This data structure is deep enough to comply with "imakeidx" LaTeX package.
+--
+
+
+
+
+
+
+
+
+
+
+
+-- | The type to describe the style of the Index
+--
+-- preamble
+--
+-- prefix heading layer1 suffix
+--
+-- name1 delimiters 1, 3, 4
+--
+-- name2 delimiters 4, 9
+--
+-- name3 delimiters 9, 12
+--
+-- postamble
+--
+data IndexStyle =
+ IndexStyle { idxPreamble :: T.Text -- ^ The preamble
+ , idxPostamble :: T.Text -- ^ The postamble
+ , idxHeadingFlag0 :: Heading -- ^ The flag for the layer 0 heading, in connection with 'IndexSection's
+ , idxHeadingFlag1 :: Heading -- ^ The flag for the layer 1 heading, in connection with 'IndexSubSection's
+ , idxHeadingPreL0 :: T.Text -- ^ The prefix for the Layer 0 heading, in connection with 'IndexSection's
+ , idxHeadingSufL0 :: T.Text -- ^ The suffix for the Layer 0 heading, in connection with 'IndexSection's
+ , idxHeadingPreL1 :: T.Text -- ^ The prefix for the Layer 1 heading, in connection with 'IndexSubSection's
+ , idxHeadingSufL1 :: T.Text -- ^ The suffix for the Layer 1 heading, in connection with 'IndexSubSection's
+ , idxSymhead :: T.Text -- ^ The title for the "symbols" section
+ , idxNumhead :: T.Text -- ^ The title for the "numbers" section
+ , idxGroupSkip0 :: T.Text -- ^ The skip command after a layer 0 group ('IndexSection')
+ , idxGroupSkip1 :: T.Text -- ^ The skip command after a layer 1 group ('IndexSubSection')
+ , idxItem0 :: T.Text -- ^ The command to place before the index "items"
+ , idxItem1 :: T.Text -- ^ The command to place before the index "subitems"
+ , idxItem2 :: T.Text -- ^ The command to place before the index "subsubitems"
+ , idxItem01 :: T.Text -- ^ The command to place between an index "items" and an index "subitems"
+ , idxItem12 :: T.Text -- ^ The command to place between an index "subitems" and an index "subsubitems"
+ , idxDelim0 :: T.Text -- ^ The delimiter between the name and the pages numbers for "items"
+ , idxDelim1 :: T.Text -- ^ The delimiter between the name and the pages numbers for "subitems"
+ , idxDelim2 :: T.Text -- ^ The delimiter between the name and the pages numbers for "subsubitems"
+ , idxDelimn :: T.Text -- ^ The delimiter between pages numbers.
+ , idxDelimr :: T.Text -- ^ The delimiter between pages range.
+ , idxEncapPre :: T.Text
+ , idxEncapSuf :: T.Text
+ }
+
+
+-- | The list of chars to define a language.
+data LangDef = LangDef { lstLetters :: [Char] -- ^ Chars considered as letters.
+ , lstNumbers :: [Char] -- ^ Chars considered as numbers.
+ , lstSymbols :: Maybe [Char] -- ^ Chars considered as symbols.
+ , lstSubs :: [(Char,String)] -- ^ List of substitutions to perform.
+ , lstSecOrder :: [Section]
+ }
+
+
+-- | The style of a heading.
+data Heading = None -- ^ No heading
+ | UpperCase -- ^ Upper case heading
+ | LowerCase -- ^ Lower case heading
+ deriving (Eq)
+
+
+-- | The category of a section.
+--
+-- A section can be one of these three categories :
+--
+-- * Letters
+--
+-- * Numbers
+--
+-- * Symbols
+--
+data Section = Letters
+ | Numbers
+ | Symbols
+ deriving (Eq, Show)
+
+-- | An alias for a list of 'IndexSection's
+type Index = [IndexSection]
+
+
+-- | The type for a section.
+data IndexSection =
+ IndexSection { secTitle :: T.Text -- ^ The section title.
+ , secSubSections :: [IndexSubSection] -- ^ The subsections.
+ }
+ deriving (Show)
+
+-- | The type for a subsection.
+data IndexSubSection =
+ IndexSubSection { subSecTitle :: T.Text -- ^ The subsection title.
+ , subSecEntries :: [IndexItem] -- ^ The entries.
+ }
+ deriving (Show)
+
+-- | The type for an item.
+data IndexItem =
+ IndexItem { itemName :: T.Text -- ^ The name of the index item.
+ , itemEqui :: (Section, T.Text) -- ^ The equivalent name and the section of the item.
+ , itemPageCommand :: T.Text -- ^ The command to insert before page number
+ , itemPages :: [Int] -- ^ The pages numbers it refers to.
+ , itemContent :: [IndexSubItem] -- ^ The subitems.
+ }
+ deriving (Show)
+
+-- | The type for a subitem.
+data IndexSubItem =
+ IndexSubItem { subItemName :: T.Text -- ^ The name of the index subitem.
+ , subItemEqui :: (Section, T.Text) -- ^ The equivalent name and the section of the subitem.
+ , subItemPageCommand :: T.Text -- ^ The command to insert before page number
+ , subItemPages :: [Int] -- ^ The pages numbers it refers to.
+ , subItemContent :: [IndexSubSubItem] -- ^ The subsubitems.
+ }
+ deriving (Show)
+
+-- | The type for a subsubitem.
+data IndexSubSubItem =
+ IndexSubSubItem { subSubItemName :: T.Text -- ^ The name of the index subsubitem.
+ , subSubItemEqui :: (Section, T.Text) -- ^ The equivalent name and the section of the subsubitem.
+ , subSubItemPageCommand :: T.Text -- ^ The command to insert before page number
+ , subSubItemPages :: [Int] -- ^ The pages numbers it refers to.
+ }
+ deriving (Show)
+
+
+-- | The type of index to use
+data IndexType = StyleBasic -- ^ The default basic style
+ | StyleDouble -- ^ The default double header style
+ | Stylecustom FilePath -- ^ A custom style (path to the style file).
+
+
+-- | A state to accumulate the 'Section' order.
+data PermState = PermState{ order::[Section]}
+
+-- | The empty state
+emptyPermState = PermState []
+
diff --git a/indexing/hsindex/src/hsindex.hs b/indexing/hsindex/src/hsindex.hs
new file mode 100644
index 0000000000..bee37119cf
--- /dev/null
+++ b/indexing/hsindex/src/hsindex.hs
@@ -0,0 +1,395 @@
+-- |
+-- 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
+-- The Main program for the index generator
+--
+
+
+import Prelude hiding (getContents, putStrLn)
+
+
+
+import Control.Monad
+
+import Data.Char
+import Data.Function
+import Data.List
+import Data.Maybe
+import Data.Ord
+import Debug.Trace
+import GHC.IO.Encoding -- solve bug commitBuffer: invalid argument (invalid character)
+import HsIndex.CharLists.English
+import HsIndex.CharLists.French
+import HsIndex.CharLists.German
+import HsIndex.CharLists.Russian
+import HsIndex.Files
+import HsIndex.Functions
+import HsIndex.Parser
+import HsIndex.Show
+import HsIndex.Sorting
+import HsIndex.Types
+import qualified Prelude (getContents, putStrLn)
+import System.Console.CmdArgs.Explicit
+import System.Console.CmdArgs.Text
+import System.Environment
+import System.Exit
+import System.IO
+import Text.Parsec
+import Text.Printf
+
+import System.Directory
+import System.FilePath
+
+
+-- | The ASCII art for the CLI title.
+logo =
+ [
+ " _ _ _____ _____ __ __ "
+ , " | | | | |_ _| | __ \\ \\ \\ / / "
+ , " | |__| |___ | | _ __ | | | | ___ \\ V / "
+ , " | __ / __| | | | '_ \\| | | |/ _ \\ > < "
+ , " | | | \\__ \\_| |_| | | | |__| | __// . \\ "
+ , " |_| |_|___/_____|_| |_|_____/ \\___/_/ \\_\\ "
+ ]
+
+
+-- | Available options for the CLI.
+data MyModes =
+
+ IndexRussian { fileIn :: FilePath -- ^ The input file
+ , fileOut :: FilePath -- ^ The output file
+ , fileStyle :: IndexType -- ^ The style type
+ , autoRange :: Bool
+ , caseSens :: Bool
+ }
+ | IndexFrench { fileIn :: FilePath
+ , fileOut :: FilePath
+ , fileStyle :: IndexType -- ^ The style type
+ , autoRange :: Bool
+ , caseSens :: Bool
+ }
+ | IndexGerman { fileIn :: FilePath
+ , fileOut :: FilePath
+ , fileStyle :: IndexType -- ^ The style type
+ , autoRange :: Bool
+ , caseSens :: Bool
+ }
+ | IndexEnglish { fileIn :: FilePath
+ , fileOut :: FilePath
+ , fileStyle :: IndexType -- ^ The style type
+ , autoRange :: Bool
+ , caseSens :: Bool
+ }
+ | IndexCustom { fileIn :: FilePath
+ , fileOut :: FilePath
+ , fileStyle :: IndexType -- ^ The style type
+ , autoRange :: Bool
+ , caseSens :: Bool
+ , fileDef :: FilePath
+ }
+ | IndexCheck { checkInternalStyle :: Bool
+ , checkLanguageDef :: Maybe String
+ }
+
+ | ArgHelp
+ | ArgVersion
+
+
+-- | The basic options for English language.
+initialOptsIndexEnglish = IndexEnglish "" "" StyleBasic False True
+
+-- | The basic options for French language.
+initialOptsIndexFrench = IndexFrench "" "" StyleBasic False True
+
+-- | The basic options for German language.
+initialOptsIndexGerman = IndexGerman "" "" StyleBasic False True
+
+-- | The basic options for Russian language.
+initialOptsIndexRussian = IndexRussian "" "" StyleBasic False True
+
+-- | The basic options for custom language.
+initialOptsIndexCustom = IndexCustom "" "" StyleBasic False True ""
+
+-- | The basic options for cheking the program.
+initialOptsCheck = IndexCheck False Nothing
+
+
+-- | The cli mode for English language.
+modeGenIndexEnglish :: Mode MyModes
+modeGenIndexEnglish = mode "english" initialOptsIndexEnglish description unnamedArg convertFlags
+ where
+ description = "Generate a English index"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+
+ convertFlags =
+ [ flagReq ["input", "i"] setInputFile "<File>" "Input file"
+ , flagReq ["output", "o"] setOutpuFile "<File>" "Output file"
+ , flagReq ["style", "s"] setStyleFile "<File>" "Style file"
+ , flagNone ["range"] setRange "Convert sequences of page into range"
+ , flagNone ["nocase"] setNoCase "Case insensitive ordering"
+ , flagNone ["dbl"] setDblHeader "Two letters headers"
+ ]
+
+-- | The cli mode for French language.
+modeGenIndexFrench :: Mode MyModes
+modeGenIndexFrench = mode "french" initialOptsIndexFrench description unnamedArg convertFlags
+ where
+ description = "Generate a French index"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+ convertFlags =
+ [ flagReq ["input", "i"] setInputFile "<File>" "Input file"
+ , flagReq ["output", "o"] setOutpuFile "<File>" "Output file"
+ , flagReq ["style", "s"] setStyleFile "<File>" "Style file"
+ , flagNone ["range"] setRange "Convert sequences of page into range"
+ , flagNone ["nocase"] setNoCase "Case insensitive ordering"
+ , flagNone ["dbl"] setDblHeader "Two letters headers"
+ ]
+
+-- | The cli mode for German language.
+modeGenIndexGerman :: Mode MyModes
+modeGenIndexGerman = mode "german" initialOptsIndexGerman description unnamedArg convertFlags
+ where
+ description = "Generate a German index"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+ convertFlags =
+ [ flagReq ["input", "i"] setInputFile "<File>" "Input file"
+ , flagReq ["output", "o"] setOutpuFile "<File>" "Output file"
+ , flagReq ["style", "s"] setStyleFile "<File>" "Style file"
+ , flagNone ["range"] setRange "Convert sequences of page into range"
+ , flagNone ["nocase"] setNoCase "Case insensitive ordering"
+ , flagNone ["dbl"] setDblHeader "Two letters headers"
+ ]
+
+-- | The cli mode for Russian language.
+modeGenIndexRussian :: Mode MyModes
+modeGenIndexRussian = mode "russian" initialOptsIndexRussian description unnamedArg convertFlags
+ where
+ description = "Generate a Russian index"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+ convertFlags =
+ [ flagReq ["input", "i"] setInputFile "<File>" "Input file"
+ , flagReq ["output", "o"] setOutpuFile "<File>" "Output file"
+ , flagReq ["style", "s"] setStyleFile "<File>" "Style file"
+ , flagNone ["range"] setRange "Convert sequences of page into range"
+ , flagNone ["nocase"] setNoCase "Case insensitive ordering"
+ , flagNone ["dbl"] setDblHeader "Two letters headers"
+ ]
+
+-- | The cli mode for a custom language.
+modeGenIndexCustom :: Mode MyModes
+modeGenIndexCustom = mode "custom" initialOptsIndexCustom description unnamedArg convertFlags
+ where
+ description = "Generate a index with a custom language"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+
+ convertFlags =
+ [ flagReq ["input", "i"] setInputFile "<File>" "Input file"
+ , flagReq ["output", "o"] setOutpuFile "<File>" "Output file"
+ , flagReq ["style", "s"] setStyleFile "<File>" "Style file"
+ , flagReq ["def", "d"] setDefFile "<File>" "Definition file"
+ , flagNone ["range"] setRange "Convert sequences of page into range"
+ , flagNone ["nocase"] setNoCase "Case insensitive ordering"
+ , flagNone ["dbl"] setDblHeader "Two letters headers"
+ ]
+
+-- | The cli mode for a checking the program.
+modeGenCheck :: Mode MyModes
+modeGenCheck = mode "check" initialOptsCheck description unnamedArg convertFlags
+ where
+ description = "Check the internal parameter of the program"
+ unnamedArg = Arg { argValue = updateUnnamed, argType = "", argRequire = False }
+ where updateUnnamed str opts = Left ("Error unknown argument : " ++ str)
+
+ convertFlags =
+ [ flagNone ["style"] setCheckStyle "Check built-in default style"
+ , flagReq ["language", "l"] setCheckLanguage "<Lang>" "Check built-in language definition"
+ ]
+
+
+
+
+-- | Set the input file.
+setInputFile str opts = Right $ opts { fileIn = str }
+
+-- | Set the output file.
+setOutpuFile str opts = Right $ opts { fileOut = str }
+
+-- | Set the style file.
+setStyleFile str opts = Right $ opts { fileStyle = Stylecustom str }
+
+-- | Set the definition file.
+setDefFile str opts = Right $ opts { fileDef = str }
+
+-- | Enable automatic conversion of pages sequences into ranges.
+setRange opts = opts { autoRange = True }
+
+-- | Enable the checking of the internal default style.
+setCheckStyle opts = opts { checkInternalStyle = True }
+
+-- | Disable case sensitivity in ordering.
+setNoCase opts = opts { caseSens = False }
+
+-- | Enable the two letters defaults header
+setDblHeader opts = opts { fileStyle = StyleDouble }
+
+
+-- | Set the language definition to check
+setCheckLanguage "english" opts = Right $ opts { checkLanguageDef = Just "english" }
+setCheckLanguage "french" opts = Right $ opts { checkLanguageDef = Just "french" }
+setCheckLanguage "german" opts = Right $ opts { checkLanguageDef = Just "german" }
+setCheckLanguage "russian" opts = Right $ opts { checkLanguageDef = Just "russian" }
+setCheckLanguage str opts = Left $ "/!\\ ERROR The language " ++ str ++ " is not recognized"
+
+
+-- | List of all possibles cli modes.
+lstModes :: [Mode MyModes]
+lstModes =
+ [ modeGenIndexEnglish
+ , modeGenIndexFrench
+ , modeGenIndexGerman
+ , modeGenIndexRussian
+ , modeGenIndexCustom
+ , modeGenCheck
+ ]
+
+
+
+-- | The main cli mode.
+--
+-- Contain all the languages modes with the help and version flags.
+modesCLI mods = (modes _ProgName ArgHelp "" mods) { modeGroupFlags = toGroup [helpFlag, versionFlag] }
+ where
+ helpFlag = flagNone ["help", "h", "?"] (const ArgHelp) "Help message"
+ versionFlag = flagNone ["version", "V"] (const ArgVersion) "Version informations"
+
+
+
+_ProgName = "hsindex"
+_ProgDetails = "A program to create indexes for LaTeX and XeTeX"
+_Auteur = "(c) Jean-Luc JOULIN 2018-2020"
+_Version = "0.12.0"
+
+
+-- | The main function.
+main :: IO ()
+main = do
+ setLocaleEncoding utf8 -- solve bug commitBuffer: invalid argument (invalid character)
+ opts <- processArgs $ modesCLI lstModes
+ outputScreen opts
+
+
+-- | Main function to output result to screen.
+outputScreen opts@(IndexEnglish fin fou fsty rng cas ) = do
+ let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou
+ readAllFile
+ fin
+ fsty
+ parseIndexFile
+ (\ent idx -> do
+ let entc = concatPagesItems ent
+ ents = sortItems cas langDefEnglish (equivItems True langDefEnglish entc)
+ entd = splitIndex idx ents
+ writeIndex fout idx rng entd
+ )
+
+outputScreen opts@(IndexFrench fin fou fsty rng cas ) = do
+ let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou
+ readAllFile
+ fin
+ fsty
+ parseIndexFile
+ (\ent idx -> do
+ let entc = concatPagesItems ent
+ ents = sortItems cas langDefFrench (equivItems True langDefFrench entc)
+ entd = splitIndex idx ents
+ writeIndex fout idx rng entd
+ )
+
+outputScreen opts@(IndexGerman fin fou fsty rng cas ) = do
+ let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou
+ readAllFile
+ fin
+ fsty
+ parseIndexFile
+ (\ent idx -> do
+ let entc = concatPagesItems ent
+ ents = sortItems cas langDefGerman (equivItems True langDefGerman entc)
+ entd = splitIndex idx ents
+ writeIndex fout idx rng entd
+ )
+
+outputScreen opts@(IndexRussian fin fou fsty rng cas ) = do
+ let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou
+ readAllFile
+ fin
+ fsty
+ parseIndexFile
+ (\ent idx -> do
+ let entc = concatPagesItems ent
+ ents = sortItems cas langDefRussian (equivItems True langDefRussian entc)
+ entd = splitIndex idx ents
+ writeIndex fout idx rng entd
+ )
+
+outputScreen opts@(IndexCustom fin fou fsty rng cas fdef) = do
+ let fout = if null fou then ((dropExtension fin) ++ ".ind") else fou
+ readDefinitionFile
+ fdef
+ (\def -> readAllFile
+ fin
+ fsty
+ parseIndexFile
+ (\ent idx -> do
+ let entc = concatPagesItems ent
+ ents = sortItems cas def { lstLetters = (lstLetters def) } (equivItems True def entc)
+ entd = splitIndex idx ents
+ putStrLn $ "Building index with custom language definition"
+ putStrLn $ showLangDef def
+ writeIndex fout idx rng entd
+ )
+ )
+
+outputScreen opts@(IndexCheck sty mblang ) = do
+ if sty
+ then do
+ putStrLn $ showStyle styleBasic
+ else putStrLn ""
+ case mblang of
+ Nothing -> do
+ putStrLn ""
+ Just "english" -> putStrLn $ showLangDef langDefEnglish
+ Just "french" -> putStrLn $ showLangDef langDefFrench
+ Just "german" -> putStrLn $ showLangDef langDefGerman
+ Just "russian" -> putStrLn $ showLangDef langDefRussian
+
+outputScreen opts@ArgHelp = do
+ putStrLn $ unlines logo
+ putStrLn $ " " ++ _ProgDetails
+ putStrLn $ " " ++ _Auteur
+ putStrLn $ " Version : " ++ _Version
+ print $ helpText [] HelpFormatAll (modesCLI lstModes)
+ exitSuccess
+
+outputScreen opts@ArgVersion = do
+ putStrLn $ unlines logo
+ putStrLn $ " " ++ _ProgDetails
+ putStrLn $ " " ++ _Auteur
+ putStrLn $ " Version : " ++ _Version
+ exitSuccess
+
+
+
+
+
+
+
+