module Web.REST
( REST(..), RESTController, rest
, index, show, create, update, delete
, edit, new
) where
import Prelude hiding (show)
import Control.Monad.Trans.State
import Control.Monad.Identity
import Web.Simple.Responses
import Web.Simple.Router
import Network.HTTP.Types
data REST = REST
{ restIndex :: Route ()
, restShow :: Route ()
, restCreate :: Route ()
, restUpdate :: Route ()
, restDelete :: Route ()
, restEdit :: Route ()
, restNew :: Route ()
}
defaultREST :: REST
defaultREST = REST
{ restIndex = routeAll $ notFound
, restShow = routeAll $ notFound
, restCreate = routeAll $ notFound
, restUpdate = routeAll $ notFound
, restDelete = routeAll $ notFound
, restEdit = routeAll $ notFound
, restNew = routeAll $ notFound
}
instance Routeable REST where
runRoute controller = runRoute $ do
routeMethod GET $ do
routeTop $ restIndex controller
routeName "new" $ restNew controller
routeVar "id" $ do
routeTop $ restShow controller
routeName "edit" $ restEdit controller
routeMethod POST $ routeTop $ restCreate controller
routeMethod DELETE $ routeVar "id" $ restDelete controller
routeMethod PUT $ routeVar "id" $ restUpdate controller
type RESTControllerM a = StateT REST Identity a
instance Routeable (RESTControllerM a) where
runRoute controller = rt
where rt req = do
let (_, st) = runIdentity $ runStateT controller defaultREST
runRoute st req
rest :: RESTControllerM a -> REST
rest controller = snd . runIdentity $ runStateT controller defaultREST
type RESTController = RESTControllerM ()
index :: Routeable r => r -> RESTController
index route = modify $ \controller ->
controller { restIndex = routeAll route }
create :: Routeable r => r -> RESTController
create route = modify $ \controller ->
controller { restCreate = routeAll route }
edit :: Routeable r => r -> RESTController
edit route = modify $ \controller ->
controller { restEdit = routeAll route }
new :: Routeable r => r -> RESTController
new route = modify $ \controller ->
controller { restNew = routeAll route }
show :: Routeable r => r -> RESTController
show route = modify $ \controller ->
controller { restShow = routeAll route }
update :: Routeable r => r -> RESTController
update route = modify $ \controller ->
controller { restUpdate = routeAll route }
delete :: Routeable r => r -> RESTController
delete route = modify $ \controller ->
controller { restDelete = routeAll route }