fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

More idiomatic usage of invRef

Browse Source
This commit is contained in:
Gregor Kleen 2019-04-23 11:17:43 +02:00
parent dfe0b4de5e
commit 2a0bee58b5
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/Utils/Invitations.hs
View File

@ -179,13 +179,13 @@ sinkInvitations InvitationConfig{..} = determineExists .| C.foldMap pure >>= lif
= C.map Right
| otherwise
= C.mapM $ \inp@(email, fid, dat) ->
maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (toJSON $ InvRef @junction fid))
maybe (Right inp) (Left . (, dat)) <$> getKeyBy (UniqueInvitation email (invRef @junction fid))
sinkInvitations' :: [Either (InvitationId, InvitationData junction) (UserEmail, Key (InvitationFor junction), InvitationData junction)]
-> YesodJobDB UniWorX ()
sinkInvitations' (partitionEithers -> (existing, new)) = do
when (is _Nothing (ephemeralInvitation @junction)) $ do
insertMany_ $ map (\(email, fid, dat) -> Invitation email (toJSON $ InvRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
insertMany_ $ map (\(email, fid, dat) -> Invitation email (invRef @junction fid) (toJSON $ dat ^. _invitationDBData)) new
forM_ existing $ \(iid, dat) -> update iid [ InvitationData =. toJSON (dat ^. _invitationDBData) ]
forM_ new $ \(jInvitee, fid, dat) -> do
app <- getYesod
@ -250,7 +250,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
Entity fid fRec <- invitationResolveFor >>= (\k -> Entity k <$> get404 k)
dbData <- case ephemeralInvitation @junction of
Nothing -> do
Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail . toJSON $ InvRef @junction fid)
Invitation{..} <- entityVal <$> getBy404 (UniqueInvitation itEmail $ invRef @junction fid)
case fromJSON invitationData of
JSON.Success dbData -> return dbData
JSON.Error str -> fail $ "Could not decode invitationData: " <> str
@ -275,7 +275,7 @@ invitationR' InvitationConfig{..} = liftHandlerT $ do
fmap (, (dataWidget, dataEnctype), heading, explanation) . formResultMaybe dataRes $ \case
Nothing -> do
addMessageI Info MsgInvitationDeclined
deleteBy . UniqueInvitation itEmail . toJSON $ InvRef @junction fid
deleteBy . UniqueInvitation itEmail $ invRef @junction fid
return . Just $ SomeRoute HomeR
Just jData -> do
mResult <- insertUniqueEntity $ review _InvitableJunction (invitee, fid, jData)