Question

以下代码尝试组合两个单独工作的示例：

day 19 of 24 (2012)例如ws example但是我把几乎所有与websocket相关的东西拿走了一个小例子。

请找到下面的代码。 msgHandler由helloDb调用，它将获取包含db-connection的snaplet并将其传递给msgHandler。 snaplet-posgresql-simple docs（最后）给出了便利实例以及如何在Initializer monad中使用其中一个实例的示例。

当我拿走两条注释行时，ghc说有两个涉及范围外类型的实例，并且这些实例重叠：HasPostgres (ReaderT r m)和HasPostgres (ReaderT (Snaplet Postgres) m)。

所以问题是，如何让程序编译，以便我可以将snap-bulet连接到websocket-part。

我的目标是让websocket监听消息，查询数据库和发送消息包。我已经尝试过的其他事情：

aFun :: (MonadIO m, HasPostgres m) => ... m (..)同时编译db-queries和websocket-things（都是liftIO'd）直到WS.runWebSocketsSnap直接或间接调用aFun。
试图告诉msgHandler :: (MonadIO m, HasPostgres m)但是ghc说没有HasPosgres IO的实例。我的感觉是，如果没有IO实例，这应该是可行的。或者是吗？
下面的代码试图在非snaplet上下文中使用snaplet，但我不确定这是否正确。

在snapframework中组合websockets和（db-）snaplet是否有更好的方法？在尝试了几种方法后，我处于严重的心理锁定状态，显然需要帮助。任何帮助（即使是关于我应该开始学习/刷新什么样的东西的小提示）都将受到高度赞赏！

{-# LANGUAGE TemplateHaskell #-}                                                                                                                                                    
{-# LANGUAGE OverloadedStrings #-}                                                                                                                                                  

module Main where                                                                                                                                                                   

import Data.Maybe                                                                                                                                                                   
import Data.Monoid ((<>))                                                                                                                                                           
import Control.Lens                                                                                                                                                                 
import Control.Monad.Trans                                                                                                                                                          
import Control.Monad.Reader 
import Snap.Snaplet                                                                                                                                                                 
import Snap.Snaplet.PostgresqlSimple                                                                                                                                                
import Snap.Http.Server                                                                                                                                                             
import Snap.Core as SC                                                                                                                                                              
import Data.ByteString as BS                                                                                                                                                        
import Data.Text (Text)                                                                                                                                                             
import qualified Data.Text as T                                                                                                                                                     
import qualified Data.Text.IO as T                                                                                                                                                  
import qualified Network.WebSockets as WS                                                                                                                                           
import qualified Network.WebSockets.Snap as WS                                                                                                                                      

newtype App = App { _db :: Snaplet Postgres }                                                                                                                                       

makeLenses ''App                                                                                                                                                                    

msgHandler :: (MonadIO m) => App -> BS.ByteString -> WS.PendingConnection -> m ()                                                                                                   
msgHandler appSt mUId pending = do                                                                                                                                                  
  conn <- liftIO $ WS.acceptRequest pending                                                                                                                                         
  -- res <- liftIO $ runReaderT (query "SELECT name FROM users WHERE id = ?" (Only mUId)) dbSnaplet                                                                                 
  -- liftIO $ print (res :: [Name])                                                                                                                                                 
  liftIO $ T.putStrLn "msgHandler ended"                                                                                                                                            
    where dbSnaplet = view db appSt                                                                                                                                                 

initApp :: SnapletInit App App                                                                                                                                                      
initApp = makeSnaplet "myapp" "My application" Nothing $                                                                                                                            
  App <$> nestSnaplet "db" db pgsInit                                                                                                                                               
      <* addRoutes [("/hello/:id", helloDb)]                                                                                                                                        

newtype Name = Name { _nm :: Text } deriving (Show, Eq)                                                                                                                             

instance FromRow Name where fromRow = Name <$> field                                                                                                                                

helloDb :: Handler App App ()                                                                                                                                                       
helloDb = do                                                                                                                                                                        
  Just mUId <- getParam "id"                                                                                                                                                        
  userName <- with db $ listToMaybe <$> query "SELECT name FROM users     WHERE id = ?" (Only mUId)                                                                                     
  writeText $ maybe "User not found" (\h -> "Hello, " <> (T.pack . show) h) (userName :: Maybe Name)                                                                                
  sStApp <- getSnapletState                                                                                                                                                         
  WS.runWebSocketsSnap $ msgHandler (view snapletValue sStApp) mUId                                                                                                                 

main :: IO ()                                                                                                                                                                       
main = serveSnaplet defaultConfig initApp

Answer 1

您遇到的重叠实例问题是bug in the snaplet-postgresql-simple library已修复但修复程序尚未发布。您可能想向维护者询问此事。

与此同时，你可以从Github中提取最新版本的库，或者重新定义一个不同但同构为ReaderT (Snaplet Postgres)的类型，复制HasPostgres实例。

如何组合postgresql snaplet和websockets？

1 个答案: