Router Support [UUID]

Author: s0kil

IHP/RouterSupport.hs

@@ -179,6 +179,18 @@ parseFuncs parseIdType = [
                     Nothing -> Right []
                 Nothing -> Left NotMatched,
 
+            -- Try and parse a raw [UUID]
+            \queryValue -> case eqT :: Maybe (d :~: [UUID]) of
+                Just Refl -> case queryValue of
+                    Just queryValue -> queryValue
+                        |> cs
+                        |> Text.splitOn ","
+                        |> map (fromASCIIBytes . cs)
+                        |> catMaybes
+                        |> Right
+                    Nothing -> Right []
+                Nothing -> Left NotMatched,
+
             -- Try and parse a raw UUID
             \queryValue -> case eqT :: Maybe (d :~: UUID) of
                 Just Refl -> case queryValue of
@@ -618,12 +630,12 @@ post path action = do
 -- >
 -- >            updateRecordAction = do
 -- >                onlyAllowMethods [PATCH]
--- >                
+-- >
 -- >                table <- parseText
 -- >                string "/"
 -- >                id <- parseUUID
 -- >                pure UpdateRecordAction { table, id }
--- >        
+-- >
 -- > createRecordAction <|> updateRecordAction
 --
 onlyAllowMethods :: (?context :: RequestContext) => [StdMethod] -> Parser ()
@@ -800,4 +812,4 @@ parseIntegerId queryVal = let
 --
 -- See https://forum.ihpapp.com/ShowThread?threadId=ad73d6a5-2481-4e2f-af46-9bf8849f998b
 -- See https://github.com/digitallyinduced/ihp/issues/840
-instance ((T.TypeError (T.Text "Looks like you forgot to pass a " :<>: (T.ShowType argument) :<>: T.Text " to this " :<>: (T.ShowType controller))), Data argument, Data controller) => AutoRoute (argument -> controller) where
+instance ((T.TypeError (T.Text "Looks like you forgot to pass a " :<>: (T.ShowType argument) :<>: T.Text " to this " :<>: (T.ShowType controller))), Data argument, Data controller) => AutoRoute (argument -> controller) where

Test/RouterSupportSpec.hs

@@ -65,6 +65,7 @@ data TestController
   | TestInteger { p1 :: Integer, p2 :: Maybe Integer, p3 :: [Integer] }
   | TestIntegerId { integerId :: Id Band }
   | TestUUIDId { uuidId :: Id Performance }
+  | TestUUIDList { uuidList :: [UUID] }
   deriving (Eq, Show, Data)
 
 instance Controller TestController where
@@ -103,6 +104,8 @@ instance Controller TestController where
         renderPlain (cs $ ClassyPrelude.show integerId)
     action TestUUIDId { .. } = do
         renderPlain (cs $ ClassyPrelude.show uuidId)
+    action TestUUIDList { .. } = do
+        renderPlain $ cs $ ClassyPrelude.show uuidList
 
 instance AutoRoute TestController where
     autoRoute = autoRouteWithIdType (parseIntegerId @(Id Band))
@@ -186,6 +189,14 @@ tests = beforeAll (mockContextNoDatabase WebApplication config) do
             runSession (testGet "test/TestIntegerId?integerId=123") Server.application >>= assertSuccess "123"
         it "parses Id with UUID param" $ withContext do
             runSession (testGet "test/TestUUIDId?uuidId=8dd57d19-490a-4323-8b94-6081ab93bf34") Server.application >>= assertSuccess "8dd57d19-490a-4323-8b94-6081ab93bf34"
+        it "parses [UUID] param: empty" $ withContext do
+            runSession (testGet "test/TestUUIDList") Server.application >>= assertSuccess "[]"
+        it "parses [UUID] param: one element" $ withContext do
+            runSession (testGet "test/TestUUIDList?uuidList=8dd57d19-490a-4323-8b94-6081ab93bf34") Server.application >>= assertSuccess "[8dd57d19-490a-4323-8b94-6081ab93bf34]"
+        it "parses [UUID] param: multiple elements" $ withContext do
+            runSession (testGet "test/TestUUIDList?uuidList=8dd57d19-490a-4323-8b94-6081ab93bf34,8dd57d19-490a-4323-8b94-6081ab93bf34") Server.application >>= assertSuccess "[8dd57d19-490a-4323-8b94-6081ab93bf34,8dd57d19-490a-4323-8b94-6081ab93bf34]"
+        it "parses [UUID] param: multiple elements, ignoring non UUID" $ withContext do
+            runSession (testGet "test/TestUUIDList?uuidList=8dd57d19-490a-4323-8b94-6081ab93bf34,423423432432432") Server.application >>= assertSuccess "[8dd57d19-490a-4323-8b94-6081ab93bf34]"
     describe "pathTo" $ do
         it "generates correct path for empty route" $ withContext do
             pathTo TestAction `shouldBe` "/test/Test"