/
Main.hs
94 lines (77 loc) · 2.63 KB
/
Main.hs
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
-- These extensions are needed for wai-routes
{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, ViewPatterns, TemplateHaskell, QuasiQuotes, RankNTypes #-}
-- This extension is for convenience
{-# LANGUAGE OverloadedStrings #-}
module Main where
{-
Demonstrates all the major features of wai-routes (WIP)
-}
import Data.Maybe (fromMaybe)
import Data.Monoid (mconcat)
import Data.Text (Text)
import Wai.Routes
import Network.Wai.Handler.Warp (run)
-------------
-- ROUTING --
-------------
-- The master route
data MasterRoute = MasterRoute
-- wai-routes uses compile time checks to avoid routes overlap
-- We can use parseRoutesNoCheck, if we are certain we want overlapping routes
mkRoute "MasterRoute" [parseRoutesNoCheck|
/ RootR GET POST DELETE PUT
/read-headers ReadHeadersR POST
/set-headers SetHeadersR POST
/json JsonR GET
/submit SubmitR POST
/all AllR
/#Text BeamR GET
|]
--------------
-- HANDLERS --
--------------
getRootR, deleteRootR, postRootR, putRootR :: Handler MasterRoute
getRootR = runHandlerM $ plain "gotten!"
deleteRootR = runHandlerM $ plain "deleted!"
postRootR = runHandlerM $ plain "posted!"
putRootR = runHandlerM $ plain "put-ted!"
-- get a header:
postReadHeadersR :: Handler MasterRoute
postReadHeadersR = runHandlerM $ do
agent <- reqHeader "User-Agent"
plain $ fromMaybe "unknown user-agent" agent
-- set a header:
postSetHeadersR :: Handler MasterRoute
postSetHeadersR = runHandlerM $ do
status status302
header "Location" "http://www.google.com.au"
-- set content type
getJsonR :: Handler MasterRoute
getJsonR = runHandlerM $ json
(Right ("hello", "world") :: Either Int (String, String)) -- you need types for JSON
-- named parameters:
getBeamR :: Text -> Handler MasterRoute
getBeamR beam = runHandlerM $ html $ mconcat ["<h1>Scotty, ", beam, " me up!</h1>" ]
-- unnamed parameters from a query string or a form:
postSubmitR :: Handler MasterRoute
postSubmitR = runHandlerM $ do
name <- getParam "name"
plain $ fromMaybe "unknown" name
-- Match a route regardless of the method
handleAllR :: Handler MasterRoute
handleAllR = runHandlerM $ plain "matches all methods"
-------------------------
-- RUN THE APPLICATION --
-------------------------
main :: IO ()
main = do
putStrLn "Starting server on port 8080"
-- Run the app on port 8080
run 8080 $ waiApp $ do
-- Log everything
middleware logStdoutDev
-- Match our routes
route MasterRoute
-- handler for when there is no matched route
-- (this should be the last handler because it matches all routes)
handler $ runHandlerM $ plain "there is no such route."