make the multipart types better

Author: bitonic

solga-client-ghcjs/src/Solga/Client/GHCJS.hs

@@ -200,9 +200,9 @@ instance (Client next) => Client (WithIO next) where
   type RequestData (WithIO next) = RequestData next
   performRequest _p req perf = performRequest (Proxy @next) req perf
 
-instance (Client next) => Client (ReqBodyMultipart fp a next) where
+instance (Client next) => Client (ReqBodyMultipart a next) where
   type
-    RequestData (ReqBodyMultipart fp a next) =
-      WithData [(JSString, Xhr.FormDataVal)] (RequestData next)
-  performRequest _p req (WithData fd perf) = do
-    performRequest (Proxy @next) req{reqData = Xhr.FormData fd} perf
+    RequestData (ReqBodyMultipart a next) =
+      WithData (a, a -> [(JSString, Xhr.FormDataVal)]) (RequestData next)
+  performRequest _p req (WithData (x, f) perf) = do
+    performRequest (Proxy @next) req{reqData = Xhr.FormData (f x)} perf

solga-client/src/Solga/Client.hs

@@ -131,7 +131,7 @@ instance (Client next, ToSegment a) => Client (Capture a next) where
     performRequest (Proxy @next) (addSegment req (toSegment x)) mgr perf
 
 instance (Client next, KnownSymbol method) => Client (Method method next) where
-  type RequestData (Method seg next) = RequestData next
+  type RequestData (Method method next) = RequestData next
   performRequest _p req mgr perf = performRequest
     (Proxy @next) req{Http.method = BSC8.pack (symbolVal (Proxy @method))} mgr perf
 
@@ -164,11 +164,12 @@ instance (Client next) => Client (WithIO next) where
   type RequestData (WithIO next) = RequestData next
   performRequest _p req mgr perf = performRequest (Proxy @next) req mgr perf
 
-instance (Client next) => Client (ReqBodyMultipart fp a next) where
+instance (Client next) => Client (ReqBodyMultipart a next) where
   type
-    RequestData (ReqBodyMultipart fp a next) =
-      WithData ([Http.Part], Maybe ByteString) (RequestData next)
-  performRequest _p req mgr (WithData (parts, mbBoundary) perf) = do
+    RequestData (ReqBodyMultipart a next) =
+      WithData (a, a -> ([Http.Part], Maybe ByteString)) (RequestData next)
+  performRequest _p req mgr (WithData (x, f) perf) = do
+    let (parts, mbBoundary) = f x
     req' <- case mbBoundary of
       Nothing -> Http.formDataBody parts req
       Just x -> Http.formDataBodyWithBoundary x parts req

solga-client/test/Test.hs

@@ -97,8 +97,6 @@ spec port = do
         Right seg' <- return decodeSeg
         return (seg == seg')
 
-deriving instance Generic Value
-
 instance Arbitrary Value where
   arbitrary = sized arbJSON
    where

solga-core/src/Solga/Core.hs

@@ -113,22 +113,22 @@ newtype ReqBodyJSON a next = ReqBodyJSON { reqBodyJSONNext :: a -> next }
 newtype WithIO next = WithIO { withIONext :: IO next }
 
 type MultiPartParam = (ByteString, ByteString)
-type MultiPartFile y = (ByteString, MultiPartFileInfo y)
+type MultiPartFile = (ByteString, MultiPartFileInfo)
 
-data MultiPartFileInfo c = MultiPartFileInfo
+data MultiPartFileInfo = MultiPartFileInfo
   { mpfiName :: ByteString
   , mpfiContentType :: ByteString
   , mpfiContent :: FilePath
   }
 
 -- | A parsed "multipart/form-data" request.
-type MultiPartData y = ([MultiPartParam], [MultiPartFile y])
+type MultiPartData = ([MultiPartParam], [MultiPartFile])
 
 -- | Accept a "multipart/form-data" request.
 -- Files will be stored in a temporary directory and will be deleted
 -- automatically after the request is processed.
-data ReqBodyMultipart y a next = ReqBodyMultipart
-  { reqMultiPartParse :: MultiPartData y -> Either String a
+data ReqBodyMultipart a next = ReqBodyMultipart
+  { reqMultiPartParse :: MultiPartData -> Either String a
   , reqMultiPartNext :: a -> next
   }
 

solga-router/src/Solga/Router.hs

@@ -172,7 +172,7 @@ instance (Aeson.FromJSON a, Router next) => Router (ReqBodyJSON a next) where
 instance Router next => Router (WithIO next) where
   tryRoute = tryRouteNextIO withIONext
 
-instance (fp ~ FilePath, Router next) => Router (ReqBodyMultipart fp a next) where
+instance (Router next) => Router (ReqBodyMultipart a next) where
   tryRoute req = flip fmap (tryRoute req) $ \nextRouter rmp cont ->
     runResourceT $ withInternalState $ \s -> do
       (params, fileInfos0) <- Wai.parseRequestBody (Wai.tempFileBackEnd s) req
@@ -186,7 +186,7 @@ instance (fp ~ FilePath, Router next) => Router (ReqBodyMultipart fp a next) whe
                   , mpfiContent = fileContent
                   }
               )
-      let multiPart :: MultiPartData FilePath = (params, fileInfos)
+      let multiPart :: MultiPartData = (params, fileInfos)
       case reqMultiPartParse rmp multiPart of
         Left err -> throwIO $ badRequest $ "Could not decode form request: " <> Text.pack err
         Right val -> nextRouter (reqMultiPartNext rmp val) cont
@@ -251,7 +251,7 @@ instance Abbreviated next => Abbreviated (WithIO next) where
   type Brief (WithIO next) = IO (Brief next)
   brief = WithIO . fmap brief
 
-instance Abbreviated (ReqBodyMultipart fp a next)
+instance Abbreviated (ReqBodyMultipart a next)
 
 -- Generic routers
 

solga-swagger/src/Solga/Swagger.hs

@@ -136,7 +136,7 @@ instance RouterSwagger next => RouterSwagger (NoCache next) where
 instance RouterSwagger next => RouterSwagger (ExtraHeaders next) where
   genPaths = passPaths
 
-instance RouterSwagger (ReqBodyMultipart fp a next) where
+instance RouterSwagger (ReqBodyMultipart a next) where
   genPaths = noPaths
 
 instance RouterSwagger (OneOfSegs '[] next) where