Скотти: пул соединений как читатель монад
Есть триллионы учебников по монадам, включая читателя, и кажется, что все ясно, когда вы читаете об этом. Но когда вам действительно нужно писать, это становится другим вопросом.
Я никогда не использовал Reader, просто никогда не использовал его на практике. Так что я не знаю, как это сделать, хотя я читал об этом.
Мне нужно реализовать простой пул соединений с базой данных в Скотти, чтобы каждое действие могло использовать пул. Пул должен быть "глобальным" и доступным для всех функций действий. Я читал, что способ сделать это - монада Reader. Если есть другие способы, пожалуйста, дайте мне знать.
Не могли бы вы помочь мне и показать, как правильно сделать это с помощью 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' в каждом действии Скотти для доступа к пулу соединений с базой данных. Теперь вопрос в том, как обернуть его в монаду 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 за идею и спасибо Ивану Мередиту за предложение СкоттиТ. Этот вопрос также помог: Как мне добавить монаду 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)
2 ответа
Я пытался выяснить эту проблему сам. Благодаря подсказкам по этому вопросу 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
Как вы уже упоминали, способ сделать его доступным - это обернуть ваши вычисления в 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 на "листовых" вычислениях вы обычно должны называть это как можно выше в логике программы.
РЕДАКТИРОВАТЬ: разница между Reader а также ReaderT в том, что Reader это монада в то время как ReaderT это монадный трансформатор. То есть, ReaderT добавляет Reader поведение к другой монаде (или стеку монадного трансформера). Если вы не знакомы с монадными трансформерами, я бы порекомендовал реальный haskell - трансформеры.
У тебя есть showJson pool ~ ActionM () и вы хотите добавить Reader среда с доступом к Pool Pipe, В этом случае вам действительно нужно ActionT а также ScottyT трансформаторы, а не ReaderT для того, чтобы работать с функциями из scotty пакет.
Обратите внимание, что ActionM определено type ActionM = ActionT Text IOаналогично для ScottyM,
У меня не установлены все необходимые библиотеки, так что это может быть не проверка типов, но это должно дать вам правильную идею.
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