blob: c9883ab972a2c3ffccd3586495b957d5529b9a05 (
plain)
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
|
module Main
%default total
data Matcher =
MDirectory String Matcher
| MCapture Matcher
| End
data Commands = Capture
infixr 8 //
interface Matchable a where
(//) : a -> Matcher -> Matcher
Matchable String where
x // m = MDirectory x m
Matchable Commands where
Capture // m = MCapture m
HandlerType : Matcher -> Type
HandlerType (MDirectory s m) = HandlerType m
HandlerType (MCapture m) = String -> HandlerType m
HandlerType End = String
Handler : Type
Handler = (m : Matcher ** HandlerType m)
dispatch : (handlers : List Handler) -> String -> Maybe String
dispatch [] _ = Nothing
dispatch handlers path = go handlers components where
components : List String
components = filter (/="") (split (=='/') path)
go : List Handler -> List String -> Maybe String
go [] cs = Nothing
go ((m ** f) :: hs) cs =
let next = go hs cs in
case m of
MDirectory dir matcher => case cs of
(c :: cs') => if c == dir then go ((matcher ** f) :: hs) cs' else next
_ => next
MCapture matcher => case cs of
(c :: cs') => go ((matcher ** f c) :: hs) cs'
_ => next
End => Just f
helloHandler : String -> String -> String
helloHandler firstName lastName = "Hello, " ++ firstName ++ " " ++ lastName
weatherHandler : String -> String
weatherHandler place = "The weather in " ++ place ++ " is cold."
handlers : List Handler
handlers = [
("hello" // Capture // Capture // End ** helloHandler)
, ("weather" // Capture // End ** weatherHandler)
]
main : IO ()
main = do
putStrLn (fromMaybe "failed" $ dispatch handlers "hello/Bob/Sunshine")
putStrLn (fromMaybe "failed" $ dispatch handlers "weather/New York")
|
