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
|
{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
-- An example of embedding a custom monad into
-- Scotty's transformer stack, using ReaderT to provide access
-- to a TVar containing global state.
--
-- Note: this example is somewhat simple, as our top level
-- is IO itself. The types of 'scottyT' and 'scottyAppT' are
-- general enough to allow a Scotty application to be
-- embedded into any MonadIO monad.
module Main (main) where
import Control.Concurrent.STM
import Control.Monad.Reader
import Data.Default.Class
import Data.String
import Data.Text.Lazy (Text)
import Network.Wai.Middleware.RequestLogger
import Prelude ()
import Prelude.Compat
import Web.Scotty.Trans
newtype AppState = AppState { tickCount :: Int }
instance Default AppState where
def = AppState 0
-- Why 'ReaderT (TVar AppState)' rather than 'StateT AppState'?
-- With a state transformer, 'runActionToIO' (below) would have
-- to provide the state to _every action_, and save the resulting
-- state, using an MVar. This means actions would be blocking,
-- effectively meaning only one request could be serviced at a time.
-- The 'ReaderT' solution means only actions that actually modify
-- the state need to block/retry.
--
-- Also note: your monad must be an instance of 'MonadIO' for
-- Scotty to use it.
newtype WebM a = WebM { runWebM :: ReaderT (TVar AppState) IO a }
deriving (Applicative, Functor, Monad, MonadIO, MonadReader (TVar AppState))
-- Scotty's monads are layered on top of our custom monad.
-- We define this synonym for lift in order to be explicit
-- about when we are operating at the 'WebM' layer.
webM :: MonadTrans t => WebM a -> t WebM a
webM = lift
-- Some helpers to make this feel more like a state monad.
gets :: (AppState -> b) -> WebM b
gets f = ask >>= liftIO . readTVarIO >>= return . f
modify :: (AppState -> AppState) -> WebM ()
modify f = ask >>= liftIO . atomically . flip modifyTVar' f
main :: IO ()
main = do
sync <- newTVarIO def
-- 'runActionToIO' is called once per action.
let runActionToIO m = runReaderT (runWebM m) sync
scottyT 3000 runActionToIO app
-- This app doesn't use raise/rescue, so the exception
-- type is ambiguous. We can fix it by putting a type
-- annotation just about anywhere. In this case, we'll
-- just do it on the entire app.
app :: ScottyT Text WebM ()
app = do
middleware logStdoutDev
get "/" $ do
c <- webM $ gets tickCount
text $ fromString $ show c
get "/plusone" $ do
webM $ modify $ \ st -> st { tickCount = tickCount st + 1 }
redirect "/"
get "/plustwo" $ do
webM $ modify $ \ st -> st { tickCount = tickCount st + 2 }
redirect "/"
|
