Add HTTP QUERY method

.github/workflows/ci.yml

@@ -11,16 +11,17 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
 
       - name: Set up a PureScript toolchain
         uses: purescript-contrib/setup-purescript@main
         with:
-          purescript: "unstable"
+          purescript: "0.15.0"
+          spago: "0.20.9"
           purs-tidy: "latest"
 
       - name: Cache PureScript dependencies
-        uses: actions/cache@v2
+        uses: actions/cache@v4
         with:
           key: ${{ runner.os }}-spago-${{ hashFiles('**/*.dhall') }}
           path: |
@@ -40,7 +41,7 @@ jobs:
         run: |
           npm install bower pulp@16.0.0-0
           npx bower install
-          npx pulp build -- --censor-lib --strict
+          npx pulp build
           if [ -d "test" ]; then
             npx pulp test
           fi

packages.dhall

@@ -1,4 +1,5 @@
 let upstream =
-      https://raw.githubusercontent.com/purescript/package-sets/prepare-0.15/src/packages.dhall
+      https://raw.githubusercontent.com/purescript/package-sets/psc-0.15.0-20220502/src/packages.dhall
+        sha256:38d347aeba9fe6359c208abe87a5cecf1ffb14294f11ad19664ae35c59b6e29a
 
 in  upstream

src/Data/HTTP/Method.purs

@@ -12,8 +12,9 @@ import Data.Either (Either(..), either)
 import Data.String as Str
 
 -- | The definition of the type is based on HTTP/1.1 with
--- | [RFC 2518](https://tools.ietf.org/html/rfc2518) and
--- | [RFC 5789](https://tools.ietf.org/html/rfc5789).
+-- | [RFC 2518](https://tools.ietf.org/html/rfc2518),
+-- | [RFC 5789](https://tools.ietf.org/html/rfc5789), and
+-- | [RFC 9842](https://www.rfc-editor.org/rfc/rfc9842).
 data Method
   -- HTTP/1.1
   = OPTIONS
@@ -37,6 +38,9 @@ data Method
   -- RFC5789
   | PATCH
 
+  -- RFC 9842
+  | QUERY
+
 derive instance eqMethod :: Eq Method
 derive instance ordMethod :: Ord Method
 
@@ -57,6 +61,7 @@ instance showMethod :: Show Method where
   show LOCK = "LOCK"
   show UNLOCK = "UNLOCK"
   show PATCH = "PATCH"
+  show QUERY = "QUERY"
 
 newtype CustomMethod = CustomMethod String
 
@@ -91,6 +96,7 @@ parse handleMethod handleUnknown s =
     "LOCK" -> handleMethod LOCK
     "UNLOCK" -> handleMethod UNLOCK
     "PATCH" -> handleMethod PATCH
+    "QUERY" -> handleMethod QUERY
     m -> handleUnknown m
 
 fromString :: String -> Either Method CustomMethod

test/Main.js

@@ -0,0 +1,3 @@
+export const fail = message => () => {
+  throw new Error(message);
+};

test/Main.purs

@@ -0,0 +1,25 @@
+module Test.Main where
+
+import Prelude
+
+import Data.Either (Either(..))
+import Data.HTTP.Method (Method(..), fromString, print, unCustomMethod)
+import Effect (Effect)
+
+foreign import fail :: String -> Effect Unit
+
+assertEqual :: forall a. Eq a => Show a => String -> a -> a -> Effect Unit
+assertEqual label expected actual =
+  unless (actual == expected) do
+    fail (label <> ": expected " <> show expected <> ", got " <> show actual)
+
+main :: Effect Unit
+main = do
+  assertEqual "show QUERY" "QUERY" (show QUERY)
+  assertEqual "print QUERY" "QUERY" (print (Left QUERY))
+  assertEqual "parse uppercase QUERY" (Left QUERY) (fromString "QUERY")
+  assertEqual "parse lowercase QUERY" (Left QUERY) (fromString "query")
+  assertEqual "parse mixed-case QUERY" (Left QUERY) (fromString "QuErY")
+  case fromString "FROB" of
+    Left method -> fail ("unknown method parsed as " <> show method)
+    Right custom -> assertEqual "unknown method" "FROB" (unCustomMethod custom)