{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, TypeFamilies #-} {- | Module : Network.Wai.Middleware.Routes.Monad Copyright : (c) Anupam Jain 2013 License : MIT (see the file LICENSE) Maintainer : ajnsit@gmail.com Stability : experimental Portability : non-portable (uses ghc extensions) Defines a Routing Monad that provides easy composition of Routes -} module Network.Wai.Middleware.Routes.Monad ( -- * Route Monad RouteM -- * Compose Routes , defaultAction , middleware , route -- * Convert to Wai Application , toWaiApp ) where import Network.Wai import Network.Wai.Middleware.Routes.Routes import Network.HTTP.Types import Control.Monad.State data RouteState = RouteState { middlewares :: [Middleware] , defaultApp :: Application } -- The final "catchall" application, simply returns a 404 response -- Ideally you should put your own default application defaultApplication :: Application defaultApplication _req = return $ responseLBS status404 [("Content-Type", "text/plain")] "Error : 404 - Document not found" addMiddleware :: Middleware -> RouteState -> RouteState addMiddleware m s@(RouteState {middlewares=ms}) = s {middlewares=m:ms} setDefaultApp :: Application -> RouteState -> RouteState setDefaultApp a s = s {defaultApp=a} -- | The Route Monad newtype RouteM a = S { runS :: StateT RouteState IO a } deriving (Monad, MonadIO, Functor, MonadState RouteState) -- | Add a middleware to the application. -- Middleware is nested so the one declared earlier is outer. middleware :: Middleware -> RouteM () middleware = modify . addMiddleware -- | Add a route to the application. -- Routes are ordered so the one declared earlier is matched first. route :: (Routable master) => master -> RouteM () route = middleware . routeDispatch -- | Set the default action of the Application. -- You should only call this once in an application. -- Subsequent invocations override the previous settings. defaultAction :: Application -> RouteM () defaultAction = modify . setDefaultApp -- Empty state initRouteState :: RouteState initRouteState = RouteState [] defaultApplication -- | Convert a RouteM Monadic value into a wai application. toWaiApp :: RouteM () -> IO Application toWaiApp m = do (_,s) <- runStateT (runS m) initRouteState return $ foldl (\a b -> b a) (defaultApp s) (middlewares s)