wip

Author: AugmenTab

orb.cabal

@@ -129,6 +129,7 @@ test-suite orb-test
       Fixtures.SimplePost
       Fixtures.TaggedUnion
       Fixtures.Union
+      Form
       Handler
       OpenApi
       SwaggerUI

package.yaml

@@ -31,7 +31,6 @@ extra-source-files:
   - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui-standalone-preset.js
   - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui.css
   - src/Orb/SwaggerUI/swagger-ui-dist-5.25.2/swagger-ui.js
-  
 
 # Metadata used when publishing your package
 # synopsis:            Short description of your package

src/Orb/Handler/Form.hs

@@ -42,7 +42,7 @@ insertParamField ::
   Map.Map T.Text (NEL.NonEmpty T.Text)
 insertParamField params (k, v) =
   Map.insertWith
-    (<>)
+    appendField
     (TE.decodeUtf8 k)
     (NEL.singleton $ TE.decodeUtf8 v)
     params
@@ -53,11 +53,15 @@ insertFileField ::
   Map.Map T.Text (NEL.NonEmpty (Wai.FileInfo LBS.ByteString))
 insertFileField files (k, v) =
   Map.insertWith
-    (<>)
+    appendField
     (TE.decodeUtf8 k)
     (NEL.singleton v)
     files
 
+appendField :: NEL.NonEmpty a -> NEL.NonEmpty a -> NEL.NonEmpty a
+appendField new old =
+  old <> new
+
 data FormField
   = ParamField (NEL.NonEmpty T.Text)
   | FileField (NEL.NonEmpty (Wai.FileInfo LBS.ByteString))

stack.yaml.lock

@@ -57,29 +57,29 @@ packages:
 - completed:
     name: json-fleece-aeson
     pantry-tree:
-      sha256: 4821f2305b6a4a38fea102375dce74a3f9296cb804aaa009fead93d07b73e51d
-      size: 581
-    sha256: f39c90b9e0dd1efbc362fd4f012ca9d0475bba7982b97964b97b8a598f3165d7
-    size: 3068986
+      sha256: d687b890f3727930fba309980fdb2b7f099e3c6092006940867c7fed3c19bd64
+      size: 628
+    sha256: d37000c263116c1f30d69dde80ece99f2a0037a5f07a378537cb282c3ac5debf
+    size: 3073901
     subdir: json-fleece-aeson
-    url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz
+    url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz
     version: 0.3.8.0
   original:
     subdir: json-fleece-aeson
-    url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz
+    url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz
 - completed:
     name: json-fleece-core
     pantry-tree:
-      sha256: 4f1b4f4684155abec72fe865975865e0caa94a01440c0281e38f864afb052c02
-      size: 444
-    sha256: f39c90b9e0dd1efbc362fd4f012ca9d0475bba7982b97964b97b8a598f3165d7
-    size: 3068986
+      sha256: 5adc2bf8c045e936eeb32d4388ee1dcd44cb4557e078b485c9a7415b98a9387f
+      size: 491
+    sha256: d37000c263116c1f30d69dde80ece99f2a0037a5f07a378537cb282c3ac5debf
+    size: 3073901
     subdir: json-fleece-core
-    url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz
+    url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz
     version: 0.8.0.0
   original:
     subdir: json-fleece-core
-    url: https://github.com/flipstone/json-fleece/archive/4dcf90fc0c24abe28dfa029db74adc32dbb6b027.tar.gz
+    url: https://github.com/flipstone/json-fleece/archive/2064e681d594a603fcbaf2e58105c64ee53156a1.tar.gz
 snapshots:
 - completed:
     sha256: 0d0bb681dd5be9b930c8fc070d717aae757b9aed176ae6047d87624b46406816

test/Form.hs

@@ -0,0 +1,51 @@
+module Form
+  ( testGroup
+  ) where
+
+import Data.List.NonEmpty qualified as NEL
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Hedgehog ((===))
+import Hedgehog qualified as HH
+import Hedgehog.Gen qualified as Gen
+import Hedgehog.Range qualified as Range
+import Test.Tasty qualified as Tasty
+import Test.Tasty.Hedgehog qualified as TastyHH
+
+import Orb qualified
+
+testGroup :: Tasty.TestTree
+testGroup =
+  Tasty.testGroup
+    "Form"
+    [ TastyHH.testProperty "preserves the order of a repeated param" prop_repeatedParamOrderPreserved
+    ]
+
+prop_repeatedParamOrderPreserved :: HH.Property
+prop_repeatedParamOrderPreserved = HH.property $ do
+  vals <-
+    HH.forAll
+      . Gen.nonEmpty (Range.linear 1 50)
+      $ Gen.text (Range.linear 1 12) Gen.alphaNum
+
+  let
+    keyText = T.pack "item"
+    key = TE.encodeUtf8 keyText
+    params =
+      [ (key, TE.encodeUtf8 v)
+      | v <- NEL.toList vals
+      ]
+
+  form <- HH.evalEither $ Orb.getForm (params, [])
+  field <-
+    maybe
+      (fail "Expected key 'item' to exist in the form.")
+      pure
+      (Map.lookup keyText form)
+
+  case field of
+    Orb.ParamField ps ->
+      NEL.toList ps === NEL.toList vals
+    Orb.FileField _fs ->
+      fail "Expected ParamField for 'item', but got FileField."

test/Main.hs

@@ -4,6 +4,7 @@ module Main
 
 import Test.Tasty qualified as Tasty
 
+import Form qualified
 import Handler qualified
 import OpenApi qualified
 import SwaggerUI qualified
@@ -13,7 +14,8 @@ main =
   Tasty.defaultMain $
     Tasty.testGroup
       "Orb"
-      [ Handler.testGroup
+      [ Form.testGroup
+      , Handler.testGroup
       , OpenApi.testGroup
       , SwaggerUI.testGroup
       ]