| 1 | module EventsCons where |
|---|
| 2 | import Text.XML.HXT.Arrow |
|---|
| 3 | import Data.Tree.NTree.TypeDefs (NTree (..)) |
|---|
| 4 | import System.Time |
|---|
| 5 | import List |
|---|
| 6 | |
|---|
| 7 | myMonths = [January .. December] |
|---|
| 8 | monthRefs = zip [January .. December] |
|---|
| 9 | ["#jan", "#feb", "#mar", "#apr", "#may", "#jun", |
|---|
| 10 | "#jul", "#aug", "#sep", "#oct", "#nov", "#dec"] |
|---|
| 11 | |
|---|
| 12 | |
|---|
| 13 | main = |
|---|
| 14 | runX ( readDocument [(a_validate, v_0)] "events.xml" >>> |
|---|
| 15 | processEvents myMonths >>> |
|---|
| 16 | writeDocument [(a_indent, v_1)] "events.html" ) |
|---|
| 17 | |
|---|
| 18 | |
|---|
| 19 | processEvents months = |
|---|
| 20 | processTopDown (monthListX months) |
|---|
| 21 | |
|---|
| 22 | |
|---|
| 23 | monthListX 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 | {- |
|---|
| 42 | eventListX 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 |
|---|
| 64 | getRef Nothing = "" |
|---|
| 65 | getRef (Just val) = val |
|---|
