Skip to content
Snippets Groups Projects
Verified Commit 2017e4e9 authored by jan.hamal.dvorak's avatar jan.hamal.dvorak
Browse files

Use simpler type for uploaded files

parent 68557dc2
Branches
No related tags found
No related merge requests found
...@@ -92,7 +92,6 @@ module Hikaru.Action ...@@ -92,7 +92,6 @@ module Hikaru.Action
, respond , respond
-- ** Re-Exports -- ** Re-Exports
, FileInfo
, FilePath , FilePath
) )
where where
...@@ -227,7 +226,7 @@ where ...@@ -227,7 +226,7 @@ where
-- | -- |
-- Fields and files sent using a web form. -- 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 ...@@ -652,21 +651,21 @@ where
-- Identical to 'getFields', except it returns information about -- Identical to 'getFields', except it returns information about
-- files uploaded through the form. -- files uploaded through the form.
-- --
getFiles :: (MonadAction m) => m [(Text, FileInfo FilePath)] getFiles :: (MonadAction m) => m [(Text, FilePath)]
getFiles = snd <$> getFormData getFiles = snd <$> getFormData
-- | -- |
-- Obtain a specific form file -- 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 getFileMaybe n = lookup n <$> getFiles
-- | -- |
-- Obtain a group of form files with the same name. -- 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 getFileList n = map snd . filter ((n ==) . fst) <$> getFiles
...@@ -706,8 +705,8 @@ where ...@@ -706,8 +705,8 @@ where
form' <- liftIO do form' <- liftIO do
sinkRequestBody (tempFileBackEnd rtis) bt getChunk sinkRequestBody (tempFileBackEnd rtis) bt getChunk
-- Convert ByteString to Text fields. -- Perform string conversions and simplify uploaded file types.
let form = csForm form' let form = adaptForm form'
-- Cache and return. -- Cache and return.
setActionField aeBody (BodyForm form) setActionField aeBody (BodyForm form)
...@@ -720,10 +719,13 @@ where ...@@ -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 adaptForm :: ([Param], [(ByteString, FileInfo FilePath)]) -> FormData
csForm (ps, fs) = (map cs2 ps, map cs1 fs) adaptForm (ps, fs) = (map cs2 ps, map convFile fs)
where
convFile (n, FileInfo{fileContent}) = (cs n, fileContent)
-- | -- |
...@@ -1048,18 +1050,9 @@ where ...@@ -1048,18 +1050,9 @@ where
-- | -- |
-- Helper to apply 'cs' to both elements of a 2-tuple. -- Helper to apply 'cs' to both elements of a 2-tuple.
-- --
cs2 :: ( ConvertibleStrings a c cs2 :: (ConvertibleStrings a c, ConvertibleStrings b d)
, ConvertibleStrings b d
)
=> (a, b) -> (c, d) => (a, b) -> (c, d)
cs2 (x, y) = (cs x, cs y) 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: -- vim:set ft=haskell sw=2 ts=2 et:
...@@ -184,7 +184,7 @@ where ...@@ -184,7 +184,7 @@ where
= Env = Env
{ envPrefix :: [Text] { envPrefix :: [Text]
, envParams :: [(Text, Text)] , envParams :: [(Text, Text)]
, envFiles :: [(Text, FileInfo FilePath)] , envFiles :: [(Text, FilePath)]
, envCheck :: Bool , envCheck :: Bool
} }
...@@ -572,7 +572,7 @@ where ...@@ -572,7 +572,7 @@ where
return $ fromParam =<< lookup name envParams 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 formFileMaybe name = do
Env{envFiles} <- ask Env{envFiles} <- ask
return $ lookup name envFiles return $ lookup name envFiles
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment