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