-- | -- Module : HsIndex.Sorting -- Copyright : Jean-Luc JOULIN 2018-2019 -- License : General Public Licence (GPLv3) -- Maintainer : Jean-Luc JOULIN -- 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