{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}

-- | Types and constants for HTTP methods.
--
-- The HTTP standard defines a set of standard methods, when to use them,
-- and how to handle them. The standard set has been provided as a separate
-- data type 'StdMethod', but since you can also use custom methods, the
-- basic type 'Method' is just a synonym for 'ByteString'.
module Network.HTTP.Types.Method (
    -- * HTTP methods
    Method,

    -- ** Constants
    methodGet,
    methodPost,
    methodHead,
    methodPut,
    methodDelete,
    methodTrace,
    methodConnect,
    methodOptions,
    methodPatch,

    -- ** Standard Methods

    -- | One data type that holds all standard HTTP methods.
    StdMethod (..),
    parseMethod,
    renderMethod,
    renderStdMethod,
)
where

import Control.Arrow ((|||))
import Data.Array (Array, Ix, assocs, listArray, (!))
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)

-- $setup
-- >>> import Data.ByteString.Char8 (ByteString)
-- >>> import Data.Text (pack)
-- >>> import Data.Text.Encoding (encodeUtf8)
-- >>> import Test.QuickCheck
-- >>> :{
-- instance Arbitrary ByteString where
--     arbitrary = encodeUtf8 . pack <$> arbitrary
-- :}

-- | HTTP method (flat 'ByteString' type).
type Method = B.ByteString

-- | HTTP GET Method
methodGet :: Method
methodGet :: Method
methodGet = StdMethod -> Method
renderStdMethod StdMethod
GET

-- | HTTP POST Method
methodPost :: Method
methodPost :: Method
methodPost = StdMethod -> Method
renderStdMethod StdMethod
POST

-- | HTTP HEAD Method
methodHead :: Method
methodHead :: Method
methodHead = StdMethod -> Method
renderStdMethod StdMethod
HEAD

-- | HTTP PUT Method
methodPut :: Method
methodPut :: Method
methodPut = StdMethod -> Method
renderStdMethod StdMethod
PUT

-- | HTTP DELETE Method
methodDelete :: Method
methodDelete :: Method
methodDelete = StdMethod -> Method
renderStdMethod StdMethod
DELETE

-- | HTTP TRACE Method
methodTrace :: Method
methodTrace :: Method
methodTrace = StdMethod -> Method
renderStdMethod StdMethod
TRACE

-- | HTTP CONNECT Method
methodConnect :: Method
methodConnect :: Method
methodConnect = StdMethod -> Method
renderStdMethod StdMethod
CONNECT

-- | HTTP OPTIONS Method
methodOptions :: Method
methodOptions :: Method
methodOptions = StdMethod -> Method
renderStdMethod StdMethod
OPTIONS

-- | HTTP PATCH Method
--
-- @since 0.8.0
methodPatch :: Method
methodPatch :: Method
methodPatch = StdMethod -> Method
renderStdMethod StdMethod
PATCH

-- | HTTP standard method (as defined by RFC 2616, and PATCH which is defined
--   by RFC 5789).
--
-- @since 0.2.0
data StdMethod
    = GET
    | POST
    | HEAD
    | PUT
    | DELETE
    | TRACE
    | CONNECT
    | OPTIONS
    | -- | @since 0.8.0
      PATCH
    deriving
        ( ReadPrec [StdMethod]
ReadPrec StdMethod
Int -> ReadS StdMethod
ReadS [StdMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StdMethod]
$creadListPrec :: ReadPrec [StdMethod]
readPrec :: ReadPrec StdMethod
$creadPrec :: ReadPrec StdMethod
readList :: ReadS [StdMethod]
$creadList :: ReadS [StdMethod]
readsPrec :: Int -> ReadS StdMethod
$creadsPrec :: Int -> ReadS StdMethod
Read
        , Int -> StdMethod -> ShowS
[StdMethod] -> ShowS
StdMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StdMethod] -> ShowS
$cshowList :: [StdMethod] -> ShowS
show :: StdMethod -> String
$cshow :: StdMethod -> String
showsPrec :: Int -> StdMethod -> ShowS
$cshowsPrec :: Int -> StdMethod -> ShowS
Show
        , StdMethod -> StdMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StdMethod -> StdMethod -> Bool
$c/= :: StdMethod -> StdMethod -> Bool
== :: StdMethod -> StdMethod -> Bool
$c== :: StdMethod -> StdMethod -> Bool
Eq
        , Eq StdMethod
StdMethod -> StdMethod -> Bool
StdMethod -> StdMethod -> Ordering
StdMethod -> StdMethod -> StdMethod
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 :: StdMethod -> StdMethod -> StdMethod
$cmin :: StdMethod -> StdMethod -> StdMethod
max :: StdMethod -> StdMethod -> StdMethod
$cmax :: StdMethod -> StdMethod -> StdMethod
>= :: StdMethod -> StdMethod -> Bool
$c>= :: StdMethod -> StdMethod -> Bool
> :: StdMethod -> StdMethod -> Bool
$c> :: StdMethod -> StdMethod -> Bool
<= :: StdMethod -> StdMethod -> Bool
$c<= :: StdMethod -> StdMethod -> Bool
< :: StdMethod -> StdMethod -> Bool
$c< :: StdMethod -> StdMethod -> Bool
compare :: StdMethod -> StdMethod -> Ordering
$ccompare :: StdMethod -> StdMethod -> Ordering
Ord
        , Int -> StdMethod
StdMethod -> Int
StdMethod -> [StdMethod]
StdMethod -> StdMethod
StdMethod -> StdMethod -> [StdMethod]
StdMethod -> StdMethod -> StdMethod -> [StdMethod]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: StdMethod -> StdMethod -> StdMethod -> [StdMethod]
$cenumFromThenTo :: StdMethod -> StdMethod -> StdMethod -> [StdMethod]
enumFromTo :: StdMethod -> StdMethod -> [StdMethod]
$cenumFromTo :: StdMethod -> StdMethod -> [StdMethod]
enumFromThen :: StdMethod -> StdMethod -> [StdMethod]
$cenumFromThen :: StdMethod -> StdMethod -> [StdMethod]
enumFrom :: StdMethod -> [StdMethod]
$cenumFrom :: StdMethod -> [StdMethod]
fromEnum :: StdMethod -> Int
$cfromEnum :: StdMethod -> Int
toEnum :: Int -> StdMethod
$ctoEnum :: Int -> StdMethod
pred :: StdMethod -> StdMethod
$cpred :: StdMethod -> StdMethod
succ :: StdMethod -> StdMethod
$csucc :: StdMethod -> StdMethod
Enum
        , StdMethod
forall a. a -> a -> Bounded a
maxBound :: StdMethod
$cmaxBound :: StdMethod
minBound :: StdMethod
$cminBound :: StdMethod
Bounded
        , Ord StdMethod
(StdMethod, StdMethod) -> Int
(StdMethod, StdMethod) -> [StdMethod]
(StdMethod, StdMethod) -> StdMethod -> Bool
(StdMethod, StdMethod) -> StdMethod -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (StdMethod, StdMethod) -> Int
$cunsafeRangeSize :: (StdMethod, StdMethod) -> Int
rangeSize :: (StdMethod, StdMethod) -> Int
$crangeSize :: (StdMethod, StdMethod) -> Int
inRange :: (StdMethod, StdMethod) -> StdMethod -> Bool
$cinRange :: (StdMethod, StdMethod) -> StdMethod -> Bool
unsafeIndex :: (StdMethod, StdMethod) -> StdMethod -> Int
$cunsafeIndex :: (StdMethod, StdMethod) -> StdMethod -> Int
index :: (StdMethod, StdMethod) -> StdMethod -> Int
$cindex :: (StdMethod, StdMethod) -> StdMethod -> Int
range :: (StdMethod, StdMethod) -> [StdMethod]
$crange :: (StdMethod, StdMethod) -> [StdMethod]
Ix
        , Typeable
        , -- | @since 0.12.4
          forall x. Rep StdMethod x -> StdMethod
forall x. StdMethod -> Rep StdMethod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StdMethod x -> StdMethod
$cfrom :: forall x. StdMethod -> Rep StdMethod x
Generic
        , -- | @since 0.12.4
          Typeable StdMethod
StdMethod -> DataType
StdMethod -> Constr
(forall b. Data b => b -> b) -> StdMethod -> StdMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StdMethod -> u
forall u. (forall d. Data d => d -> u) -> StdMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StdMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StdMethod -> c StdMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StdMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StdMethod)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StdMethod -> m StdMethod
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StdMethod -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StdMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> StdMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StdMethod -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StdMethod -> r
gmapT :: (forall b. Data b => b -> b) -> StdMethod -> StdMethod
$cgmapT :: (forall b. Data b => b -> b) -> StdMethod -> StdMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StdMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StdMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StdMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StdMethod)
dataTypeOf :: StdMethod -> DataType
$cdataTypeOf :: StdMethod -> DataType
toConstr :: StdMethod -> Constr
$ctoConstr :: StdMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StdMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StdMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StdMethod -> c StdMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StdMethod -> c StdMethod
Data
        )

-- These are ordered by suspected frequency. More popular methods should go first.
-- The reason is that methodList is used with lookup.
-- lookup is probably faster for these few cases than setting up an elaborate data structure.

-- FIXME: listArray (minBound, maxBound) $ fmap fst methodList
methodArray :: Array StdMethod Method
methodArray :: Array StdMethod Method
methodArray = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (String -> Method
B8.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [forall a. Bounded a => a
minBound :: StdMethod .. forall a. Bounded a => a
maxBound]

-- FIXME: map (\m -> (B8.pack $ show m, m)) [minBound .. maxBound]
methodList :: [(Method, StdMethod)]
methodList :: [(Method, StdMethod)]
methodList = forall a b. (a -> b) -> [a] -> [b]
map (\(StdMethod
a, Method
b) -> (Method
b, StdMethod
a)) (forall i e. Ix i => Array i e -> [(i, e)]
assocs Array StdMethod Method
methodArray)

-- | Convert a method 'ByteString' to a 'StdMethod' if possible.
--
-- @since 0.2.0
parseMethod :: Method -> Either B.ByteString StdMethod
parseMethod :: Method -> Either Method StdMethod
parseMethod Method
bs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Method
bs) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Method
bs [(Method, StdMethod)]
methodList

-- | Convert an algebraic method to a 'ByteString'.
--
-- prop> renderMethod (parseMethod bs) == bs
--
-- @since 0.3.0
renderMethod :: Either B.ByteString StdMethod -> Method
renderMethod :: Either Method StdMethod -> Method
renderMethod = forall a. a -> a
id forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| StdMethod -> Method
renderStdMethod

-- | Convert a 'StdMethod' to a 'ByteString'.
--
-- @since 0.2.0
renderStdMethod :: StdMethod -> Method
renderStdMethod :: StdMethod -> Method
renderStdMethod StdMethod
m = Array StdMethod Method
methodArray forall i e. Ix i => Array i e -> i -> e
! StdMethod
m