version 0.1.1.0: ReaderT -> RWST (#2)

app/Main.hs

@@ -2,27 +2,31 @@
 
 module Main where
 
-import Control.Monad.Reader (ask, lift)
-import Data.Text  (pack)
-import Data.Text.Lazy  (fromStrict)
-import Text.Printf  (printf)
-import Web.Scotty.Trans  (get, text)
-import Web.Template  (CustomWebServer (..), Process (..),
-   Route (..), runWebServer)
-
+import Control.Monad.RWS (ask, lift, tell)
+import Data.Text (Text, pack)
+import Data.Text.Lazy (fromStrict)
+import Text.Printf (printf)
+import Web.Scotty.Trans (get, text)
+import Web.Template (CustomWebServer (..),
+ Process (..), ProcessRW, Route (..),
+ defaultHandleLog, runWebServer)
 
 main :: IO ()
 main = runWebServer 5000 myWebServer
- where env = 0
- myWebServer = CustomWebServer env [ Route get 1 "/ping" pingR
- , Route get 1 "/pong" pongR
- ]
+ where
+ rEnv = 0
+ wEnv = ["Start server"]
+ myWebServer = CustomWebServer rEnv wEnv () defaultHandleLog [ Route get 1 "/ping" pingR
+ , Route get 1 "/pong" pongR
+ ]
 
-pingR :: Process Int
+pingR :: ProcessRW Int [Text]
 pingR = Process $ do
  env <- lift ask
+ lift $ tell ["Got /ping request"]
  text . fromStrict . pack $ printf "Pong!\nCurrent environment: %d." env
 
-pongR :: Process Int
-pongR = AuthProcess $ \userId ->
+pongR :: ProcessRW Int [Text]
+pongR = AuthProcess $ \userId -> do
+ lift $ tell ["Got /pong request"]
  text . fromStrict . pack $ printf "Ping!\nAuthorised: %s." userId

src/Web/Template.hs

@@ -2,7 +2,9 @@ module Web.Template
  (
  module Web.Template.Except
  , module Web.Template.Server
+ , module Web.Template.Types
  ) where
 
 import Web.Template.Except
 import Web.Template.Server
+import Web.Template.Types

src/Web/Template/Server.hs

@@ -6,86 +6,51 @@
 
 
 module Web.Template.Server
- ( UserId, Port, Env, WebM, ScottyM
- , CustomWebServer (..), Process (..), Route (..)
- , runWebServer
+ (
+  runWebServer
+ , defaultHandleLog
  ) where
 
-import Control.Monad.Reader (ReaderT (..), runReaderT)
+import Control.Monad.RWS  (evalRWST)
 import Data.String (fromString)
-import Data.Text as T (Text)
 import Data.Text.Encoding (encodeUtf8)
 import Data.Text.Lazy as TL (Text, toStrict)
 import Network.HTTP.Types.Status (status401, status405)
+import Network.Wai (Response)
 import Network.Wai.Handler.Warp (defaultSettings,
  exceptionResponseForDebug,
  setOnExceptionResponse,
  setPort)
 import Network.Wai.Middleware.RequestLogger (logStdout)
 import Web.Cookie (parseCookiesText)
-import Web.Scotty.Trans (ActionT, Options (..),
- RoutePattern, ScottyT,
+import Web.Scotty.Trans (Options (..),
  defaultHandler, header,
  json, middleware, param,
  scottyOptsT, status)
-import Web.Template.Except (Except,
- JsonWebError (..),
+import Web.Template.Except (JsonWebError (..),
  handleEx)
-
--- | Alias for UserId.
-type UserId = T.Text
-
--- | Alias for Port.
-type Port = Int
-
--- | Alias for environment.
-type Env env = ReaderT env IO
-
--- | Alias for Web monad. Incapsulates 'Web.Scotty.Trans.ActionT'.
-type WebM env a = ActionT Except (Env env) a
-
--- | Alias for Scotty monad. Encapsulates 'Web.Scotty.Trans.ScottyT'
-type ScottyM env a = ScottyT Except (Env env) a
-
--- | 'Process' encapsulates what we what to do inside 'Route'.
--- If your need to check authorization then use 'AuthProcess' constructor.
-data Process s = Process (WebM s ())
- | AuthProcess (UserId -> WebM s ())
-
--- | 'Route' include every needed information to make some stuff with request. It includes:
--- * environment @env@ that we can store and use (for example, connections for databases);
--- * method (like POST or GET);
--- * version of path (it should be like `/v{Integer}/`);
--- * path (just name of path);
--- * process (what should we do with request).
-data Route env = Route { method :: RoutePattern -> WebM env () -> ScottyT Except (Env env) ()
- , version :: Int
- , path :: String
- , process :: Process env
- }
-
--- | Contains environment and processing routes.
-data CustomWebServer env = CustomWebServer { environment :: env
- , routes :: [Route env]
- }
+import Web.Template.Types
 
 -- | For given port and server settings run the server.
-runWebServer :: Port -> CustomWebServer env -> IO ()
-runWebServer port CustomWebServer{..} = scottyOptsT (scottyOpts port) (`runReaderT` environment) $ do
+runWebServer :: (Monoid w, Show w) => Port -> CustomWebServer r w s -> IO ()
+runWebServer port CustomWebServer{..} = scottyOptsT (scottyOpts port) (handleLog .
+ (\rws -> evalRWST rws readerEnv stateEnv)) $ do
  middleware logStdout
  defaultHandler handleEx
- _ <- mapM runRoute routes
- pure ()
+ mapM_ runRoute routes
+
+defaultHandleLog :: Show w => IO (Response, w) -> IO Response
+defaultHandleLog = (print . snd <$>) >> (fst <$>)
 
-runRoute :: Route env -> ScottyM env ()
+runRoute :: Monoid w => Route r w s -> ScottyM r w s ()
 runRoute Route{..} = method (fromString $ "/:version" ++ path) (checkVersion version . auth $ process)
 
 scottyOpts :: Port -> Options
 scottyOpts port = Options 1 warpSettings
  where warpSettings = setOnExceptionResponse exceptionResponseForDebug .
  setPort port $ defaultSettings
 
-auth :: Process env -> WebM env ()
+auth :: Monoid w => Process r w s -> WebM r w s ()
 auth (Process p) = p
 auth (AuthProcess p) = do
  cookiesM <- header "Cookie"
@@ -95,9 +60,9 @@ auth (AuthProcess p) = do
  Nothing -> do status status401
  json . JsonWebError $ "Authorization failed"
 
-checkVersion :: Int -> WebM env () -> WebM env ()
+checkVersion :: Monoid w => Int -> WebM r w s () -> WebM r w s ()
 checkVersion version route = do
- versionPath <- param "version" :: WebM s String
+ versionPath <- param "version"
  if "v" ++ show version == versionPath
  then route
  else do status status405

src/Web/Template/Types.hs

@@ -0,0 +1,152 @@
+module Web.Template.Types
+ (
+ UserId
+ , Port
+ , Env
+ , WebM
+ , ScottyM
+ , Process (..)
+ , Route (..)
+ , CustomWebServer (..)
+ , EnvR, EnvW, EnvS, EnvRW, EnvRS, EnvWS
+ , WebR, WebW, WebS, WebRW, WebRS, WebWS
+ , ScottyR, ScottyW, ScottyS, ScottyRW, ScottyRS, ScottyWS
+ , ProcessR, ProcessW, ProcessS, ProcessRW, ProcessRS, ProcessWS
+ , RouteR, RouteW, RouteS, RouteRW, RouteRS, RouteWS
+ , CustomWebServerR, CustomWebServerW, CustomWebServerS
+ , CustomWebServerRW, CustomWebServerRS, CustomWebServerWS
+ ) where
+
+import Control.Monad.RWS (RWST (..))
+import Data.Text as T (Text)
+import Network.Wai (Response)
+import Web.Scotty.Trans (ActionT, RoutePattern, ScottyT)
+import Web.Template.Except (Except)
+
+-- | Alias for UserId.
+type UserId = T.Text
+
+-- | Alias for Port.
+type Port = Int
+
+-- | Alias for environment.
+type Env r w s = RWST r w s IO
+
+-- | Alias for Web monad. Incapsulates 'Web.Scotty.Trans.ActionT'.
+type WebM r w s a = ActionT Except (Env r w s) a
+
+-- | Alias for Scotty monad. Encapsulates 'Web.Scotty.Trans.ScottyT'
+type ScottyM r w s a = ScottyT Except (Env r w s) a
+
+-- | 'Process' encapsulates what we what to do inside 'Route'.
+-- If your need to check authorization then use 'AuthProcess' constructor.
+data Process r w s = Process (WebM r w s ())
+ | AuthProcess (UserId -> WebM r w s ())
+
+-- | 'Route' include every needed information to make some stuff with request. It includes:
+-- * environment @env@ that we can store and use (for example, connections for databases);
+-- * method (like POST or GET);
+-- * version of path (it should be like `/v{Integer}/`);
+-- * path (just name of path);
+-- * process (what should we do with request).
+data Route r w s = Route { method :: RoutePattern -> WebM r w s () -> ScottyT Except (Env r w s) ()
+ , version :: Int
+ , path :: String
+ , process :: Process r w s
+ }
+
+-- | Contains environment and processing routes.
+data CustomWebServer r w s = CustomWebServer { readerEnv :: r
+ , writerEnv :: w
+ , stateEnv :: s
+ , handleLog :: IO (Response, w) -> IO Response
+ , routes :: [Route r w s]
+ }
+
+-----------------------------------------------------------------------------------------------------
+-- DEFAULT TYPES --
+-----------------------------------------------------------------------------------------------------
+
+type EnvR r = Env r () ()
+
+type EnvW w = Env () w ()
+
+type EnvS s = Env () () s
+
+type EnvRW r w = Env r w ()
+
+type EnvRS r s = Env r () s
+
+type EnvWS w s = Env () w s
+
+---------------------------------------------------
+
+type WebR r a = WebM r () () a
+
+type WebW w a = WebM () w () a
+
+type WebS s a = WebM () () s a
+
+type WebRW r w a = WebM r w () a
+
+type WebRS r s a = WebM r () s a
+
+type WebWS w s a = WebM () w s a
+
+---------------------------------------------------
+
+type ScottyR r a = ScottyM r () () a
+
+type ScottyW w a = ScottyM () w () a
+
+type ScottyS s a = ScottyM () () s a
+
+type ScottyRW r w a = ScottyM r w () a
+
+type ScottyRS r s a = ScottyM r () s a
+
+type ScottyWS w s a = ScottyM () w s a
+
+---------------------------------------------------
+
+type ProcessR r = Process r () ()
+
+type ProcessW w = Process () w ()
+
+type ProcessS s = Process () () s
+
+type ProcessRW r w = Process r w ()
+
+type ProcessRS r s = Process r () s
+
+type ProcessWS w s = Process () w s
+
+---------------------------------------------------
+
+type RouteR r = Route r () ()
+
+type RouteW w = Route () w ()
+
+type RouteS s = Route () () s
+
+type RouteRW r w = Route r w ()
+
+type RouteRS r s = Route r () s
+
+type RouteWS w s = Route () w s
+
+---------------------------------------------------
+
+type CustomWebServerR r = CustomWebServer r () ()
+
+type CustomWebServerW w = CustomWebServer () w ()
+
+type CustomWebServerS s = CustomWebServer () () s
+
+type CustomWebServerRW r w = CustomWebServer r w ()
+
+type CustomWebServerRS r s = CustomWebServer r () s
+
+type CustomWebServerWS w s = CustomWebServer () w s
+
+---------------------------------------------------

web-template.cabal

@@ -1,5 +1,5 @@
 name: web-template
-version: 0.1.0.5
+version: 0.1.1.0
 synopsis: Web template
 description:
  Web template includes:
@@ -23,6 +23,7 @@ library
  exposed-modules: Web.Template
  other-modules: Web.Template.Except
  , Web.Template.Server
+ , Web.Template.Types
  build-depends: base >= 4.7 && < 5
  , scotty
  , http-types
@@ -32,6 +33,7 @@ library
  , cookie
  , aeson
  , warp
+ , wai
  , wai-extra
  default-language: Haskell2010