Combining Persistents SqlPersistT with Servants Handler - haskell

I'm trying to define a helper function that will allow me to run queries using a connection pool provided when run in the Reader monad. I would like to define a function that will abstract away the asks part of fetching the pool, like so:
type Config = Config { getPool :: ConnectionPool }
type App = ReaderT Config
runQuery :: MonadBaseControl IO m => SqlPersistT m a -> App m a
runQuery query =
asks getPool >>= lift . runSqlQuery
Though I am having trouble getting this to compile... I could have sworn this code had worked on a previous project, and low and behold it had. When I went to look at the definitions of Handler (the m I want in App m), and runSqlQuery they both differ. It seems that Handler has an instance for MonadBaseControl IO m whereas runSqlQuery uses MonadUnliftIO, however, looking back to the change prior to when MonadUnliftIO was added, runSqlQuery used MonadBaseControl IO m... which I presume is why my previous code worked in this instance.
So I suppose my question is, how can I change my implementation of runQuery to support the fact that runSqlQuery is based off of MonadUnliftIO now? I had a look through the functions MonadUnliftIO provides (namely unliftIO) but I have been unable to figure out a way to make the types fit.

It seems this may be an intentional design descision of MonadUnliftIO, looking at the readme here https://www.stackage.org/package/unliftio under 'Limitations' it states that it does not support "Transformers with multiple exit points (e.g., ExceptT)", and Servant's Handler is a wrapper around ExceptT. I may just need to find another way of writing this code.

This compiles with persistent-2.8.2:
runQuery :: MonadUnliftIO m => ReaderT SqlBackend m b -> App m b
runQuery query =
asks getPool >>= lift . runSqlPool query

Related

Is Yesod's Handler Monad an instance of MonadBaseControl IO?

I would like to use the withResource :: MonadBaseControl IO m => Pool a -> (a -> m b) -> m b from the Data.Pool library in my handler code. I am trying to determine if Handler is an instance of MonadBaseControl IO, but I'm having a hard time finding the exact place that Handler is defined.
Is Yesod's Handler Monad (as created by mkYesodData) an instance of MonadBaseControl IO or can it easily be made into one?
No, Handler does not have a MonadBaseControl IO instance.
However, it's basically a reader, so it's not too difficult to write one.
Assuming you're using the scaffolded site, the following should work. Add some extensions and imports to the top of Foundation:
import Control.Monad.Base
import Control.Monad.Trans.Control
import Yesod.Core.Types (HandlerFor(..))
In some convenient place after the mkYesodData statement, add the instances:
instance MonadBase IO Handler where
liftBase = liftIO
instance MonadBaseControl IO Handler where
type StM Handler a = a
liftBaseWith ioAct = HandlerFor $ \handlerData ->
ioAct (\handlerAct -> unHandlerFor handlerAct handlerData)
restoreM = return
I have no idea if what you're generally trying to do is a good idea or not, but that should get things to type-check.

How to pass HTTP request parameter to quickQuery?

I'm using Happstack to receive some parameters from an HTTP request then pass these parameters to a function that will retrieve data from the database and return this data in the HTTP response as follow:
myFunc :: IO String
myFunc = do r <- look "personId"
conn <- connectODBC "... my connection string ...";
vals <- quickQuery conn ("SELECT Name FROM Person where Id = ?") [(toSql r)];
return (processData vals)
handlers :: ServerPartT IO Response
handlers = do
x <- liftIO (myFunc);
decodeBody (defaultBodyPolicy "/tmp/" 0 1000 1000)
msum [
dir "getData" $ ok $ toResponse x
, ... other handlers ...
]
mainFunc = simpleHTTP nullConf handlers
But when I build the above code I get the following error:
No instance for (HasRqData IO) arising from a use of `look'
In a stmt of a 'do' block: r <- look "personId"
After reading questions on similar issues (like this one) I think I have to include HasRqData constraint somewhere, but I couldn't learn where and how.
As you may have guessed, this is too an issue with monads. There are a handful of them in happstack (HasRqData, among others), so you may well consider it a complicated case.
Let us begin with the innocent-looking look function.
look :: (Functor m, Monad m, HasRqData m) => String -> m String
Indeed, there is a non-trivial constraint HasRqData. Let us ask ourselves: what monads HaveRqData? (It so happens that IO has not!)
class HasRqData m where
...
Instances
HasRqData RqData
(MonadIO m, MonadPlus m) => HasRqData (ServerPartT m)
...
The other instances are derivative of these first two, so, it looks like we have to consider these two options first.
The RqData has limited effects — you can only do look and its derivatives, extracting information from the request at hand. As we want to also have other effects — querying the database, for one, — this is not enough for us.
The ServerPartT m is the general form of the same old friend of ours, ServerPart ≡ ServerPartT IO. It happens that it also HasRqData. This is not a coincidence, but rather an implication of the design of happstack — looks like the authors meant us to use this single monad everywhere, unless we need particular granularity. So, let's give it a try.
myFunc :: ServerPart String
myFunc = do r <- look "personId"
return undefined
This compiles.
Now, we don't even need to lift myFunc in handlers — our previous predicament solved itself. We will need to lift our access to the database though, by the same jar logic we discussed before.
I believe you can figure the details by yourself. In any case, let me know how it works out!

Building a monad on top of hedis, a haskell redis lib

I want to write a simple DSL on top of hedis, a redis lib. The goal is to write functions like:
iWantThis :: ByteString -> MyRedis ()
iWantThis bs = do
load bs -- :: MyRedis () It fetches a BS from Redis and puts it as
-- the state in a state monad
bs <- get -- :: MyRedis (Maybe ByteString) Gets the current state
put $ doSomethingPure bs -- :: MyMonad () Updates the state
commit -- :: MyRedis () Write to redis
The basic idea is to fetch data from redis, put it in a state monad, do some stuff with the state and then put the updated state back into redis.
Obviously, it should be atomic so load and put should happen in the same Redis transaction. Hedis permits that by wrapping calls to Redis in a RedisTx (Queued a). For example, we have get :: ByteString -> RedisTx (Queued a).
Queued is a monad and you then run multiExec on your Queued a to execute everything in the Queued a in the same transaction. So I tried to define my MyRedis as such:
import qualified Database.Redis as R
newtype MyRedis a = MyRedis { runMyRedis :: StateT MyState R.RedisTx a } -- deriving MonadState, MyState...
The run function calls multiExec so I'm sure that as long as I stay in MyRedis everything happens in the same transaction.
run :: MyRedis (R.Queued a) -> MyState -> IO (R.TxResult a)
run m s = R.runRedis (undefined :: R.Connection) (R.multiExec r)
where r = evalStateT (runMyRedis m) s
Furthermore, I can define commit as:
commit :: ByteString -> MyRedis (R.Queued R.Status)
commit bs = do
MyState new <- get
(MyRedis . lift) (R.set bs new)
And a computation would look like:
computation :: MyRedis (R.Queued R.Status)
computation = do
load gid
MyState bs <- get
put $ MyState (reverse bs)
commit gid
where gid = "123"
But I can't figure out how to write "load"
load :: ByteString -> MyRedis ()
load gid = undefined
Actually, I think that it is not possible to write load, because get is of type ByteString -> RedisTx (Queued (Maybe ByteString)) and I have no way to peek into the Queued monad without executing it.
Questions:
Is it correct that because of the type of Hedis's get, it doesn't make sense to define a load function with the semantics above?
Is it possible to change the MyRedis type definition to make it work?
Hedis doesn't define a RedisT monad transformer. If such a transformer existed, would it be of any help?
Hedis defines (but does not export to lib users) a MonadRedis typeclass; would making my monad an instance of that typeclass help?
Is it the right approach? I want to:
Abstract over Redis (I may switch someday to another DB)
Restrict the Redis functions available to my users (basically only lifting to MyRedis get and set)
Guarantee that when I run my monad everything happens in the same (redis) transaction
Put my redis abstraction at the same level as other functions in my monad
You can play with the code at http://pastebin.com/MRqMCr9Q. Sorry for the pastebin, lpaste.net is down at the moment.
What you want is not possible. In particular, you can't provide a monadic interface while a running a computation in one Redis transaction. Nothing to do with the library you're using - it's just not something Redis can do.
Redis transactions are rather different from the ACID transactions you may be used to from the world of relational databases. Redis transactions have batching semantics, which means that later commands cannot in any way depend on the result of earlier commands.
Look: here's something similar to your example, run at the Redis command line.
> set "foo" "bar"
OK
> multi
OK
> get "foo"
QUEUED -- I can't now set "baz" to the result of this command because there is no result!
> exec
1) "bar" -- I only get the result after running the whole tran
Anyway, that's the purpose of that library's slightly odd Queued type: the idea is to prevent you from accessing any of the results of a batched command until the end of the batch. (It seems that the author wanted to abstract over batched and non-batched commands but there are simpler ways to do that. See below for how I'd simplify the transactional interface.)
So there's no "choosing what to do next" when Redis transactions are involved, but the whole point of (>>=) :: m a -> (a -> m b) -> m b is that later effects can depend on earlier results. You have to choose between monads and transactions.
If you decide you want transactions, there's an alternative to Monad called Applicative which handlily supports purely-static effects. This is exactly what we need. Here's some (entirely untested) code illustrating how I'd cook an Applicative version of your idea.
newtype RedisBatch a = RedisBatch (R.RedisTx (R.Queued a))
-- being a transactional batch of commands to send to redis
instance Functor RedisBatch where
fmap = liftA
instance Applicative RedisBatch where
pure x = RedisBatch (pure (pure x))
(RedisBatch rf) <*> (RedisBatch rx) = RedisBatch $ (<*>) <$> rf <*> rx
-- no monad instance
get :: ByteString -> RedisBatch (Maybe ByteString)
get key = RedisBatch $ get key
set :: ByteString -> ByteString -> RedisBatch (R.Status)
set key val = RedisBatch $ set key val
runBatch :: R.Connection -> RedisBatch a -> IO (R.TxResult a)
runBatch conn (RedisBatch x) = R.runRedis conn (R.multiExec x)
If I wanted to abstract over transactional-or-not behaviour, as the library author has attempted to do, I'd write a second type RedisCmd exposing a monadic interface, and a class containing my primitive operations, with instances for my two RedisBatch and RedisCmd types.
class Redis f where
get :: ByteString -> f (Maybe ByteString)
set :: ByteString -> ByteString -> f (R.Status)
Now, computations with a type of (Applicative f, Redis f) => ... could work for either behaviour (transactional or not), but those which require a monad (Monad m, Redis m) => ... would only be able to run in non-transactional mode.
When all's said and done, I'm not convinced it's worth it. People seem to like building abstractions over libraries like this, invariably providing less functionality than the library did and writing more code for bugs to lurk in. Whenever someone says "I may want to switch databases" I sigh: the only sufficiently abstract abstraction for that purpose is one which provides no functionality. Worry about switching databases when the time comes that you need to (that is, never).
On the other hand, if your goal is not to abstract the database but just to clean up the interface, the best thing may be to fork the library.

Catching an Exception from runDb

This is a follow-up to my previous post. MaybeT and Transactions in runDb
I thought this will be a simple thing to do but I have been trying to figure this out for over a day and still haven't made much progress. So thought I will give up and ask!
I just added a try function (from Control.Exception.Lifted) to my previous code and I couldn't get the code to type check. Variants like catch and handle had similar issues.
eauth <- LiftIO (
try( runDb $ do
ma <- runMaybeT $ do
valid <- ...
case ma of
Just a -> return a
Nothing -> liftIO $ throwIO MyException
) :: IO (Either MyException Auth)
)
case eauth of
Right auth -> return auth
Left _ -> lift $ left err400 { errBody = "Could not create user"}
My runDb looks like this (I also tried a variant where I removed liftIO):
runDb query = do
pool <- asks getPool
liftIO $ runSqlPool query pool
I get this error:
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
arising from a use of ‘runDb’
In the expression: runDb
In the first argument of ‘try’, namely
‘(runDb
$ do { ma <- runMaybeT ...
I am running inside servant handler and my return type is AppM Auth where
type AppM = ReaderT Config (EitherT ServantErr IO)
I have tried many combinations of lifting but doesn't seem to be helping. I thought I will take this opportunity to figure out things from scratch and I hit a wall as well. If someone could suggest how you arrived at the answer, it will be super instructive for me.
This has been my thought process:
I see runSqlConn :: MonadBaseControl IO m => SqlPersistT m a -> Connection -> m a
So that seems to imply it will be in the IO monad, which means try should work
I think check the definition of MonadBaseControl which has class MonadBase b m => MonadBaseControl b m | m -> b. At this point I am confused. This functional dependency logic seems to be suggest type m dictates what b will be but in the previous one b was specified as IO.
I check MonadBase and that did not give me any clue either.
I check SqlPersistT and got no clues either.
I reduced the problem to something very simple like result <- liftIO (try (evaluate (5 `div` 0)) :: IO (Either SomeException Int)) and that worked. So I was even more confused at this time. Doesn't runDb work in IO so shouldn't the same thing work for my original code?
I thought I can figure this out by backtracking but it seems like my level of Haskell knowledge is just not sufficient to get at the root of the problem. Appreciate if people can provide step by step pointers as to arrive at the right solution.
Thanks!
General type signature for try:
(MonadBaseControl IO m, Exception e) => m a -> m (Either e a)
Specialized type signature for try (as it appears in your code):
IO Auth -> IO (Either MyException Auth)
So, the monadic value that is the argument to try has type:
IO Auth
Everything listed above, you probably already understood. If we look at the type signature for your runDb, we get this:
runDb :: (MonadReader Config m, MonadIO m) => SqlPersistT m a -> m a
I sort of had to guess because you didn't provide a type signature, but that is probably what it is. So now, the problem should be a little clearer. You are trying to use runDb to create a monadic value for something that's supposed to be in IO. But IO doesn't satisfy the MonadReader Config instance that you need.
To make the mistake more clear, let's make runDb more monomorphic. You could give it this type signature instead:
type AppM = ReaderT Config (EitherT ServantErr IO)
runDb :: SqlPersistT AppM a -> AppM a
And now if you tried to compile your code, you would get an even better error. Instead of telling you
No instance for (Control.Monad.Reader.Class.MonadReader Config IO)
It would tell you that IO doesn't match AppM (although it would probably expand the type synonym). Practically, what this means is that you can't get the shared pool of database connections magically out of IO. You need the ReaderT Config that was passing it around everywhere.
The easiest fix I can think of would be to stop using exceptions where they aren't necessary:
mauth <- runDb $ runMaybeT $ do
... -- Same stuff you were doing earlier
case mauth of
Just auth -> return auth
Nothing -> lift $ left err400 { errBody = "Could not create user"}

Haskell: Making Snap and LevelDB play nice

I am using the LevelDB library and Snap framework together. I have:
main :: IO ()
main = runResourceT $ do
db <- open "thedb" defaultOptions { createIfMissing = True }
liftIO $ serveSnaplet defaultConfig $ initWeb db
Now in my handler, I'm unsure how to get back to MonadResource IO in order to query the database:
handleWords :: Handler App App ()
handleWords = do
words <- uses thedb $ \db -> $ get db def "words"
writeBS $ pack $ show words
Which gives me a: No instance for (MonadResource IO) arising from a use of 'get'
Any ideas? I feel like I'm missing something about how to properly create a monad "stack". Thanks
MonadResource/ResourceT is one way of acquiring scarce resources in a way that guarantees resources will be freed in the case of an exception. Another approach is the bracket pattern, which is supported by Snap via the bracketSnap function. You can use this to create the ResourceT context needed by LevelDB:
import qualified Control.Monad.Trans.Resource as Res
bracketSnap Res.createInternalState Res.closeInternalState $ \resState -> do
let openAction = open "thedb" defaultOptions { createIfMissing = True }
db <- Res.runInternalState openAction resState
This could be made simpler with some changes in Snap and leveldb:
Instead of only providing the open function, which presumes a MonadResource context, there could be a function which returns a Resource value. I'm making this tweak in persistent for the 2.0 release.
Snap could provide support for either MonadResource or the Resource monad (two separate concepts with unfortunately similar names).
Snap doesn't need to support MonadResource or Resource for you to do this. You're doing the monad transformer composition in the wrong direction. A look at the types will help.
serveSnaplet :: Config Snap AppConfig -> SnapletInit b b -> IO ()
runResourceT :: MonadBaseControl IO m => ResourceT m a -> m a
So you're trying to put an IO in the place that a ResourceT is expected. You should approach this the other way around. Put your open "thedb" ... call inside your application's Initializer with a liftIO. But open is a MonadResource, so you need to use the ResourceT instance to get it into an IO. It will look something like this:
app = makeSnaplet "app" "An snaplet example application." Nothing $ do
...
db <- liftIO $ runResourceT $ open "thedb" defaultOptions
Then store the db handle in your App state and you can retrieve it later using Handler's MonadReader or MonadState instances.

Resources