{-# LANGUAGE Safe, FlexibleInstances, OverloadedStrings #-}
{- |

REST is a DSL for creating routes using RESTful HTTP verbs.
See <http://en.wikipedia.org/wiki/Representational_state_transfer>

-}
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

-- | Type used to encode a REST controller.
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 ()
  }

-- | Default state, returns @404@ for all verbs.
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
  }

-- | Monad used to encode a REST controller incrementally.
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 ()

-- | GET \/
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 }

-- | POST \/
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 }

-- | GET \/:id\/edit
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 }

-- | GET \/new
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 }

-- | GET \/:id
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 }

-- | PUT \/:id
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 \/:id
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 }