Ticket #1553: eventsCons.hs

File eventsCons.hs, 1.7 KB (added by fkberthold@…, 7 years ago)

Source code that produces teh error.

Line 
1module EventsCons where
2import Text.XML.HXT.Arrow
3import Data.Tree.NTree.TypeDefs (NTree (..))
4import System.Time
5import List
6
7myMonths = [January .. December]
8monthRefs = zip [January .. December]
9                                                                ["#jan", "#feb", "#mar", "#apr", "#may", "#jun",
10                                                                        "#jul", "#aug", "#sep", "#oct", "#nov", "#dec"]
11
12
13main = 
14        runX ( readDocument [(a_validate, v_0)] "events.xml" >>>
15                                        processEvents myMonths >>>
16                                        writeDocument [(a_indent, v_1)] "events.html" )
17
18       
19processEvents months =
20        processTopDown (monthListX months)
21
22
23monthListX months =
24        mkelem "div" [sattr "class" "monthlist"] 
25                ([header] ++
26                        (listMonths $ take 6 months) ++
27                        [breakTag] ++
28                        (listMonths $ drop 6 months) ++
29                        [breakTag, archive, breakTag])
30                `when`
31                        (isElem >>> hasName "monthList")
32        where
33                header = selem "h2" [[txt "Event Galleries"]]
34                breakTag = selem "br" []
35                archive = mkelem "a" [sattr "class" "month", sattr "href" "archive.html"]
36                                                                                                        [txt "Archive of Previous Years"]
37                monthLink month = mkelem "a" [sattr "class" "month", 
38                                                                                                                                        sattr "href" (getRef $ lookup month monthRefs)]
39                                                                                                                                 [txt $ show month]
40                listMonths = map monthLink
41{-
42eventListX months events =
43       
44                `when`
45                (isElem >>> hasName "eventList")
46        where
47                monthGroup month =
48                        mkelem "div" [sattr "class" "month"]
49                                ([mkelem "a" [sattr "name" "jan"]
50                                        [mkelem "span" [sattr "class" "month"]
51                                                [txt (show month)]],
52                                selem "br" []] ++
53                                concatMap mkEventLink (filter (inMonth month) events) ++
54                                [selem "br" []]
55                mkEventLink event =
56                        [mkelem "a" [sattr "class" "event", sattr "href" "eventLoc"]
57                                                                [txt (eventName event)],
58                        selem "br" []]
59
60-}
61-- Tools --
62
63--Turns a lookup reference from "Maybe" to a String
64getRef Nothing = ""
65getRef (Just val) = val
66