content: {-# 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.IO.Unlift (MonadUnliftIO(..))
  import Control.Monad.Reader
  
  import Data.String
  
  import Network.Wai.Middleware.RequestLogger
  
  import Web.Scotty.Trans
  
  newtype AppState = AppState { tickCount :: Int }
  
  defaultAppState :: AppState
  defaultAppState = 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), MonadUnliftIO)
  
  -- 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 defaultAppState
          -- '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 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 "/"
  