在数据库中保留上传的文件(无法使用'HandlerT App IO ByteString'匹配类型'ConduitM()ByteString(ResourceT IO)()')

时间:2016-01-23 21:53:20

标签: haskell yesod

使用yesod我试图在数据库中保留上传的文件。 要做到这一点,我想提取bytestring并保持它,但我仍然需要代码来进行类型检查。

实际问题是

Couldn't match type ‘ConduitM () ByteString (ResourceT IO) ()’
               with ‘HandlerT App IO ByteString’
Expected type: HandlerT App IO ByteString
  Actual type: Source (ResourceT IO) ByteString
In a stmt of a 'do' block: file <- (fileSourceRaw fileinfo)
In the expression:
  do { setMessageI $ MsgUploadedImg;
       uuidWrapped <- liftIO (U4.nextRandom);
       let uuid = fromString $ U.toString $ uuidWrapped;
       transactionId <- runDB $ insert $ Transaction userId;
       .... }

相关部分是这个函数(参见:file&lt; - (fileSourceRaw fileinfo))。

getImgR :: Handler Html
getImgR = do
    oldImages <- runDB $ selectList [] []
    mauthId <- maybeAuthId
    ((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
    case (mauthId,res) of
      (Just userId, FormSuccess (title,fileinfo)) -> do
        transactionId <- runDB $ insert $ Transaction userId
        file <- (fileSourceRaw fileinfo)
        let newImg = Img {imgFile = Just file, imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
        _ <- runDB $ insert newImg
        redirect $ ImgR
      _ -> defaultLayout
        [whamlet|
            $if null oldImages
                <p>There are no images
            $else
                <ul>
                    $forall Entity imgId img  <- oldImages
                        <li>
                            <p>#{imgTitle img}
            $if mauthId == Nothing
               <form method=post action=@{ImgR} enctype=#{enctype}>
                   <input type=submit value=_{MsgPleaseLogin}>
            $else
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    ^{widget}
                    <input type=submit>
       |]

帮助程序代码:

type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap  $ (,)
    <$> areq textField "Title" Nothing
    <*> fileAFormReq "Image file"

Img
   title         Text
   filetype      Text          Maybe
   desc          Textarea      Maybe
   file          ByteString    Maybe
   transactionId TransactionId Maybe
   userId        UserId        Maybe
   deriving Show

仍在浏览文档,但我认为用例很常见,可以提问。 FileInfo的数据类型是:

   data FileInfo = FileInfo
       { fileName        :: !Text
       , fileContentType :: !Text
       , fileSourceRaw   :: !(Source (ResourceT IO) ByteString)
       , fileMove        :: !(FilePath -> IO ())
       }

感谢您的关注。

编辑:我认为解决方案包含在此处的文档中 http://www.yesodweb.com/blog/2013/03/simpler-streaming-responses

更新: 它看起来像是其中一个链接

How can I post FileInfo to a web service using Yesod and Http-Conduit?

https://www.schoolofhaskell.com/school/to-infinity-and-beyond/competition-winners/part-5

Yesod handlers, content of POSTed files

包含解决方案。

UPDATE2: 使用(Data.Conduit.Binary是DCB)

file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs

离开我

Handler/Img.hs:62:42:
    Couldn't match expected type ‘ByteString’
                with actual type ‘Data.ByteString.Lazy.Internal.ByteString’
NB: ‘ByteString’ is defined in ‘Data.ByteString.Internal’
    ‘Data.ByteString.Lazy.Internal.ByteString’
      is defined in ‘Data.ByteString.Lazy.Internal’
In the first argument of ‘Just’, namely ‘file’
In the ‘imgFile’ field of a record

1 个答案:

答案 0 :(得分:0)

看起来缺少的功能在这里: Many types of String (ByteString)

最终代码是

module Handler.Img where

import Import
import LambdaCms.Core -- for UserId
import Database.Persist.Sql (toSqlKey)
-- for uuids
import qualified Data.UUID as U
import qualified Data.UUID.V4 as U4
import Yesod.Core.Types

import qualified Data.Conduit.List as CL
import qualified Data.Conduit.Binary as DCB

import Data.ByteString as BS
import Data.ByteString.Lazy as LBS

type MyForm = Html -> MForm Handler (FormResult (Text, FileInfo), Widget)
form :: Maybe UserId -> Maybe TransactionId -> Text -> MyForm
form userId transactionId uuid = renderBootstrap  $ (,) 
    <$> areq textField "Title" Nothing
    <*> fileAFormReq "Image file"


lazyToStrictBS :: LBS.ByteString -> BS.ByteString
lazyToStrictBS x = BS.concat $ LBS.toChunks x

getImgR :: Handler Html
getImgR = do
    oldImages <- runDB $ selectList [] []
    mauthId <- maybeAuthId
    ((res, widget), enctype) <- runFormPost $ form Nothing Nothing ""
    case (mauthId,res) of
      (Just userId, FormSuccess (title,fileinfo)) -> do
        setMessageI $ MsgUploadedImg
        transactionId <- runDB $ insert $ Transaction userId
        file <- runResourceT $ fileSource fileinfo $$ DCB.sinkLbs
        let newImg = Img {imgFile = Just (lazyToStrictBS file), imgTitle = title , imgDesc = Nothing, imgFiletype = Nothing, imgTransactionId = Just transactionId, imgUserId = Just userId}
        _ <- runDB $ insert newImg
        redirect $ ImgR
      _ -> defaultLayout
        [whamlet|
            $if Import.null oldImages
                <p>There are no images
            $else
                <ul>
                    $forall Entity imgId img  <- oldImages
                       <li>
                            <p>#{imgTitle img}
            $if mauthId == Nothing
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    <input type=submit value=_{MsgPleaseLogin}>
            $else
                <form method=post action=@{ImgR} enctype=#{enctype}>
                    ^{widget}
                    <input type=submit>
        |]

   postImgR :: Handler Html
   postImgR = getImgR