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

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

Я никогда не пользовался 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)

Ответы

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

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)

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

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