Chaining DB Insertions Without Explicitly Checking for Success - haskell

I am trying to figure out if there is a way to avoid lots of case statements while inserting records into the DB.
My current code sort of looks like this:
mt1 <- runDb $ do
muid <- insertUnique user
case muid of
Just uid -> do
let t1 = Table1 {..., user = uid}
maid <- insertUnique t1
case maid of
Just aid -> do
mo <- getBy $ UniqueField "somevalue"
case mo of
Just (Entity oid o) -> do
mcid <- insertUnique Table2 {..., oid = oid}
case mcid of
Just cid -> do
mfid <- insertUnique Table3 {..., cid = cid}
case mfid of
Just fid -> Just t1 -- original t1 that was created at the top of the chain
Nothing -> Nothing
Nothing -> Nothing
Nothing -> Nothing
Nothing -> Nothing
Nothing -> Nothing
Nothing -> Nothing
First of all, I have issues getting the code to compile but instead of trying to debug that, I wanted to see if there is a better way to do this.
At a conceptual level, I want to do something like below, where all the Maybe values get unwrapped automatically to be used in subsequent invocations. If any point, we hit a Nothing, I just want to return Nothing. The whole code will run in a single transaction so if we hit a Nothing in between, the transaction is rolled back
runDb $ do
uid <- insertUnique user
let t1 = Table1 {..., user = uid} -- uid is unwrapped to just the value
aid <- insertUnique t1
o <- getBy $ UniqueField "somevalue"
cid <- insertUnique Table2 {..., oid = oid}
fid <- insertUnique Table3 {..., cid = cid}
Just t1
I am Haskell beginner so I only have superficial understanding of Monads (I can use the simple ones fine) but when it comes to use it inside something like runDb of Persistent, I have no idea how to put the pieces together.
Any suggestions on how I can simply the logic so I don't end up checking for failure each step of the way?
Update: Based on Michael's answer, I did something like this and it automatically unwraps the maybes when used.
mt1 <- runDb $ runMaybeT $ do
uid <- MaybeT $ insertUnique user
...
case mt1 of
Just t -> return t
Nothing -> lift $ left ...
Thanks!

The standard approach to something like this is the MaybeT monad transformer. Something like the following will probably work:
runMaybeT $ do
uid <- MaybeT $ insertUnique user
...

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.

Yesod - Maybe EntityId to Maybe Entity

First of all I'm a Haskell noob so if there is something obvious I'm doing wrong sorry.
Say I have something like:
Object1
stuff Text
other Object2Id Maybe
Object2
otherStuff Text
in my config/models file
How do I get the Object2 associated to Object1 if I have a handler of type:
getObject1R :: Object1Id -> Handler Html
If I understand correctly I want to go from a Maybe Object2Id to a Maybe Object with calling runDB $ get in the middle and with everything I've tried the types don't line up properly.
Thanks
EDIT
here is one attempt that I feel is close but isn't correct:
object1 <- runDB $ get object1Id
maybeObj2 <- case (object1Other object1) of
Just obj2Id -> Just $ runDB $ get obj2Id
Nothing -> Nothing
EDIT 2 (figured it out)
So I figured out how to get it to compile and work! Thanks for the comments and help.
here is my code (in the handler):
(object1, maybeObject2) <- runDB $ do
object1 <- get404 object1Id
maybeObject2 <- case (object1Other object1) of
Just object2Id -> get object2Id
Nothing -> return Nothing
return (object1,maybeObject2)
I'm sure there are better/faster/easier ways to do it, but this worked.
So I figured out how to get it to compile and work! Thanks for the comments and help.
here is my code (in the handler):
(object1, maybeObject2) <- runDB $ do
object1 <- get404 object1Id
maybeObject2 <- case (object1Other object1) of
Just object2Id -> get object2Id
Nothing -> return Nothing
return (object1,maybeObject2)
I'm sure there are better/faster/easier ways to do it, but this worked.

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.

MaybeT and Transactions in runDb

For my previous question on chaining failures, Michael Snoyman had suggested I use MaybeT to run them so if any of them fails, it will just short-circuit to Nothing.
I was under the impression runDb runs everything in a transaction. So shouldn't a failure at any point in code automatically rollback the transaction?
mauth <- runDb $ runMaybeT $ do
valid <- MaybeT $ return $ listToMaybe errs
uid <- MaybeT $ insertUnique u
vid <- MaybeT $ getBy $ UniqueField v -- this step fails but previous insert does not roll back
auth <- liftIO $ createAuthToken uid
return auth
When I run the above code, the getBy fails but user was still inserted. Am I misunderstanding that runDb will rollback on a Nothing inside MaybeT? Do I need to use some other Monad for this to work?
Appreciate your thoughts on how to best rollback on failure.
Update:
This is what I ended up doing per Michael's suggestion.
mauth <- runDb $ do
ma <- runMaybeT $ do
valid <- ...
case ma of
Just _ -> return ma
Nothing -> liftIO $ throwIO MyException
Now I need to figure out how to catch this exception nicely outside and return a proper error message back.
Thanks!
Returning Nothing is not the same thing as a failure. You'd need to throw a runtime exception (via something like throwIO) for Persistent to treat it as a rollback situation.

selectOneMany Yesod Persistent

Im trying to get selectOneMany to work with limited success.
I have the following database models
User
email Text
verkey Text Maybe
verified Bool
password Text Maybe
UniqueUser email
date UTCTime
deriving Show
Competence
parent CompetenceId Maybe
title Text
UniqueCompetence title
deriving Show Read
UserCompetence
competence CompetenceId
user UserId Eq
UniqueUserCompetence user competence
deriving Show Read
code from my handler
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
user <- MaybeT . runDB . get . entityKey $ id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
return (member,competences)
first of; I cant event get this code to run without adding a big type-signature, is this as it should be?
competences <- lift . runDB . runJoin $ (selectOneMany (UserCompetenceUser <-.) userCompetenceUser :: SelectOneMany SqlPersist (UserGeneric SqlPersist) (UserCompetenceGeneric SqlPersist))
secondly; what is the type of competences. Ideally i want to end up with [Entity competenceId competence].
Lastly; How would one add a filter to the above join so as to only acquire competences for 'user'?
I have already told you that it's not possible to avoid the extra type signature due to the fact that SelectOneMany uses type aliases that might not be inductive; i.e. your code tries to be more polymorphic than it should be, and the type signature is necessary to restrict that polymorphism.
You can avoid using the huge signature by constraining the types "from a different angle", e.g.:
return (member, competences :: [(Entity User, [Entity UserCompetence])])
Since the type aliases User and UserCompetence select a specific database backend, the types should be resolved appropriately.
Also, I just spoiled the type of competences for you. Hah! I hope that that's enough for you. If you want a many-to-many three-table join directly so that you can get all competences "owned" by an user, you should use prepared statements anyways because of the potential AST overhead, so check out the generic raw SQL interface which lets you do the traditional "SELECT * FROM foo WHERE bar = ?" [filteredBarValue] which you might be more used to working with; it doesn't offer the same type safety as the rest of persistent but I think that it's the easiest way to implement three-table joins in your case.
You can restrict the Users that are selected by modifying the result of oneFilterMany which has type OneFilterMany. Like so (haven't tested it, but should work):
let join = (selectOneMany (UserCompetenceUser <-.) userCompetenceUser)
{ somFilterOne = [... filters for User ...] }
competences <- lift . runDB . runJoin $ join
Thanks to (lots of) help from dflemstr I ended up with
mmember <- runMaybeT $ do
id <- MaybeT $ maybeAuth
let user = entityVal id
Entity memberId member <- MaybeT . runDB . getBy . UniqueMember . userEmail $ user
let competenceStatement =
Text.concat
[ "SELECT ?? "
, "FROM competence, user_competence "
, "WHERE competence.id = user_competence.competence_id "
, "AND ? = user_competence.user_id"
]
competences <- lift . runDB $ rawSql competenceStatement
[toPersistValue . entityKey $ id]
return (member, competences :: [Entity Competence])

Resources