Added a onlyAllowMethods function to filter for specific methods when…

… building custom routing parsers

IHP/RouterSupport.hs

@@ -23,6 +23,7 @@ CanRoute (..)
 , parseText
 , webSocketApp
 , webSocketAppWithCustomPath
+, onlyAllowMethods
 ) where
 
 import qualified Prelude
@@ -599,6 +600,37 @@ post path action = do
         _   -> fail "Invalid method, expected POST"
 {-# INLINABLE post #-}
 
+-- | Filter methods when writing a custom routing parser
+--
+-- __Example:__
+--
+-- > instance CanRoute ApiController where
+-- >    parseRoute' = do
+-- >        string "/api/"
+-- >        let
+-- >            createRecordAction = do
+-- >                onlyAllowMethods [POST]
+-- >
+-- >                table <- parseText
+-- >                endOfInput
+-- >                pure CreateRecordAction { table }
+-- >
+-- >            updateRecordAction = do
+-- >                onlyAllowMethods [PATCH]
+-- >                
+-- >                table <- parseText
+-- >                string "/"
+-- >                id <- parseUUID
+-- >                pure UpdateRecordAction { table, id }
+-- >        
+-- > createRecordAction <|> updateRecordAction
+--
+onlyAllowMethods :: (?context :: RequestContext) => [StdMethod] -> Parser ()
+onlyAllowMethods methods = do
+    method <- getMethod
+    unless (method `elem` methods) (fail ("Invalid method, expected one of: " <> show methods))
+{-# INLINABLE onlyAllowMethods #-}
+
 -- | Routes to a given WebSocket app if the path matches the WebSocket app name
 --
 -- __Example:__