haskell - Scotty:连接池作为monad读取器

包括读者在内，有成千上万的monad教程，当您阅读它时，一切似乎都很清楚。但是，当您实际需要编写时，情况就不同了。

我从未使用过Reader，只是在实践中从未接触过它。因此，尽管我已阅读有关内容，但我仍不知道该如何处理。

我需要在Scotty中实现一个简单的数据库连接池，以便每个操作都可以使用该池。该池必须是“全局”的，并且可由所有操作功能访问。我读到，做到这一点的方法是Reader monad。如果还有其他方法，请通知我。

您能否帮助我，并说明如何正确使用Reader？
如果我通过自己的示例看到它是如何完成的，则可能会学得更快。

{-# LANGUAGE OverloadedStrings #-}

module DB where

import Data.Pool
import Database.MongoDB

-- Get data from config
ip = "127.0.0.1"
db = "index"

--Create the connection pool
pool :: IO (Pool Pipe)
pool = createPool (runIOE $ connect $ host ip) close 1 300 5

-- Run a database action with connection pool
run :: Action IO a -> IO (Either Failure a)
run act = flip withResource (\x -> access x master db act) =<< pool

所以上面很简单。我想在每个Scotty操作中使用“运行”功能来访问数据库连接池。现在，问题是如何将其包装在Reader monad中以使所有功能都可以访问它？我了解到，所有Scotty动作函数的'pool'变量必须'像全局变量'。

谢谢。

更新

我正在用完整的代码片段更新问题。我在功能链中传递“pool”变量的位置。如果有人可以显示如何更改它以利用monad Reader。
我不知道该怎么做。

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Network.HTTP.Types
import Web.Scotty
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Text.Lazy.Internal
import Data.Monoid (mconcat)
import Data.Aeson (object, (.=), encode)
import Network.Wai.Middleware.Static
import Data.Pool
import Database.MongoDB
import Control.Monad.Trans (liftIO,lift)

main = do
  -- Create connection pool to be accessible by all action functions
  pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
  scotty 3000 (basal pool)

basal :: Pool Pipe -> ScottyM ()
basal pool = do
  middleware $ staticPolicy (noDots >-> addBase "static")
  get "/json" (showJson pool)

showJson :: Pool Pipe -> ActionM ()
showJson pool = do
  let run act = withResource pool (\pipe -> access pipe master "index" act)
  d <- lift $ run $ fetch (select [] "tables")
  let r = either (const []) id d
  text $ LT.pack $ show r

谢谢。

更新2

我尝试按照下面建议的方式进行操作，但是它不起作用。
如果有人有任何想法，请。编译错误的列表太长了，我什至不知道从哪里开始。

main = do
  pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
  scotty 3000 $ runReaderT basal pool

basal :: ScottyT LT.Text (ReaderT (Pool Pipe) IO) ()
basal = do
  middleware $ staticPolicy (noDots >-> addBase "static")
  get "/json" $ showJson

showJson :: ActionT LT.Text (ReaderT (Pool Pipe) IO) ()
showJson = do
  p <- lift ask
  let rdb a = withResource p (\pipe -> access pipe master "index" a)
  j <- liftIO $ rdb $ fetch (select [] "tables")
  text $ LT.pack $ show j

更新3

感谢cdk提出的想法，也感谢Ivan Meredith提出了scottyT的建议。这个问题也有帮助:How do I add the Reader monad to Scotty's monad
这是编译的版本。我希望它可以帮助某人并节省一些时间。

import qualified Data.Text.Lazy as T
import qualified Data.Text.Lazy.Encoding as T
import           Data.Text.Lazy (Text)
import           Control.Monad.Reader
import           Web.Scotty.Trans
import           Data.Pool
import           Database.MongoDB

type ScottyD = ScottyT Text (ReaderT (Pool Pipe) IO)
type ActionD = ActionT Text (ReaderT (Pool Pipe) IO)

-- Get data from config
ip = "127.0.0.1"
db = "basal"

main = do
  pool <- createPool (runIOE $ connect $ host ip) close 1 300 5
  let read = \r -> runReaderT r pool
  scottyT 3000 read read basal

-- Application, meaddleware and routes
basal ::  ScottyD ()
basal = do
  get "/" shoot

-- Route action handlers
shoot ::  ActionD ()
shoot = do
  r <- rundb $ fetch $ select [] "computers"
  html $ T.pack $ show r

-- Database access shortcut
rundb :: Action IO a -> ActionD (Either Failure a)
rundb a = do
  pool <- lift ask
  liftIO $ withResource pool (\pipe -> access pipe master db a)

最佳答案

我一直在尝试自己找出确切的问题。多亏有关此SO问题的提示以及其他研究，我得出了以下对我有用的建议。您缺少的关键是使用scottyT
毫无疑问，有一种编写runDB的更漂亮的方法，但是我在Haskell方面没有很多经验，所以如果可以做得更好，请发布它。

type MCScottyM = ScottyT TL.Text (ReaderT (Pool Pipe) IO)
type MCActionM = ActionT TL.Text (ReaderT (Pool Pipe) IO)

main :: IO ()
main = do
  pool <- createPool (runIOE $ connect $ host "127.0.0.1") close 1 300 5
  scottyT 3000 (f pool) (f pool) $ app
    where
      f = \p -> \r -> runReaderT r p

app :: MCScottyM ()
app = do
  middleware $ staticPolicy (noDots >-> addBase "public")
  get "/" $ do
    p <- runDB dataSources
    html $ TL.pack $ show p

runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = (lift ask) >>= (\p ->  liftIO $ withResource p (\pipe -> access pipe master "botland" a))

dataSources :: Action IO [Document]
dataSources = rest =<< find (select [] "datasources")

更新资料

我想这更漂亮。

runDB :: Action IO a -> MCActionM (Either Failure a)
runDB a = do
  p <- lift ask
  liftIO $ withResource p db
    where
       db pipe = access pipe master "botland" a

关于haskell - Scotty:连接池作为monad读取器，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/22703289/