Servant Method combinator to match routes by method early

Method.hs

-- combinator that returns a mismatch if the method doesn't match
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Servant.Method where

import qualified Network.HTTP.Types as HTTP
import Network.Wai (requestMethod)
import Servant
import Servant.Server.Internal

data GET
data POST
data DELETE
data PUT

data Method a

class ToMethod method where
    toMethod :: Proxy method -> HTTP.Method

instance ToMethod GET where
    toMethod _ = HTTP.methodGet

instance ToMethod POST where
    toMethod _ = HTTP.methodPost

instance ToMethod DELETE where
    toMethod _ = HTTP.methodDelete

instance ToMethod PUT where
    toMethod _ = HTTP.methodPut

instance (ToMethod method, HasServer api) => HasServer (Method method :> api) where
  type ServerT (Method method :> api) m =
    ServerT api m

  route Proxy api req respond = do
    if requestMethod req == toMethod (Proxy :: Proxy method)
      then route (Proxy :: Proxy api) api req respond
      else respond . failWith $ WrongMethod

ModelAPI.hs

type ModelAPI =
    "models" :>
        (    ProjectKey :> Get '[JSON] [Model]
        -- Bug in MultipartUpload. Has to be last or it expects EVERYTHING to have multipart uploads
        :<|> ProjectKey :> Method POST :> MultipartUpload :> Post '[JSON] Model
        :<|> ProjectKey :> Capture "modelID" ID :> Get '[JSON] Model
        )