{-# LANGUAGE Safe, FlexibleInstances, OverloadedStrings #-}
module Web.REST
( REST(..), RESTController, rest, routeREST
, index, show, create, update, delete
, edit, new
) where
import Prelude hiding (show)
import Control.Monad.Trans.State
import Data.Functor.Identity
import Web.Simple.Responses
import Web.Simple.Controller.Trans
import Network.HTTP.Types
data REST m s = REST
{ REST m s -> ControllerT s m ()
restIndex :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restShow :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restCreate :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restUpdate :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restDelete :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restEdit :: ControllerT s m ()
, REST m s -> ControllerT s m ()
restNew :: ControllerT s m ()
}
defaultREST :: Monad m => REST m s
defaultREST :: REST m s
defaultREST = REST :: forall (m :: * -> *) s.
ControllerT s m ()
-> ControllerT s m ()
-> ControllerT s m ()
-> ControllerT s m ()
-> ControllerT s m ()
-> ControllerT s m ()
-> ControllerT s m ()
-> REST m s
REST
{ restIndex :: ControllerT s m ()
restIndex = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restShow :: ControllerT s m ()
restShow = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restCreate :: ControllerT s m ()
restCreate = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restUpdate :: ControllerT s m ()
restUpdate = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restDelete :: ControllerT s m ()
restDelete = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restEdit :: ControllerT s m ()
restEdit = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
, restNew :: ControllerT s m ()
restNew = Response -> ControllerT s m ()
forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond (Response -> ControllerT s m ()) -> Response -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Response
notFound
}
type RESTControllerM m r a = StateT (REST m r) Identity a
rest :: Monad m => RESTControllerM m r a -> REST m r
rest :: RESTControllerM m r a -> REST m r
rest rcontroller :: RESTControllerM m r a
rcontroller = (a, REST m r) -> REST m r
forall a b. (a, b) -> b
snd ((a, REST m r) -> REST m r)
-> (Identity (a, REST m r) -> (a, REST m r))
-> Identity (a, REST m r)
-> REST m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (a, REST m r) -> (a, REST m r)
forall a. Identity a -> a
runIdentity (Identity (a, REST m r) -> REST m r)
-> Identity (a, REST m r) -> REST m r
forall a b. (a -> b) -> a -> b
$ RESTControllerM m r a -> REST m r -> Identity (a, REST m r)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT RESTControllerM m r a
rcontroller REST m r
forall (m :: * -> *) s. Monad m => REST m s
defaultREST
routeREST :: Monad m => REST m s -> ControllerT s m ()
routeREST :: REST m s -> ControllerT s m ()
routeREST rst :: REST m s
rst = do
StdMethod -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
GET (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ do
ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restIndex REST m s
rst
Text -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeName "new" (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restNew REST m s
rst
Text -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar "id" (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ do
ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restShow REST m s
rst
Text -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeName "edit" (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restEdit REST m s
rst
StdMethod -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
POST (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restCreate REST m s
rst
StdMethod -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
DELETE (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Text -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar "id" (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restDelete REST m s
rst
StdMethod -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
PUT (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ Text -> ControllerT s m () -> ControllerT s m ()
forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar "id" (ControllerT s m () -> ControllerT s m ())
-> ControllerT s m () -> ControllerT s m ()
forall a b. (a -> b) -> a -> b
$ REST m s -> ControllerT s m ()
forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restUpdate REST m s
rst
type RESTController m r = RESTControllerM m r ()
index :: ControllerT s m () -> RESTController m s
index :: ControllerT s m () -> RESTController m s
index route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restIndex :: ControllerT s m ()
restIndex = ControllerT s m ()
route }
create :: ControllerT s m () -> RESTController m s
create :: ControllerT s m () -> RESTController m s
create route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restCreate :: ControllerT s m ()
restCreate = ControllerT s m ()
route }
edit :: ControllerT s m () -> RESTController m s
edit :: ControllerT s m () -> RESTController m s
edit route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restEdit :: ControllerT s m ()
restEdit = ControllerT s m ()
route }
new :: ControllerT s m () -> RESTController m s
new :: ControllerT s m () -> RESTController m s
new route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restNew :: ControllerT s m ()
restNew = ControllerT s m ()
route }
show :: ControllerT s m () -> RESTController m s
show :: ControllerT s m () -> RESTController m s
show route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restShow :: ControllerT s m ()
restShow = ControllerT s m ()
route }
update :: ControllerT s m () -> RESTController m s
update :: ControllerT s m () -> RESTController m s
update route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restUpdate :: ControllerT s m ()
restUpdate = ControllerT s m ()
route }
delete :: ControllerT s m () -> RESTController m s
delete :: ControllerT s m () -> RESTController m s
delete route :: ControllerT s m ()
route = (REST m s -> REST m s) -> RESTController m s
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((REST m s -> REST m s) -> RESTController m s)
-> (REST m s -> REST m s) -> RESTController m s
forall a b. (a -> b) -> a -> b
$ \controller :: REST m s
controller ->
REST m s
controller { restDelete :: ControllerT s m ()
restDelete = ControllerT s m ()
route }