{-# LANGUAGE OverloadedStrings #-} -- | -- Module : HsIndex.Files -- Copyright : Jean-Luc JOULIN 2018-2020 -- License : General Public Licence (GPLv3) -- Maintainer : Jean-Luc JOULIN -- 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