捕捉,IO和酸态

时间:2012-10-02 02:38:13

标签: haskell haskell-snap-framework acid-state

尝试在Snap中使用酸状态,我遇到了障碍。

这是我到目前为止所得到的。

首先是我与酸状态相关的对象(它是一个带有isbn数字的虚拟书籍):

{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE OverloadedStrings          #-}

module Models where

import Prelude hiding ((.), id)
import Control.Category ((.))
import Control.Monad.Reader (asks)
import Data.ByteString (ByteString)
import Data.SafeCopy (base, deriveSafeCopy)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import Data.Acid (Update, Query, makeAcidic)
import Control.Monad.Reader (ask)
import Control.Applicative ((<$>))
import Data.Data (Data)

data Book = Book { isbn :: String }
     deriving (Eq, Ord, Read, Data, Show, Typeable)

$(deriveSafeCopy 0 'base ''Book)

-- Retrieve the book's isbn
queryIsbn :: Query Book String
queryIsbn = isbn <$> ask

$(makeAcidic ''Book ['queryIsbn])

然后我实际尝试将其与Snap集成。正如您所看到的,我在定义__ doQuery__函数时遇到问题,该函数应返回字符串isbn:

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Application where

import           Control.Monad.Trans.Class (lift)
import           Data.Text.Encoding (decodeUtf8)
import           Text.XmlHtml (Node(TextNode),Node (Element), 
                 getAttribute, setAttribute, nodeText)
import           Data.ByteString (ByteString)
import           Data.Maybe
import           Snap.Core
import           Snap.Snaplet
import           Snap.Snaplet.Heist (Heist, HasHeist(heistLens), heistInit,
                        addSplices, liftHeist, render)
import           Snap.Util.FileServe
import           Text.Templating.Heist (HeistT, Template, getParamNode)
import           Data.Lens.Template

import Models
import Data.Acid.Advanced (query')
import Data.Acid (AcidState, openLocalState, closeAcidState, IsAcidic, query)
import Data.Text (pack)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Snap (snapletValue)
import Data.Lens.Common (getL, (^$), (^.), Lens) 
import Control.Monad.Reader (ask, asks)
import Control.Applicative ((<$>))
import Data.Typeable (typeOf)


import Prelude hiding ((.), id)
import Control.Category ((.), id)

------------------------------------------------------------------------------
type AppHandler = Handler App App

--------------
-- Acid
---------------
-- Used for holding data for the snapplet
data Acid st = Acid { _state ::  AcidState st }

-- Initializer function for the snapplet
seedBook =  Book "9213-23123-2311"

acidInit ::  SnapletInit b (Acid Book)
acidInit = makeSnaplet "storage" "Snaplet providing storage functionality" Nothing initializer

--The 'm' is the type variable of the MonadSnaplet type class. 'b' is the base state, and 'v' is the state of the current "view" snaplet (or simply, current state).
initializer :: Initializer b v (Acid Book)
initializer = do
      st <- liftIO (openLocalState seedBook)

      --onUnload (closeAcidState st)
      return $ Acid st

-----------------------
-- Snap Global State
--------------------

data App = App
    { _heist :: Snaplet (Heist App),
      _acid  :: Snaplet (Acid Book)
    }

makeLens ''App
----------------------------------------------------------------------------------

instance HasHeist App where
    heistLens = subSnaplet heist

-----------------------------------------------
-- | Initialize app
-----------------------------------------------
appInit :: SnapletInit App App
appInit = makeSnaplet "app" "Website" Nothing $ do
    h <- nestSnaplet "" heist $ heistInit "templates"
    a <- nestSnaplet "isbn"  acid (acidInit)
    addRoutes routes --see below
    addSplices [ ("menuEntry", liftHeist menuEntrySplice) ]
    return $ App h a


------------------------------------------------
-- | The application's routes.
------------------------------------------------
routes :: [(ByteString, Handler App App ())]
routes = [ ("/books",    handleBooks)
         , ("/contact",  render "contact")
         , ("/isbn",     liftIO doQuery >>= writeBS )
         , ("",          serveDirectory "static")
         ]

-- Is this Function signature possible? Or must it run inside Snap or other monad?
doQuery :: IO ByteString
doQuery = do    -- ???????????
        --somehow retrieve acid store from snaplet
        --run queryIsbn on it
        --return isbn string
        return "BLAH"


handleBooks :: Handler App App ()
handleBooks = render "books"

对我所缺少的任何帮助都将不胜感激。如果问题不明确,请告诉我,我会更新问题。

2 个答案:

答案 0 :(得分:1)

MathematicalOrchid是正确的,对你的问题最简单的答案是在openLocalState调用上使用liftIO。

但是从更广泛的角度来看,snaplet-acid-state包中已经为您完成了这项工作,所以我建议您使用它。存储库还包括example application,演示如何使用它。

答案 1 :(得分:0)

我不知道您正在使用的软件包,但看起来像问题只是openLocalState是一个IO操作,但您的类型签名需要它是一个Initializer动作。

修复它可能就像在那里填充liftIO的呼叫一样简单。我不是很确定......我不知道这些类型中的哪个来自哪个模块。