Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 58 lines (37 sloc) 1.439 kB
fbf55da @MedeaMelana Added Chris Done's example translated from http://hackage.haskell.org…
authored
1 -- Chris Done's example at http://hackage.haskell.org/package/url-generic-0.1
2 -- translated to Zwaluw
3
4 {-# LANGUAGE TypeOperators #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 {-# LANGUAGE TemplateHaskell #-}
7 {-# LANGUAGE NoMonoPatBinds #-}
8
9 import Web.Zwaluw
10 import Web.Zwaluw.TH
11
12 import Prelude hiding (id, (.), (/))
13 import Control.Category
14
15 import Data.Maybe
16
17
18 -- Datatypes copied verbatim from example
19
20 data Event = Event { eventId :: Maybe Integer -- ^ The event id.
21 , eventScope :: Bool -- ^ Show the scope?
22 , eventLayout :: Layout -- ^ Layout for the page.
23 }
24 deriving Show
25
26 data Layout =
27 Wide | Thin | Collapsed
28 deriving (Show, Enum)
29
30
31 -- Let Zwaluw automatically derive pure routers
32
33 event :: Router (Maybe Integer :- Bool :- Layout :- r) (Event :- r)
34 event = $(deriveRouterTuple ''Event)
35
36 wide, thin, collapsed :: Router r (Layout :- r)
37 (wide, thin, collapsed) = $(deriveRouterTuple ''Layout)
38
39
40 -- Custom routers, tying a URL format to the datatypes
41
42 rEvent :: Router r (Event :- r)
cbbdfe0 @MedeaMelana layout -> rLayout
authored
43 rEvent = event / "event" / "id" / rJust . integer / rFalse . "layout" / rLayout
fbf55da @MedeaMelana Added Chris Done's example translated from http://hackage.haskell.org…
authored
44
cbbdfe0 @MedeaMelana layout -> rLayout
authored
45 rLayout :: Router r (Layout :- r)
46 rLayout = wide . "wide"
fbf55da @MedeaMelana Added Chris Done's example translated from http://hackage.haskell.org…
authored
47 <> thin . "thin"
48 <> collapsed . "collapsed"
49
50
51 -- Auxiliary functions
52
53 parseURLPath :: String -> Maybe Event
54 parseURLPath = parse1 rEvent
55
56 formatURLPath :: Event -> Maybe String
57 formatURLPath = unparse1 rEvent
Something went wrong with that request. Please try again.