-- |Representation of HTTP request methods.
{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, OverloadedStrings #-}
module Web.Route.Invertible.Method
  ( Method(..)
  , IsMethod(..)
  ) where

import Prelude hiding (lookup)

import Data.ByteString (ByteString)
import qualified Network.HTTP.Types.Method as H
#ifdef VERSION_snap_core
import qualified Snap.Core as Snap
#endif
#ifdef VERSION_happstack_server
import qualified Happstack.Server.Types as HS
#endif

import Web.Route.Invertible.Parameter

-- |Standard HTTP methods.
-- These are defined a number of places already, but the http-types version (which is the only thing we import by default) is too cumbersome.
data Method
  = OPTIONS
  | GET
  | HEAD
  | POST
  | PUT
  | DELETE
  | TRACE
  | CONNECT
  | PATCH
  | ExtensionMethod !ByteString
  deriving (Method -> Method -> Bool
(Method -> Method -> Bool)
-> (Method -> Method -> Bool) -> Eq Method
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Method -> Method -> Bool
$c/= :: Method -> Method -> Bool
== :: Method -> Method -> Bool
$c== :: Method -> Method -> Bool
Eq, Eq Method
Eq Method
-> (Method -> Method -> Ordering)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Bool)
-> (Method -> Method -> Method)
-> (Method -> Method -> Method)
-> Ord Method
Method -> Method -> Bool
Method -> Method -> Ordering
Method -> Method -> Method
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Method -> Method -> Method
$cmin :: Method -> Method -> Method
max :: Method -> Method -> Method
$cmax :: Method -> Method -> Method
>= :: Method -> Method -> Bool
$c>= :: Method -> Method -> Bool
> :: Method -> Method -> Bool
$c> :: Method -> Method -> Bool
<= :: Method -> Method -> Bool
$c<= :: Method -> Method -> Bool
< :: Method -> Method -> Bool
$c< :: Method -> Method -> Bool
compare :: Method -> Method -> Ordering
$ccompare :: Method -> Method -> Ordering
$cp1Ord :: Eq Method
Ord, ReadPrec [Method]
ReadPrec Method
Int -> ReadS Method
ReadS [Method]
(Int -> ReadS Method)
-> ReadS [Method]
-> ReadPrec Method
-> ReadPrec [Method]
-> Read Method
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Method]
$creadListPrec :: ReadPrec [Method]
readPrec :: ReadPrec Method
$creadPrec :: ReadPrec Method
readList :: ReadS [Method]
$creadList :: ReadS [Method]
readsPrec :: Int -> ReadS Method
$creadsPrec :: Int -> ReadS Method
Read, Int -> Method -> ShowS
[Method] -> ShowS
Method -> String
(Int -> Method -> ShowS)
-> (Method -> String) -> ([Method] -> ShowS) -> Show Method
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Method] -> ShowS
$cshowList :: [Method] -> ShowS
show :: Method -> String
$cshow :: Method -> String
showsPrec :: Int -> Method -> ShowS
$cshowsPrec :: Int -> Method -> ShowS
Show)

instance Parameter ByteString Method where
  parseParameter :: ByteString -> Maybe Method
parseParameter = Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method)
-> (ByteString -> Method) -> ByteString -> Maybe Method
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Method
forall m. IsMethod m => m -> Method
toMethod
  renderParameter :: Method -> ByteString
renderParameter Method
OPTIONS = ByteString
"OPTIONS"
  renderParameter Method
GET = ByteString
"GET"
  renderParameter Method
HEAD = ByteString
"HEAD"
  renderParameter Method
POST = ByteString
"POST"
  renderParameter Method
PUT = ByteString
"PUT"
  renderParameter Method
DELETE = ByteString
"DELETE"
  renderParameter Method
TRACE = ByteString
"TRACE"
  renderParameter Method
CONNECT = ByteString
"CONNECT"
  renderParameter Method
PATCH = ByteString
"PATCH"
  renderParameter (ExtensionMethod ByteString
m) = ByteString
m

-- |Any types that represent an HTTP method.
class IsMethod m where
  toMethod :: m -> Method
  fromMethod :: Method -> Maybe m

instance IsMethod Method where
  toMethod :: Method -> Method
toMethod = Method -> Method
forall a. a -> a
id
  fromMethod :: Method -> Maybe Method
fromMethod = Method -> Maybe Method
forall a. a -> Maybe a
Just

instance IsMethod H.StdMethod where
  toMethod :: StdMethod -> Method
toMethod StdMethod
H.GET = Method
GET
  toMethod StdMethod
H.POST = Method
POST
  toMethod StdMethod
H.HEAD = Method
HEAD
  toMethod StdMethod
H.PUT = Method
PUT
  toMethod StdMethod
H.DELETE = Method
DELETE
  toMethod StdMethod
H.TRACE = Method
TRACE
  toMethod StdMethod
H.CONNECT = Method
CONNECT
  toMethod StdMethod
H.OPTIONS = Method
OPTIONS
  toMethod StdMethod
H.PATCH = Method
PATCH
  fromMethod :: Method -> Maybe StdMethod
fromMethod Method
GET = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.GET
  fromMethod Method
POST = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.POST
  fromMethod Method
HEAD = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.HEAD
  fromMethod Method
PUT = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.PUT
  fromMethod Method
DELETE = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.DELETE
  fromMethod Method
TRACE = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.TRACE
  fromMethod Method
CONNECT = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.CONNECT
  fromMethod Method
OPTIONS = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.OPTIONS
  fromMethod Method
PATCH = StdMethod -> Maybe StdMethod
forall a. a -> Maybe a
Just StdMethod
H.PATCH
  fromMethod Method
_ = Maybe StdMethod
forall a. Maybe a
Nothing

instance IsMethod (Either ByteString H.StdMethod) where
  toMethod :: Either ByteString StdMethod -> Method
toMethod = (ByteString -> Method)
-> (StdMethod -> Method) -> Either ByteString StdMethod -> Method
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ByteString -> Method
ExtensionMethod StdMethod -> Method
forall m. IsMethod m => m -> Method
toMethod
  fromMethod :: Method -> Maybe (Either ByteString StdMethod)
fromMethod (ExtensionMethod ByteString
e) = Either ByteString StdMethod -> Maybe (Either ByteString StdMethod)
forall a. a -> Maybe a
Just (Either ByteString StdMethod
 -> Maybe (Either ByteString StdMethod))
-> Either ByteString StdMethod
-> Maybe (Either ByteString StdMethod)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either ByteString StdMethod
forall a b. a -> Either a b
Left ByteString
e
  fromMethod Method
m = StdMethod -> Either ByteString StdMethod
forall a b. b -> Either a b
Right (StdMethod -> Either ByteString StdMethod)
-> Maybe StdMethod -> Maybe (Either ByteString StdMethod)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Method -> Maybe StdMethod
forall m. IsMethod m => Method -> Maybe m
fromMethod Method
m

instance IsMethod ByteString where
  toMethod :: ByteString -> Method
toMethod ByteString
"OPTIONS" = Method
OPTIONS
  toMethod ByteString
"GET" = Method
GET
  toMethod ByteString
"HEAD" = Method
HEAD
  toMethod ByteString
"POST" = Method
POST
  toMethod ByteString
"PUT" = Method
PUT
  toMethod ByteString
"DELETE" = Method
DELETE
  toMethod ByteString
"TRACE" = Method
TRACE
  toMethod ByteString
"CONNECT" = Method
CONNECT
  toMethod ByteString
"PATCH" = Method
PATCH
  toMethod ByteString
m = ByteString -> Method
ExtensionMethod ByteString
m
  fromMethod :: Method -> Maybe ByteString
fromMethod = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Method -> ByteString) -> Method -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> ByteString
forall s a. Parameter s a => a -> s
renderParameter

#ifdef VERSION_snap_core
instance IsMethod Snap.Method where
  toMethod :: Method -> Method
toMethod Method
Snap.GET = Method
GET
  toMethod Method
Snap.HEAD = Method
HEAD
  toMethod Method
Snap.POST = Method
POST
  toMethod Method
Snap.PUT = Method
PUT
  toMethod Method
Snap.DELETE = Method
DELETE
  toMethod Method
Snap.TRACE = Method
TRACE
  toMethod Method
Snap.OPTIONS = Method
OPTIONS
  toMethod Method
Snap.CONNECT = Method
CONNECT
  toMethod Method
Snap.PATCH = Method
PATCH
  toMethod (Snap.Method ByteString
m) = ByteString -> Method
ExtensionMethod ByteString
m
  fromMethod :: Method -> Maybe Method
fromMethod Method
GET = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.GET
  fromMethod Method
HEAD = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.HEAD
  fromMethod Method
POST = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.POST
  fromMethod Method
PUT = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.PUT
  fromMethod Method
DELETE = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.DELETE
  fromMethod Method
TRACE = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.TRACE
  fromMethod Method
OPTIONS = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.OPTIONS
  fromMethod Method
CONNECT = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.CONNECT
  fromMethod Method
PATCH = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
Snap.PATCH
  fromMethod (ExtensionMethod ByteString
m) = Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method) -> Method -> Maybe Method
forall a b. (a -> b) -> a -> b
$ ByteString -> Method
Snap.Method ByteString
m
#endif

#ifdef VERSION_happstack_server
instance IsMethod HS.Method where
  toMethod :: Method -> Method
toMethod Method
HS.GET = Method
GET
  toMethod Method
HS.HEAD = Method
HEAD
  toMethod Method
HS.POST = Method
POST
  toMethod Method
HS.PUT = Method
PUT
  toMethod Method
HS.DELETE = Method
DELETE
  toMethod Method
HS.TRACE = Method
TRACE
  toMethod Method
HS.OPTIONS = Method
OPTIONS
  toMethod Method
HS.CONNECT = Method
CONNECT
  toMethod Method
HS.PATCH = Method
PATCH
  toMethod (HS.EXTENSION ByteString
m) = ByteString -> Method
ExtensionMethod ByteString
m
  fromMethod :: Method -> Maybe Method
fromMethod Method
GET = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.GET
  fromMethod Method
HEAD = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.HEAD
  fromMethod Method
POST = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.POST
  fromMethod Method
PUT = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.PUT
  fromMethod Method
DELETE = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.DELETE
  fromMethod Method
TRACE = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.TRACE
  fromMethod Method
OPTIONS = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.OPTIONS
  fromMethod Method
CONNECT = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.CONNECT
  fromMethod Method
PATCH = Method -> Maybe Method
forall a. a -> Maybe a
Just Method
HS.PATCH
  fromMethod (ExtensionMethod ByteString
m) = Method -> Maybe Method
forall a. a -> Maybe a
Just (Method -> Maybe Method) -> Method -> Maybe Method
forall a b. (a -> b) -> a -> b
$ ByteString -> Method
HS.EXTENSION ByteString
m
#endif