Complete functions #15

Merged
MasseR merged 3 commits from sandbox/MasseR/14-error-types into master 2018-08-15 22:10:16 +03:00
Showing only changes of commit f7bc0d420c - Show all commits

View File

@ -16,15 +16,13 @@ import Database.Schema
import Database import Database
import Database.Selda import Database.Selda
import Database.Selda.Generic import Database.Selda.Generic
import Control.Monad.Trans.Maybe
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m Tag upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m (Maybe Tag)
upsertTag username tag = do upsertTag username tag = runMaybeT $ do
-- I want this to error out if some data is invariant is wrong and roll back userId <- MaybeT (listToMaybe <$> query userQ)
-- the transaction. Also as a side note, run this in a transaction plz void $ lift $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
[userId] <- query userQ MaybeT (listToMaybe . fromRels <$> query (tagQ userId))
void $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
[t] <- fromRels <$> query (tagQ userId)
return t
where where
predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId
tagQ userId = do tagQ userId = do
@ -48,7 +46,8 @@ booksTags bookId = fromRels <$> query q
attachTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m () attachTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
attachTag username bookId tag = do attachTag username bookId tag = do
Tag{identifier} <- upsertTag username tag maybeT <- upsertTag username tag
forM_ maybeT $ \Tag{identifier} -> do
whenM (null <$> query (tagQ identifier)) $ whenM (null <$> query (tagQ identifier)) $
void $ insertGen bookTags [BookTag identifier bookId] void $ insertGen bookTags [BookTag identifier bookId]
where where