Làm thế nào để tạo một ngăn xếp cơ sở dữ liệu trong Happstack?

Question

Tôi muốn tạo ứng dụng Happstack với nhiều quyền truy cập vào cơ sở dữ liệu. Tôi nghĩ rằng một Monad Stack với IO ở phía dưới và một cơ sở dữ liệu Write-như đơn nguyên trên đầu trang (với văn bản ghi ở giữa) sẽ làm việc để có một chức năng rõ ràng trong từng truy cập, ví dụ:

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 

Với:

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

Nhưng tôi có chút kiến ​​thức về Monad và Monad Transformers (tôi thấy câu hỏi này như một bài tập để tìm hiểu về nó), và tôi không có ý tưởng làm thế nào để bắt đầu quá trình tạo ra các cơ sở dữ liệu đơn nguyên, làm thế nào để nâng IO từ happstack đến Database Stack, ... vv.

Answer 1

Bạn có thể muốn sử dụng 'ReaderT':

type MyMonad a = ReaderT DbHandle ServerPart a 

Các Reader đơn nguyên biến làm cho một giá trị duy nhất truy cập bằng cách sử dụng ask chức năng - trong trường hợp này, giá trị chúng tôi muốn tất cả mọi người để có được ít là kết nối cơ sở dữ liệu .

Ở đây, DbHandle là một số kết nối với cơ sở dữ liệu của bạn.

Bởi vì 'ReaderT' đã là một thể hiện của tất cả các lớp kiểu máy chủ hạnh phúc, tất cả các chức năng của máy chủ thường gặp sẽ hoạt động trong đơn nguyên này.

Có thể bạn cũng muốn một số loại helper để mở và đóng kết nối cơ sở dữ liệu:

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 

(Nó có thể là tốt hơn để sử dụng một chức năng như 'khung' ở đây, nhưng tôi không biết rằng có là một hoạt động cho bản mẫu ServerPart)

Tôi không biết bạn muốn đăng nhập như thế nào - bạn định tương tác như thế nào với tệp nhật ký của mình? Một cái gì đó như:

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

và sau đó:

askDb :: MyMonad DbHandle 
askDb = fst <$> ask 

askLogger :: MyMonad LogHandle 
askLogger = snd <$> ask 

có thể là đủ. Sau đó bạn có thể xây dựng trên những nguyên thủy đó để tạo ra các hàm cấp cao hơn. Bạn cũng cần phải thay đổi runMyMonad để được chuyển vào một số LogHandle, bất kể đó là gì.

Khi bạn nhận được nhiều hơn hai thứ bạn muốn truy cập, nó sẽ trả tiền để có loại bản ghi phù hợp thay vì một bộ tuple.

Answer 2

Dưới đây là một số mã làm việc tối thiểu được biên dịch từ các đoạn mã trên cho những người mới bị nhầm lẫn như tôi.

Bạn đặt đồ vật vào AppConfig nhập và lấy nó bằng ask bên trong nhà sản xuất phản hồi của bạn.

{-# 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"]}