Yesod静态文件类型安全路由变量不在范围内

时间:2017-06-23 20:07:07

标签: haskell yesod

在下面的代码中,我在静态文件夹中有一个图像:bsd.jpg。 在ajax成功方法中,我想将img src指向静态图像并显示它。我无法弄清楚为什么我运行此代码并收到错误:

upload.hs:91:22: error: Variable not in scope: bsd_jpg :: Route Static 

#!/usr/bin/env stack
{- stack
     --resolver lts-8.19
     --install-ghc
     runghc
     --package yesod
     --package yesod-static
     --package persistent-sqlite
 -}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ViewPatterns #-}

import Yesod
import Yesod.Static
import Data.Time (UTCTime)
import System.FilePath
import System.Directory (removeFile, doesFileExist, createDirectoryIfMissing)
import Control.Applicative ((<$>), (<*>))
import Control.Monad.Logger (runStdoutLoggingT)
import Data.Conduit
import qualified Data.Text as T
import Data.Text (unpack)
import qualified Data.ByteString.Lazy as DBL
import Data.Conduit.List (consume)
import Database.Persist
import Database.Persist.Sqlite
import Data.Time (getCurrentTime)
import qualified Data.Conduit.Text as CT
import qualified Data.Conduit.List as CL

share [mkPersist sqlSettings,mkMigrate "migrateAll"] [persistUpperCase|
Image
    filename String
    description Textarea Maybe
    date UTCTime
    deriving Show
|]

data App = App
    { getStatic :: Static -- ^ Settings for static file serving.
    , connPool  :: ConnectionPool
    }

mkYesod "App" [parseRoutes|
/ ImagesR GET POST
/image/#ImageId ImageR DELETE
/static StaticR Static getStatic
/echo-body EchoBodyR PUT
|]

instance Yesod App where
    maximumContentLength _ (Just ImagesR) = Just $ 200 * 1024 * 1024 -- 200 megabytes
    maximumContentLength _ _ = Just $ 10 * 1024 * 1024 -- 10 megabytes

instance YesodPersist App where
    type YesodPersistBackend App = SqlBackend
    runDB action = do
        App _ pool <- getYesod
        runSqlPool action pool

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

uploadDirectory :: FilePath
uploadDirectory = "static"

uploadForm :: Html -> MForm Handler (FormResult (FileInfo, Maybe Textarea, UTCTime), Widget)
uploadForm = renderBootstrap $ (,,)
    <$> fileAFormReq "Image file"
    <*> aopt textareaField "Image description" Nothing
    <*> lift (liftIO getCurrentTime)

addStyle :: Widget
addStyle = do
    -- Twitter Bootstrap
    addStylesheetRemote "http://netdna.bootstrapcdn.com/twitter-bootstrap/2.1.0/css/bootstrap-combined.min.css"
    addStylesheetRemote "https://www.w3schools.com/w3css/4/w3.css"
    -- message style
    toWidget [lucius|.message { padding: 10px 0; background: #ffffed; } |]
    -- jQuery
    addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.8.0/jquery.min.js"
    -- delete function
    toWidget [julius|
$(function(){
    function confirmDelete(link) {
        if (confirm("Are you sure you want to delete this image?")) {
            deleteImage(link);
        };
    }
    function deleteImage(link) {
        $.ajax({
            type: "DELETE",
            url: link.attr("data-img-url"),
        }).done(function(msg) {
            var table = link.closest("table");
            link.closest("tr").remove();
            var rowCount = $("td", table).length;
             if (rowCount === 0) {
                table.remove();
            }
        });
    }

    $("#screenshot").click(function(){
   $.ajax({
            // sending a JSON encoded body
            contentType: "application/json",
            // don't process the body, we'll render data into a valid string
            processData: false,
            url: "@{EchoBodyR}",
            type: "PUT",
            // notice the usage of stringify here
            data: JSON.stringify([{name:"Alice",age:25}, {name:"Bob",age:30}]),
            success: function(data) {
                alert(data.body);
                $("#screenshot-pic").attr("src","@{StaticR bsd_jpg}");

            },
            // this only refers to the data type of the *returned* data
            dataType: "json"
        });

     return false;
    });

    $("a.delete").click(function() {
        confirmDelete($(this));
        return false;
    });
});
|]
putEchoBodyR :: Handler Value
putEchoBodyR = do
    texts <- rawRequestBody $$ CT.decode CT.utf8 =$ CL.consume
    return $ object ["body" .= T.concat texts]


getImagesR :: Handler Html
getImagesR = do
    ((_, widget), enctype) <- runFormPost uploadForm
    images <- runDB $ selectList [ImageFilename !=. ""] [Desc ImageDate]
    mmsg <- getMessage
    defaultLayout $ do
        addStyle
        [whamlet|$newline never
$maybe msg <- mmsg
    <div .message>
        <div .container>
            #{msg}
<div .container>
    <div .row>
        <h2>
            Upload new image

        <button #screenshot class="w3-button w3-teal">Screenshot

        <img #screenshot-pic class="w3-round">

        <div .form-actions>
            <form method=post enctype=#{enctype}>
                ^{widget}
                <input .btn type=submit value="Upload">
        $if not $ null images
            <table .table>
                <tr>
                    <th>
                        Image
                    <th>
                        Decription
                    <th>
                        Uploaded
                    <th>
                        Action
                $forall Entity imageId image <- images
                    <tr>
                        <td>
                            <a href=#{imageFilePath $ imageFilename image}>
                                #{imageFilename image}
                        <td>
                            $maybe description <- imageDescription image
                                #{description}
                        <td>
                            #{show $ imageDate image}
                        <td>
                            <a href=# .delete data-img-url=@{ImageR imageId}>
                                delete

|]

postImagesR :: Handler Html
postImagesR = do
    ((result, widget), enctype) <- runFormPost uploadForm
    case result of
        FormSuccess (file, info, date) -> do
            -- TODO: check if image already exists
            -- save to image directory
            filename <- writeToServer file
            _ <- runDB $ insert (Image filename info date)
            setMessage "Image saved"
            redirect ImagesR
        _ -> do
            setMessage "Something went wrong"
            redirect ImagesR

deleteImageR :: ImageId -> Handler ()
deleteImageR imageId = do
    image <- runDB $ get404 imageId
    let filename = imageFilename image
        path = imageFilePath filename
    liftIO $ removeFile path
    -- only delete from database if file has been removed from server
    stillExists <- liftIO $ doesFileExist path

    case (not stillExists) of 
        False  -> redirect ImagesR
        True -> do
            runDB $ delete imageId
            setMessage "Image has been deleted."
            redirect ImagesR

writeToServer :: FileInfo -> Handler FilePath
writeToServer file = do
    let filename = unpack $ fileName file
        path = imageFilePath filename
    liftIO $ fileMove file path
    return filename

imageFilePath :: String -> FilePath
imageFilePath f = uploadDirectory </> f

openConnectionCount :: Int
openConnectionCount = 10

main :: IO ()
main = do
    pool <- runStdoutLoggingT $ createSqlitePool "images.db3" openConnectionCount
    runSqlPool (runMigration migrateAll) pool
    -- Get the static subsite, as well as the settings it is based on
    createDirectoryIfMissing True uploadDirectory
    static@(Static settings) <- static uploadDirectory
    warp 3000 $ App static pool

1 个答案:

答案 0 :(得分:3)

我看不到你在哪里

import Yesod.Static (staticFiles)

-- This generates easy references to files in the static directory at compile time,
-- giving you compile-time verification that referenced files exist.
-- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
--
-- For example, to refer to @static/js/script.js@ via an identifier, you'd use:
--
--     js_script_js
--
-- If the identifier is not available, you may use:
--
--     StaticFile ["js", "script.js"] []

staticFiles (appStaticDir compileTimeAppSettings)

此代码取自默认的基于sqlite的Yesod脚手架。如果你刚刚开始玩Yesod,我建议你从它开始(stack templates + stack new <selected-template>)。

请注意staticFiles是一个模板Haskell函数,使用它们时有一些限制。具体来说,您不能使用生成的相同.hs文件生成的代码。