diff options
Diffstat (limited to 'indexing/hsindex/src/HsIndex/Functions.hs')
-rw-r--r-- | indexing/hsindex/src/HsIndex/Functions.hs | 206 |
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 + + + + + + + + + + + + |