summaryrefslogtreecommitdiff
path: root/indexing/hsindex/src/HsIndex/Functions.hs
diff options
context:
space:
mode:
Diffstat (limited to 'indexing/hsindex/src/HsIndex/Functions.hs')
-rw-r--r--indexing/hsindex/src/HsIndex/Functions.hs206
1 files changed, 206 insertions, 0 deletions
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
+
+
+
+
+
+
+
+
+
+
+
+