如何在 Happstack 中创建数据库 Monad Stack?

发布于 2024-12-10 16:17:24 字数 715 浏览 3 评论 0原文

我想创建一个可以对数据库进行大量访问的 Happstack 应用程序。我认为底部有 IO 的 Monad 堆栈和顶部类似数据库写入的 monad(中间有日志写入器)将在每次访问中具有清晰的功能,例如:

itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
  methodM [GET,HEAD]
  liftIO $ noticeM (scLogger cf) "sended job list"

  items <- runDBMonad (scDBConnString cf) $ getItemLists

  case items of
    (Right xs) -> ok $ toResponse $ show xs
    (Left err) -> internalServerError $ toResponse $ show err

With:

getItemList :: MyDBMonad (Error [Item])
getItemList = do
  -- etc...

但我对 Monad 知之甚少和 Monad Transformers (我认为这个问题是一个了解它的练习),我不知道如何开始创建 Database Monad,如何将 IO 从 happstack 提升到数据库堆栈,等等。

I want to create a Happstack application with lots of access to a database. I think that a Monad Stack with IO at the bottom and a Database Write-like monad on top (with log writer in the middle) will work to have a clear functions in each access, example:

itemsRequest :: ServerConfig -> ServerPart Response
itemsRequest cf = dir "items" $ do
  methodM [GET,HEAD]
  liftIO $ noticeM (scLogger cf) "sended job list"

  items <- runDBMonad (scDBConnString cf) $ getItemLists

  case items of
    (Right xs) -> ok $ toResponse $ show xs
    (Left err) -> internalServerError $ toResponse $ show err

With:

getItemList :: MyDBMonad (Error [Item])
getItemList = do
  -- etc...

But I have little knowledge of Monad and Monad Transformers (I see this question as an exercise to learn about it), and I have no idea how to begin the creation of Database Monad, how to lift the IO from happstack to the Database Stack,...etc.

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(2

把梦留给海 2024-12-17 16:17:24

这是一些从上面的代码片段编译而来的最小工作代码,适合像我这样困惑的新手。

您将内容放入 AppConfig 类型中,并在响应生成器中使用 ask 获取它。

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C

myApp :: AppMonad Response
myApp = do
    -- access app config. look mom, no lift!
    test <- ask

    -- try some happstack funs. no lift either.
    rq <- askRq
    bs <- lookBS "lol"

    -- test IO please ignore
    liftIO . print $ test
    liftIO . print $ rq
    liftIO . print $ bs

    -- bye
    ok $ toResponse ("Oh, hi!" :: C.ByteString)

-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
                           , appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []

type AppMonad = ReaderT AppConfig (ServerPartT IO)

main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}

Here is some minimal working code compiled from snippets above for confused newbies like me.

You put stuff into AppConfig type and grab it with ask inside your response makers.

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Happstack.Server
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as C

myApp :: AppMonad Response
myApp = do
    -- access app config. look mom, no lift!
    test <- ask

    -- try some happstack funs. no lift either.
    rq <- askRq
    bs <- lookBS "lol"

    -- test IO please ignore
    liftIO . print $ test
    liftIO . print $ rq
    liftIO . print $ bs

    -- bye
    ok $ toResponse ("Oh, hi!" :: C.ByteString)

-- Put your stuff here.
data AppConfig = AppConfig { appSpam :: C.ByteString
                           , appEggs :: [C.ByteString] } deriving (Eq, Show)
config = AppConfig "THIS. IS. SPAAAAAM!!1" []

type AppMonad = ReaderT AppConfig (ServerPartT IO)

main = simpleHTTP (nullConf {port=8001}) $ runReaderT myApp config {appEggs=["red", "gold", "green"]}
悲念泪 2024-12-17 16:17:24

您可能想使用“ReaderT”:

type MyMonad a = ReaderT DbHandle ServerPart a

Reader monad 转换器可以使用 ask 函数访问单个值 - 在这种情况下,我们希望每个人都能获得的值是数据库连接。

这里,DbHandle 是与数据库的某种连接。

因为“ReaderT”已经是所有 happstack-server 类型类的实例,所以所有正常的 happstack-server 函数都将在此 monad 中工作。

您可能还需要某种帮助程序来打开和关闭数据库连接:(

runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
   db <- liftIO $ connect_to_your_db connectionString
   result <- runReaderT m db
   liftIO $ close_your_db_connection db

在这里使用像“bracket”这样的函数可能会更好,但我不知道 ServerPart monad 有这样的操作)

我不知道不知道您想如何进行日志记录 - 您打算如何与日志文件交互?类似:

type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a

然后:

askDb :: MyMonad DbHandle
askDb = fst <
gt; ask

askLogger :: MyMonad LogHandle
askLogger = snd <
gt; ask

可能就足够了。然后,您可以在这些原语的基础上构建更高级别的函数。您还需要更改 runMyMonad 以在 LogHandle 中传递,无论它是什么。

一旦您获得了两个以上想要访问的内容,就需要使用正确的记录类型而不是元组。

You likely want to use 'ReaderT':

type MyMonad a = ReaderT DbHandle ServerPart a

The Reader monad transformer makes a single value accessible using the ask function - in this case, the value we want everyone to get at is the database connection.

Here, DbHandle is some connection to your database.

Because 'ReaderT' is already an instance of all of the happstack-server type-classes all normal happstack-server functions will work in this monad.

You probably also want some sort of helper to open and close the database connection:

runMyMonad :: String -> MyMonad a -> ServerPart a
runMyMonad connectionString m = do
   db <- liftIO $ connect_to_your_db connectionString
   result <- runReaderT m db
   liftIO $ close_your_db_connection db

(It might be better to use a function like 'bracket' here, but I don't know that there is such an operation for the ServerPart monad)

I don't know how you want to do logging - how do you plan to interact with your log-file? Something like:

type MyMonad a = ReaderT (DbHandle, LogHandle) ServerPart a

and then:

askDb :: MyMonad DbHandle
askDb = fst <
gt; ask

askLogger :: MyMonad LogHandle
askLogger = snd <
gt; ask

might be enough. You could then build on those primitives to make higher-level functions. You would also need to change runMyMonad to be passed in a LogHandle, whatever that is.

Once you get more than two things you want access to it pays to have a proper record type instead of a tuple.

~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文