Added lookup functions for multiple files

servant-multipart/servant-multipart.cabal

@@ -63,6 +63,7 @@ test-suite servant-multipart-test
     , string-conversions
     , tasty
     , tasty-wai
+    , tasty-hunit
     , text
 
 source-repository head

servant-multipart/src/Servant/Multipart.hs

@@ -21,8 +21,13 @@ module Servant.Multipart
   , MultipartForm'
   , MultipartData(..)
   , FromMultipart(..)
+  , FromText (..)
   , lookupInput
   , lookupFile
+  , lookupAllInputs
+  , lookupAllFiles 
+  , lookupInputAs 
+  , lookupAllInputsAs 
   , MultipartOptions(..)
   , defaultMultipartOptions
   , MultipartBackend(..)
@@ -75,6 +80,115 @@ lookupFile iname =
   . find ((==iname) . fdInputName)
   . files
 
+-- | Lookup all textual inputs with the given @name@ attribute.
+-- 
+-- This function returns a list of all values for inputs with the specified name.
+-- It is useful when handling forms that allow multiple inputs with the same name,
+-- such as multiple select inputs or checkboxes. If no inputs are found, Left is returned
+--
+-- Example:
+--
+-- >>> let mpd = MultipartData [Input "color" "red", Input "color" "blue"] []
+-- >>> lookupAllInputs "color" mpd
+-- ["red", "blue"]
+-- >>> lookupAllInputs "size" mpd
+-- []
+lookupAllInputs :: Text -> MultipartData tag -> Either String [Text]
+lookupAllInputs iname mpd = 
+  let lst = [ val | (Input name val) <- inputs mpd, name == iname ]
+    in if null lst then Left $ "Field " <> cs iname <> " not found"
+       else Right lst
+
+-- | Lookup all file inputs with the given @name@ attribute.
+--
+-- This function returns a list of all files uploaded under the specified name.
+-- It is useful when handling forms that allow multiple file uploads with the same
+-- name, such as file inputs with the @multiple@ attribute. If no files are found,
+-- Left Missing field error message is returned.
+--
+-- Example:
+--
+-- >>> let mpd = MultipartData [] [FileData "file" "doc1.pdf" "application/pdf" "/tmp/doc1", 
+--                                 FileData "file" "doc2.pdf" "application/pdf" "/tmp/doc2"]
+-- >>> lookupAllFiles "file" mpd
+-- [FileData "file" "doc1.pdf" "application/pdf" "/tmp/doc1", 
+--  FileData "file" "doc2.pdf" "application/pdf" "/tmp/doc2"]
+-- >>> lookupAllFiles "image" mpd
+-- []
+lookupAllFiles :: Text -> MultipartData tag -> Either String [FileData tag]
+lookupAllFiles iname mpd = 
+    let lst = [ f | f <- files mpd, fdInputName f == iname ]
+    in if null lst then Left $ "File " <> cs iname <> " not found"
+       else Right lst
+
+-- | A type class for types that can be parsed from 'Text'.
+class FromText a where
+  fromText :: Text -> Either String a
+
+-- Instance for Text (no parsing needed)
+instance FromText Text where
+  fromText = Right
+
+-- Instance for Int
+instance FromText Int where
+  fromText t = case reads (unpack t) of
+    [(val, "")] -> Right val
+    _ -> Left $ "Could not parse as Int: " <> unpack t
+
+-- Instance for Bool
+instance FromText Bool where
+  fromText t
+    | t == "true" || t == "1" = Right True
+    | t == "false" || t == "0" = Right False
+    | otherwise = Left $ "Could not parse as Bool: " <> unpack t
+
+-- Instance for Double
+instance FromText Double where
+  fromText t = case reads (unpack t) of
+    [(val, "")] -> Right val
+    _ -> Left $ "Could not parse as Double: " <> unpack t
+
+-- Instance for Integer
+instance FromText Integer where
+  fromText t =
+    case reads (unpack t) of
+      [(val, "")] -> Right val
+      _           -> Left $ "Could not parse as Integer: " <> unpack t
+
+-- Instance for Float
+instance FromText Float where
+  fromText t =
+    case reads (unpack t) of
+      [(val, "")] -> Right val
+      _           -> Left $ "Could not parse as Float: " <> unpack t
+
+-- Instance for Maybe a.
+-- This implementation assumes that if the text is "null" or empty,
+-- then we interpret it as Nothing; otherwise we try to parse it.
+instance FromText a => FromText (Maybe a) where
+  fromText t =
+    if t == "null" || t == ""
+      then Right Nothing
+      else fmap Just (fromText t)
+
+-- | Lookup a textual input with the given @name@ attribute and parse it into the desired type.
+--
+-- This function returns the parsed value if the input exists and can be parsed successfully.
+-- If the input is not found or parsing fails, it returns an error message.
+--
+-- Example:
+--
+-- >>> let mpd = MultipartData [Input "age" "30"] []
+-- >>> lookupInputAs @Int "age" mpd
+-- Right 30
+-- >>> lookupInputAs @Bool "isAdmin" mpd
+-- Left "Field isAdmin not found"
+lookupInputAs :: FromText a => Text -> MultipartData tag -> Either String a
+lookupInputAs iname mpd =
+  case lookupInput iname mpd of
+    Left err -> Left err
+    Right val -> fromText val
+
 fromRaw :: forall tag. ([Network.Wai.Parse.Param], [File (MultipartResult tag)])
         -> MultipartData tag
 fromRaw (inputs, files) = MultipartData is fs
@@ -91,6 +205,14 @@ fromRaw (inputs, files) = MultipartData is fs
 
         dec = decodeUtf8
 
+-- | Lookup all textual inputs with the given @name@ attribute and parse them into the desired type.
+lookupAllInputsAs :: FromText a => Text -> MultipartData tag -> Either String [a]
+lookupAllInputsAs iname mpd = do
+  let eVals = lookupAllInputs iname mpd
+  case eVals of
+    Left err -> Left err
+    Right vals -> mapM fromText vals
+
 class MultipartBackend tag where
     type MultipartBackendOptions tag :: *
 

servant-multipart/test/Test.hs

@@ -14,6 +14,7 @@ import Network.HTTP.Types.Header (HeaderName, hContentType)
 
 import Test.Tasty
 import Test.Tasty.Wai
+import Test.Tasty.HUnit
 
 import Servant
 import Servant.Multipart
@@ -32,6 +33,57 @@ main = defaultMain $ testGroup "servant-multipart"
   , testGroup "strict handler with raw MultipartData"
       [ testWai testApp "correct body" testBlogPostRawHandler
       ]
+  , lookupTests
+  ]
+
+sampleFileData :: FileData Tmp
+sampleFileData = FileData "file" "doc1.pdf" "application/pdf" "payload1"
+
+lookupTests :: TestTree
+lookupTests = testGroup "Lookup function tests"
+  [ testCase "lookupAllInputs - found" $ do
+       let md = MultipartData [ Input "color" "red"
+                              , Input "color" "blue"
+                              ] []
+       lookupAllInputs "color" md @?= Right ["red", "blue"]
+
+  , testCase "lookupAllInputs - missing field" $ do
+       let md = MultipartData [ Input "color" "red"
+                              , Input "color" "blue"
+                              ] []
+       case lookupAllInputs "size" md of
+         Left err -> err @?= "Field size not found"
+         Right _  -> assertFailure "Expected a Left error for missing field"
+
+  , testCase "lookupAllFiles - found" $ do
+       let file1 = sampleFileData
+           file2 = FileData "file" "doc2.pdf" "application/pdf" "/tmp/doc2.buf" :: FileData Tmp
+           md = MultipartData [] [file1, file2]
+       lookupAllFiles "file" md @?= Right [file1, file2]
+
+  , testCase "lookupAllFiles - missing file" $ do
+       let file1 = sampleFileData
+           md = MultipartData [] [file1]
+       case lookupAllFiles "image" md of
+         Left err -> err @?= "File image not found"
+         Right _  -> assertFailure "Expected a Left error for missing file"
+
+  , testCase "lookupInputAs - parsed successfully" $ do
+       let md = MultipartData [ Input "age" "30" ] []
+       lookupInputAs @Int "age" md @?= Right 30
+
+  , testCase "lookupInputAs - missing input" $ do
+       let md = MultipartData [ Input "age" "30" ] []
+       case lookupInputAs @Bool "isAdmin" md of
+         Left err -> err @?= "Field isAdmin not found"
+         Right _  -> assertFailure "Expected failure on missing input"
+
+  , testCase "lookupAllInputsAs - parsing list of numbers" $ do
+       let md = MultipartData [ Input "nums" "1"
+                              , Input "nums" "2"
+                              , Input "nums" "3"
+                              ] []
+       lookupAllInputsAs @Int "nums" md @?= Right [1,2,3]
   ]
 
 data BlogPost