Подтвердить что ты не робот

Скотти: пул соединений как читатель монады

Есть триллионы учебников по монаде, включая читателя, и, кажется, все понятно, когда вы читаете об этом. Но когда вам действительно нужно писать, это становится другим вопросом.

Я никогда не пользовался Reader, просто так и не получил его на практике. Поэтому я не знаю, как это сделать, хотя я читал об этом.

Мне нужно реализовать простой пул соединений с базами данных в Scotty, чтобы каждое действие могло использовать пул. Пул должен быть "глобальным" и доступен для всех функций действия. Я читал, что способ сделать это - монада читателей. Если есть другие способы, пожалуйста, дайте мне знать.

Не могли бы вы помочь мне и показать, как правильно это сделать с 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

Таким образом, вышесказанное просто. и я хочу использовать функцию "run" в каждом действии Scotty для доступа к пулу соединений с базой данных. Теперь вопрос заключается в том, как обернуть его в монаду Reader, чтобы сделать его доступным для всех функций? Я понимаю, что переменная "пул" должна быть "как глобальная" для всех функций действия Скотти.

Спасибо.

UPDATE

Я обновляю вопрос с полным фрагментом кода. Где я передаю переменную "пул" вниз по функциональной цепочке. Если кто-то может показать, как изменить его, чтобы использовать монад-ридер, пожалуйста. Я не понимаю, как это сделать.

{-# 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 за предоставленную идею и благодарность Ивану Мередите за то, что он дал предложение scottyT. Этот вопрос также помог: Как добавить монаду для чтения в монадию Скотти Это версия, которая компилируется. Я надеюсь, что это поможет кому-то и сэкономит время.

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)
4b9b3361

Ответ 1

Я сам пытался выяснить эту проблему. Благодаря намекам на этот вопрос 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")

Update

Я думаю, это немного более красиво.

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

Ответ 2

Как вы указали, способ сделать его доступным - это обернуть ваши вычисления в монаде Reader или, скорее, трансформаторе ReaderT. Таким образом, ваша функция run (слегка изменилась)

run :: Pool Pipe -> Action IO a -> IO (Either Failure a)
run pool act =
    flip withResource (\x -> access x master db act) =<< pool

становится

run :: Action IO a -> ReaderT (Pool Pipe) IO (Either Failure a)
run act = do
    pool <- ask
    withResource pool (\x -> access x master db act)

Вычисления внутри среды ReaderT r m a могут получить доступ к r с помощью ask и ReaderT, казалось бы, вызывающих его из воздуха! На самом деле, монада ReaderT просто вложила Env во все вычисления, и вам не пришлось об этом беспокоиться.

Чтобы выполнить действие ReaderT, вы используете runReaderT :: ReaderT r m a -> r -> m a. Таким образом, вы вызываете runReaderT в свой верхний уровень scotty для предоставления Pool и runReaderT разворачивает среду ReaderT и возвращает вам значение в базовой монаде.

Например, чтобы оценить вашу функцию run

-- remember: run act :: ReaderT (Pool Pipe) IO (Either Failure a)
runReaderT (run act) pool

но вы не хотели бы использовать runReaderT на run, так как это, вероятно, часть более крупного вычисления, которое также должно делиться средой ReaderT. Старайтесь избегать использования runReaderT на вычислениях "листа", вы должны, как правило, использовать его как можно выше в логике программы.

EDIT. Разница между Reader и ReaderT заключается в том, что Reader является монадой, а ReaderT является монадным трансформатором. То есть, ReaderT добавляет поведение Reader в другую монаду (или стек трансформатора монады). Если вы не знакомы с трансформаторами монады, я бы рекомендовал реальный мир haskell - трансформаторы.

У вас есть showJson pool ~ ActionM (), и вы хотите добавить среду Reader с доступом к Pool Pipe. В этом случае вам понадобятся трансформаторы ActionT и ScottyT, а не ReaderT, чтобы работать с функциями из пакета scotty.

Обратите внимание, что ActionM определяется type ActionM = ActionT Text IO, аналогично для ScottyM.

У меня нет всех необходимых библиотек, поэтому это может быть не typecheck, но оно должно дать вам правильную идею.

basal :: ScottyT Text (ReaderT (Pool Pipe) IO) ()
basal = do
    middleware $ staticPolicy (...)
    get "/json" showJson

showJson :: ActionT Text (ReaderT (Pool Pipe) IO) ()
showJson = do
    pool <- lift ask
    let run act = withResource pool (\p -> access p master "index act)
    d <- liftIO $ run $ fetch $ select [] "tables"
    text . TL.pack $ either (const "") show d