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