{-# 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
  { forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restIndex   :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restShow    :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restCreate  :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restUpdate  :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restDelete  :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restEdit    :: ControllerT s m ()
  , forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restNew     :: ControllerT s m ()
  }

-- | Default state, returns @404@ for all verbs.
defaultREST :: Monad m => REST m s
defaultREST :: forall (m :: * -> *) s. Monad m => REST m s
defaultREST = REST
  { restIndex :: ControllerT s m ()
restIndex   = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restShow :: ControllerT s m ()
restShow    = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restCreate :: ControllerT s m ()
restCreate  = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restUpdate :: ControllerT s m ()
restUpdate  = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restDelete :: ControllerT s m ()
restDelete  = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restEdit :: ControllerT s m ()
restEdit    = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond forall a b. (a -> b) -> a -> b
$ Response
notFound
  , restNew :: ControllerT s m ()
restNew     = forall (m :: * -> *) s a. Monad m => Response -> ControllerT s m a
respond 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 :: forall (m :: * -> *) r a.
Monad m =>
RESTControllerM m r a -> REST m r
rest RESTControllerM m r a
rcontroller = forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT RESTControllerM m r a
rcontroller forall (m :: * -> *) s. Monad m => REST m s
defaultREST

routeREST :: Monad m => REST m s -> ControllerT s m ()
routeREST :: forall (m :: * -> *) s. Monad m => REST m s -> ControllerT s m ()
routeREST REST m s
rst = do
  forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
GET forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restIndex REST m s
rst
    forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeName Text
"new" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restNew REST m s
rst
    forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar Text
"id" forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restShow REST m s
rst
      forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeName Text
"edit" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restEdit REST m s
rst

  forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
POST forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a.
Monad m =>
ControllerT s m a -> ControllerT s m ()
routeTop forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restCreate REST m s
rst

  forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
DELETE forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar Text
"id" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. REST m s -> ControllerT s m ()
restDelete REST m s
rst

  forall (m :: * -> *) s a.
Monad m =>
StdMethod -> ControllerT s m a -> ControllerT s m ()
routeMethod StdMethod
PUT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a.
Monad m =>
Text -> ControllerT s m a -> ControllerT s m ()
routeVar Text
"id" forall a b. (a -> b) -> a -> b
$ 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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
index ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
create ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
edit ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
new ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
show ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
update ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \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 :: forall s (m :: * -> *). ControllerT s m () -> RESTController m s
delete ControllerT s m ()
route = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify forall a b. (a -> b) -> a -> b
$ \REST m s
controller ->
  REST m s
controller { restDelete :: ControllerT s m ()
restDelete = ControllerT s m ()
route }