diff --git a/lib/Hikaru/Action.hs b/lib/Hikaru/Action.hs index 13bb3ed34e74a48b567a84c5b050f09138c2a997..218a65f52dff3670701aa2895e53db21f6b2e6f4 100644 --- a/lib/Hikaru/Action.hs +++ b/lib/Hikaru/Action.hs @@ -92,7 +92,6 @@ module Hikaru.Action , respond -- ** Re-Exports - , FileInfo , FilePath ) where @@ -227,7 +226,7 @@ where -- | -- Fields and files sent using a web form. -- - type FormData = ([(Text, Text)], [(Text, FileInfo FilePath)]) + type FormData = ([(Text, Text)], [(Text, FilePath)]) -- | @@ -652,21 +651,21 @@ where -- Identical to 'getFields', except it returns information about -- files uploaded through the form. -- - getFiles :: (MonadAction m) => m [(Text, FileInfo FilePath)] + getFiles :: (MonadAction m) => m [(Text, FilePath)] getFiles = snd <$> getFormData -- | -- Obtain a specific form file -- - getFileMaybe :: (MonadAction m) => Text -> m (Maybe (FileInfo FilePath)) + getFileMaybe :: (MonadAction m) => Text -> m (Maybe FilePath) getFileMaybe n = lookup n <$> getFiles -- | -- Obtain a group of form files with the same name. -- - getFileList :: (MonadAction m) => Text -> m [FileInfo FilePath] + getFileList :: (MonadAction m) => Text -> m [FilePath] getFileList n = map snd . filter ((n ==) . fst) <$> getFiles @@ -706,8 +705,8 @@ where form' <- liftIO do sinkRequestBody (tempFileBackEnd rtis) bt getChunk - -- Convert ByteString to Text fields. - let form = csForm form' + -- Perform string conversions and simplify uploaded file types. + let form = adaptForm form' -- Cache and return. setActionField aeBody (BodyForm form) @@ -720,10 +719,13 @@ where -- | - -- Convert form names and fields from 'ByteString' to 'Text'. + -- Convert form names and fields from 'ByteString' to 'Text' and + -- extract just the uploaded file names from the 'FileInfo' structures. -- - csForm :: ([Param], [File FilePath]) -> FormData - csForm (ps, fs) = (map cs2 ps, map cs1 fs) + adaptForm :: ([Param], [(ByteString, FileInfo FilePath)]) -> FormData + adaptForm (ps, fs) = (map cs2 ps, map convFile fs) + where + convFile (n, FileInfo{fileContent}) = (cs n, fileContent) -- | @@ -1048,18 +1050,9 @@ where -- | -- Helper to apply 'cs' to both elements of a 2-tuple. -- - cs2 :: ( ConvertibleStrings a c - , ConvertibleStrings b d - ) + cs2 :: (ConvertibleStrings a c, ConvertibleStrings b d) => (a, b) -> (c, d) cs2 (x, y) = (cs x, cs y) - -- | - -- Helper to apply 'cs' to the first element of a 2-tuple. - -- - cs1 :: (ConvertibleStrings a c) => (a, b) -> (c, b) - cs1 (x, y) = (cs x, y) - - -- vim:set ft=haskell sw=2 ts=2 et: diff --git a/lib/Hikaru/Form.hs b/lib/Hikaru/Form.hs index 3a096037a7ce94761584c2950b913c815f237ec3..2be433b7048060484726f95b01bf65f416b7baa6 100644 --- a/lib/Hikaru/Form.hs +++ b/lib/Hikaru/Form.hs @@ -184,7 +184,7 @@ where = Env { envPrefix :: [Text] , envParams :: [(Text, Text)] - , envFiles :: [(Text, FileInfo FilePath)] + , envFiles :: [(Text, FilePath)] , envCheck :: Bool } @@ -572,7 +572,7 @@ where return $ fromParam =<< lookup name envParams - formFileMaybe :: (Monad m) => Text -> FormT l m (Maybe (FileInfo FilePath)) + formFileMaybe :: (Monad m) => Text -> FormT l m (Maybe FilePath) formFileMaybe name = do Env{envFiles} <- ask return $ lookup name envFiles