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

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

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

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

Не могли бы вы мне помочь и показать, как это правильно делать с Ридером? Я, наверное, научусь быстрее, если увижу, как это делается, на моих собственных примерах.

{-# 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

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

Спасибо.

ОБНОВЛЕНИЕ

Я обновляю вопрос полным фрагментом кода. Где я передаю переменную pool по цепочке функций. Если кто-то может показать, как изменить его, чтобы использовать монаду 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 за идею и спасибо Ивану Мередиту за предложение scottyT. Этот вопрос также помог: Как добавить монаду Reader к монаде Скотти Это компилируемая версия. Надеюсь, это кому-то поможет и сэкономит время.

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)