Monad troubles porting from Lift to Yesod's Persistent - haskell

I have a Lift app I'm porting to Yesod as a way to learn the framework and Haskell. Part of the app resides only on the TCP and database layers: parsing incoming bytes from a socket connection and turning them into Updates for the model to handle. I did this in Scala with regexes and pattern-matching, and failed to reproduce it in Haskell.
A highly simplified example:
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persist|
Person
name String
deriving Show
UnknownMessage
text String
deriving Show
|]
parseMsg m = runDB $ do
case ms of
["add",name] -> insert Person{personName = name}
["delete",name] -> deleteWhere [PersonName ==. name]
["change",from,to] -> updateWhere [PersonName ==. from] [PersonName =.to]
_ -> insert UnknownMessage{unknownMessageText = m}
where
ms = splitRegex (mkRegex ",") m
The above code will only compile with three of the four pattern matches commented out. "insert Person" does not play with "deleteWhere", or even "insert UnknownMessage". The results tend to be type-matching error messages which I often can't make heads or tails of.
How might I rewrite the above code? Is there a Persistent guide for the monadically challenged anywhere? The book chapter doesn't go into much detail on how to chain queries and the like.
Edit: hammar's suggestion of adding (>>) to the Inserts fixed the issue. If I remove "runDB $ do", the function's type becomes "parseMsg :: PersistQuery backend m => String -> backend m ()". Would this allow me to execute the returned query later within a monad, as I was doing with my Updates in Scala?

I'm no Yesod expert, but from a quick look at the docs it looks like the problem is that the insert action returns a key for the new record, while updateWhere and deleteWhere both return ().
insert :: (...) => val -> backend m (Key backend val)
updateWhere :: (...) => [Filter val] -> [Update val] -> backend m ()
deleteWhere :: (...) => [Filter val] -> backend m ()
Presumably, you don't care about the key here, so you can discard it by doing
insert Person{personName = name} >> return ()
which should make it type check.

Related

In Persistent (Haskell), how can I insert a record only if it doesn't already exist?

I'm a Haskell beginner, so apologies in advance!
I've been following the Persistent tutorial here.
I have a data model with a uniqueness constraint:
Book
gutId Int
UniqueGutId gutId
...
author [AuthorId]
...
Author
gutId Int
UniqueAuthorGutId gutId
...
And when I go to insert a record using this:
runSqlite "test.db" $ do
runMigration migrateAll
-- FIXME: This won't work if there's an author that's already in the database.
authorIds <- mapM insert authors
It won't work if the record is already in the database. (It'll just return an exception.) I can do this instead:
authorIds <- mapM insertUnique authors
But the problem is, I need to use authorIds to update Book records later. So I'm just wondering if anyone knows of an easy way to insert a record if it doesn't exist, and return the new key, or get the record key if it already exists, so that I have an array of keys either way. The full code at this point is up here.
You just need to perform both actions you mentioned yourself:
authorIds <- forM authors $ \a -> do
res <- insertUnique a
case res of
Just key -> return key
_ -> fromJust <$> getBy (authorGutId a)
How about
authorIds <- mapM (fmap (either entityKey id) . insertBy) authors
insertBy :: _ => -- some constraints
record -> -- given some record, try to insert it
_ ( -- in some monad
Either (Entity record) (Key record)
-- if found: Left existing
-- otherwise: Right newKey
)
Data.Either.either :: (l -> o) -> (r -> o) -> Either l r -> o
-- eliminator for Either
-- purpose and implementation completely determined by type
We use insertBy to try to insert the record. fmap drills underneath the monad, and either entityKey id extracts the Key.

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!

Distributed Process in monad transformer

Im toying with implementing a gossip based cluster membership backend for the so called cloud-haskell or is it Distributed.Process.. anyway Im trying to get away with handeling state without ioref or MVars and instead using a state transformer and putting the Process monad on the bottom, like so:
type ClusterT = StateT ClusterState
type Cluster a = ClusterT Process a
This works fairly well using Control.Distributed.Process.Lifted (https://hackage.haskell.org/package/distributed-process-lifted) allowing you to do something like this:
mystatefulcomp :: Cluster ()
mystatefulcomp = do
msg <- expect :: Cluster String
old_state <- get
say $ "My old state was " ++ (show old_state)
put $ modifyState curr_state msg
mystatefulcomp
main = do
Right transport <- createTransport '127.0.0.1' '3000' (\n -> ('127.0.0.1', n) defaultTCPParameters
node <- newLocalNode transport initRemoteTable
runProcess node (evalStateT mystatefulcomp initialstate)
where initialstate = ClusterState.empty
this works resonably well and allows me to structure my program fairly well, i can keep my state functional and thread it along in the Cluster monad.
This all break tho when i try to use receiveWait and match to receive messages.
lets rewrite statefulcomp to do something else using receiveWait
doSomethingWithString :: String -> Cluster ()
doSomethingWithString str = do
s < get
put $ modifyState s str
mystatefulcomp :: Cluster ()
mystatefulcomp = do
old_state <- get
receiveWait [ match doSomthingWithString ]
new_state <- get
say $ "old state " ++ (show old_state) ++ " new " ++ (show new_state)
This wont work since the match function is of type (a -> Process b) -> Match b but we want it to be of type (a -> Cluster b) -> Match b. And here is where i get out on thin ice. As i understand Control.Distributed.Process.Lifted rexposes Control.Distributed.Process functions lifted into the tansformer stack allowing you to use functions like expect and say but does not rexposes match, matchIf and so on..
Im really struggeling with this trying to find a work around or a way of re implementing match and its friends to the form of MonadProcess m => (a -> m b) -> Match b.
Any insights is apriciated.
edit
So after som fiddeling about I came up with the following
doSomethingWithString :: String -> Cluster ()
doSomethingWithString str = do
s < get
put $ modifyState s str
doSomethingWithInt :: Int -> Cluster ()
...
mystatefulcomp :: Cluster ()
mystatefulcomp = do
old_state <- get
id =<< receiveWait [ match $ return . doSomethingWithString
, match $ return . doSomethingWithInt ]
new_state <- get
say $ "old state " ++ (show old_state) ++ " new " ++ (show new_state)
This works fairly well but I am still curious about how good of a design this is
As Michael Snoyman points out in a series of blog posts (that's 5 links), wrapping StateT around IO is a bad idea. You just stumbled over one instance where that surfaces.
mystatefulcomp :: Cluster ()
mystatefulcomp = do
old_state <- get
receiveWait [ match doSomethingWithString ]
new_state <- get
The problem is what ends up in new_state if doSomethingWithString throws an error. The old_state? Some intermediate state from doSomethingWithString before the exception? You see, the very fact that we are wondering makes this approach no less bad than just storing the state in an IORef or MVar.
Apart from questionable semantics, this can't even be implemented without distributed-process being rewritten to use MonadBaseControl everywhere. This is exactly why distributed-process-lifted fails to deliver, because it just wraps around the primitives from distributed-process.
So, what I would do here instead is to pass around a data Config = Config { clusterState :: MVar ClusterState } environment (Oh look, Process does that, too!). Possibly with ReaderT which interacts with IO in a sane way, plus you can easily lift any number of nested occurences of Process to ReaderT Config Process yourself.
Repeating the message of Michael's blog posts: StateT isn't bad in general (in a pure transformer stack, that is), just for cases where we wrap IO in some way. I encourage you to read those posts, they were very inspiring for me, so here they are again:
https://www.fpcomplete.com/blog/2017/06/readert-design-pattern
https://www.fpcomplete.com/blog/2017/06/understanding-resourcet
https://www.fpcomplete.com/blog/2017/06/tale-of-two-brackets
https://www.fpcomplete.com/blog/2017/07/announcing-new-unliftio-library
https://www.fpcomplete.com/blog/2017/07/the-rio-monad

Entering relations to database using Persistent

Starting out with Haskell and Yesod, probably getting a bit too far with Yesod relative to Haskell :)
I build entities using Persistent via
share [mkPersist sqlSettings, mkMigrate "migrateAll"][persistLowerCase|
Game
title String
company String
UniqueTitle title
deriving Show
Tag
label String
description String Maybe
UniqueLabel label
deriving Show
GameTag
gameId GameId
tagId TagId
UniqueGameTag gameId tagId
|]
-- Yesod related code ...
In main I have
main :: IO ()
main = do
let taggings = fromFile :: [(Game, Tag)] -- fromFile code not included
runStderrLoggingT $ withSqlitePool ":inmemory:" 10 $ λpool → liftIO $ do
runResourceT $ flip runSqlPool pool $ do
runMigration migrateAll
let (g, t) = head taggings
gid ← insert g
tid ← insert t
insert (GameTag gid tid)
warp 3000 $ App pool
Doing this I get the first relation into the database, and by selecting elements from the list I can add more 'by hand', but I can't figure out how to get all the relations into the database by somehow iterating over taggings. How do i define a function that I can map over taggings ::[(Game, Tag)] and inserts the game tags of the type GameTag constructed
by Persistent?
The main trick here isn't in pulling out the function, that is easy:
f (g, t) = do
gid <- insert g
tid <- insert t
insert (GameTag gid tid)
The trick is knowing how to use this.... Standard map won't work alone, because the function is defined in a monad (you can use it, it will just give you a list of actions back without running them).
map f taggings -- returns just a list, type [ResourceT IO a], doesn't run anything
Here are two ways to actually run the actions from within main.
sequence (map f taggings) --sequentially runs the actions in the list
or, the more readable
forM taggings f
or, in the slightly more verbose
forM taggings $ \tagging -> do
f tagging
You also might want to look at mapM. Also also should learn about forM_ and sequence_ to supress the (often useless) return values.

Haskell + Yesod: Separating insert logic using Persistent won't compile. Cannot figure out types

I'm new to Haskell, coming from Scala. I like Haskell, but I feel like I'm fighting the type system when it comes to using persistent.
My Request: I'd like to separate some insert logic into its own method. I can't quite figure out the types, or the right way to do this. All my failed attempts won't compile. More succinct questions below.
Here is the data declaration:
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Curator
name String
url String
feed String
UniqueUrl url
deriving Show
Article
url String
title String
content String
curatorId CuratorId Eq
deriving Show
|]
Here's a failed attempt that doesn't work:
insertArticle :: String -> String -> String -> MaybeT (???)
insertArticle url title content = do
curatorId <- selectFirst [curatorName ==. "Fake Name"]
lift $ do
curator <- curatorId
insert (Article url title content curator)
So, my questions:
What type should be in ??? ?
Is lift in the right place? (usually the compiler is more helpful).
Is there a better way to do this?
PS - I have successfully abstracted other logic away, e.g. The insert is just causing me a world of pain. I was unable to get it to compile while using SqlPersistM
getFeeds :: SqlPersistM [Curator]
getFeeds = do
curatorIds <- selectList [] [Asc CuratorName]
let curatorGenerics = map entityVal curatorIds
let curators = map (\x -> x :: Curator) curatorGenerics
return curators
The return type of insertArticle should be SqlPersistM (Maybe ArticleId), because it returns Just an inserted article id or Nothing in SqlPersistM monad.
You can implement the function something like:
insertArticle :: String -> String -> String -> SqlPersistM (Maybe ArticleId)
insertArticle url title content = do
curatorEntity <- selectFirst [CuratorName ==. "Fake Name"] []
for curatorEntity $ \(Entity curatorId _) ->
insert (Article url title content curatorId)
I use for from Data.Traversable to handle the Maybe value selectFirst returns here.
But, actually, I don't like this type signature because it sticks to the sql backend. To make it more generalized, you can write a type annotation like this.
insertArticle :: (Applicative m, PersistQuery m, PersistMonadBackend m ~ PersistEntityBackend Curator) =>
String -> String -> String -> m (Maybe ArticleId)
The signature is a bit complex, but this function works with any backends.
By the way, your getFeeds can be simplified.
getFeeds :: (Functor m, PersistQuery m, PersistMonadBackend m ~ PersistEntityBackend Curator) =>
m [Curator]
getFeeds = map entityVal <$> selectList [] [Asc CuratorName]

Resources