[web-devel] [ Newbie ] [ MongoDB ] Using MongoDB Persistent backend

Max Cantor mxcantor at gmail.com
Wed Jun 29 10:21:43 CEST 2011


Its not trivial.  Apparently, the mongodb driver isn't exactly ready for showtime.  AFAIK, the context monad is a reader monad that contains the connection parameters for mongo.  I never got it to work.  Greg might know more.

Max

On Jun 29, 2011, at 4:17 PM, Kamil Ciemniewski wrote:

> Hi all,
> 
> I've got some "newbie" problems using MongoDB as backend
> in Persistent.
> 
> Basically I've got my app type defined as:
> data MyApp = MyApp
>     { getStatic :: Static -- ^ Settings for static file serving.
>     , connPool :: ConnPool Host
>     }
> 
> And I made it an instance of YesodPersist by:
> instance YesodPersist MyApp where
>   type YesodDB MyApp = MongoDBReader Host
>   runDB db = liftIOHandler
>            $ fmap connPool getYesod >>= (\p -> return (p, "localhost")) >>= runMongoDBConn db
> 
> And I made it an instance of YesodAuth as well by:
> instance YesodAuth MyApp where
>   type AuthId MyApp = UserId
> 
>   loginDest _ = RootR
>   logoutDest _ = RootR
> 
>   getAuthId creds = runDB $ do
>       x <- getBy $ UniqueUser $ credsIdent creds
>       case x of
>       Just (uid, _) -> return $ Just uid
>       Nothing -> do
>           fmap Just $ insert $ User (credsIdent creds) Nothing
> 
>   authPlugins = [ authEmail ]
> 
> I've defined User model as yesod scaffold tool defines it.
> 
> Now, when I try to compile it i get:
> 
> No instances for (Control.Monad.Context.Context
>                         Database.MongoDB.Connection.MasterOrSlaveOk
>                         (GGHandler s MyApp IO),
>                       Control.Monad.Context.Context
>                         Database.MongoDB.Query.Database (GGHandler s MyApp IO),
>                       Control.Monad.Context.Context
>                         Database.MongoDB.Internal.Protocol.Pipe (GGHandler s MyApp IO),
>                       Control.Monad.Context.Context
>                         Database.MongoDB.Query.WriteMode (GGHandler s MyApp IO),
>                       Control.Monad.Throw.Throw
>                         Database.MongoDB.Query.Failure (GGHandler s MyApp IO))
>       arising from a use of `insert'
>     Possible fix:
>       add instance declarations for
>       (Control.Monad.Context.Context
>          Database.MongoDB.Connection.MasterOrSlaveOk
>          (GGHandler s MyApp IO),
>        Control.Monad.Context.Context
>          Database.MongoDB.Query.Database (GGHandler s MyApp IO),
>        Control.Monad.Context.Context
>          Database.MongoDB.Internal.Protocol.Pipe (GGHandler s MyApp IO),
>        Control.Monad.Context.Context
>          Database.MongoDB.Query.WriteMode (GGHandler s MyApp IO),
>        Control.Monad.Throw.Throw
>          Database.MongoDB.Query.Failure (GGHandler s MyApp IO))
>     In the expression: insert
>     In the second argument of `($)', namely
>       `insert $ User (credsIdent creds) Nothing'
>     In the expression:
>         fmap Just $ insert $ User (credsIdent creds) Nothing
> 
> The problem is probably very trivial.. But I've got no ideas how to fix it.
> 
> Best regards
> Kamil Ciemniewski
> _______________________________________________
> web-devel mailing list
> web-devel at haskell.org
> http://www.haskell.org/mailman/listinfo/web-devel




More information about the web-devel mailing list