1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
module HTML.CategorizedList
( list2CategorizedHtml, categorizeByItemKey, stringList2ItemList )
where
import Data.Char
import Data.List
import HTML.Base
list2CategorizedHtml ::
(HTML h, Show b) => [(a,[h])] -> [(b,String)] -> (a -> b -> Bool) -> [h]
list2CategorizedHtml itemL categoryL categoryFun =
categories2LinkList categoryL :
map (\ (categoryKey,categoryString) ->
anchor (string2urlencoded (show categoryKey))
(h2 [htxt categoryString] :
concatMap (\ (_,item)->item++[breakline])
(filter (\ (itemKey,_) ->
categoryFun itemKey categoryKey)
itemL)
++ [categories2LinkList categoryL])
)
categoryL
categories2LinkList :: (HTML h, Show a) => [(a,String)] -> h
categories2LinkList categoryL =
par
[center
(concatMap (\ (categoryKey,categoryString) ->
[href ('#':(string2urlencoded (show categoryKey)))
[htxt categoryString], nbsp])
categoryL)]
categorizeByItemKey :: HTML h => [(String,[h])] -> [h]
categorizeByItemKey itemL =
list2CategorizedHtml
itemL
(map (\c -> (toUpper c,[toUpper c])) (listHeads (map fst itemL)))
categorizeStringHead
stringList2ItemList :: HTML h => [String] -> [(String,[h])]
stringList2ItemList = map (\str -> (str,[htxt str]))
listHeads :: [String] -> [Char]
listHeads =
nubBy isUpperEqual . foldr (\xs ys -> if xs==[] then ys else head xs:ys) []
categorizeStringHead :: String -> Char -> Bool
categorizeStringHead [] _ = False
categorizeStringHead (c:_) c' = isUpperEqual c c'
isUpperEqual :: Char -> Char -> Bool
isUpperEqual c c' = toUpper c == toUpper c'
main :: IO HtmlPage
main = return $ page "CatTest"
(categorizeByItemKey (stringList2ItemList testList))
testList :: [String]
testList = ["bbcd",
"acde",
"ab",
"cde",
"b",
"xt",
"gbbcd",
"uacde",
"Oab",
"Qcde",
"Tb",
"mxt",
"mxtr"]
|