From 6545aaea177441a0248d88fd4c2558b2e1360027 Mon Sep 17 00:00:00 2001 From: Jon Schoning Date: Sat, 24 Jul 2021 20:21:13 -0500 Subject: [PATCH] always get tags via subquery instead of separate query --- src/Handler/User.hs | 43 +++----- src/Model.hs | 238 +++++++++++++++++++++----------------------- 2 files changed, 127 insertions(+), 154 deletions(-) diff --git a/src/Handler/User.hs b/src/Handler/User.hs index 10fc52d..4c6efcc 100644 --- a/src/Handler/User.hs +++ b/src/Handler/User.hs @@ -6,7 +6,6 @@ import Handler.Common import Import import qualified Text.Blaze.Html5 as H import Yesod.RssFeed -import qualified Database.Esqueleto.Experimental as E import qualified Data.Map as Map getUserR :: UserNameP -> Handler Html @@ -40,14 +39,11 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do queryp = "query" :: Text mquery <- lookupGetParam queryp let mqueryp = fmap (\q -> (queryp, q)) mquery - (bcount, bmarks, alltags) <- - runDB $ - do Entity userId user <- getBy404 (UniqueUserName uname) + (bcount, btmarks) <- runDB $ do + Entity userId user <- getBy404 (UniqueUserName uname) when (not isowner && userPrivacyLock user) (redirect (AuthR LoginR)) - (cnt, bm) <- bookmarksQuery userId sharedp filterp pathtags mquery limit page - tg <- tagsQuery bm - pure (cnt, bm, tg) + bookmarksTagsQuery userId sharedp filterp pathtags mquery limit page when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ()) mroute <- getCurrentRoute tagCloudMode <- getTagCloudMode isowner pathtags @@ -60,14 +56,18 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do rssLink (UserFeedR unamep) "feed" $(widgetFile "user") toWidgetBody [julius| - app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || []; + app.dat.bmarks = #{ toJSON $ toBookmarkFormList btmarks } || []; app.dat.isowner = #{ isowner }; app.userR = "@{UserR unamep}"; app.tagCloudMode = #{ toJSON $ tagCloudMode } || {}; |] toWidget [julius| - PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)(); - PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)(); + setTimeout(() => { + PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)(); + }, 0); + setTimeout(() => { + PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)(); + }, 0); |] -- Form @@ -98,24 +98,17 @@ _updateTagCloudMode mode = TagCloudModeRelated _ _ -> setTagCloudMode mode TagCloudModeNone -> notFound -bookmarkToRssEntry :: (Entity Bookmark, [Text]) -> FeedEntry Text +bookmarkToRssEntry :: (Entity Bookmark, Maybe Text) -> FeedEntry Text bookmarkToRssEntry ((Entity entryId entry), tags) = FeedEntry { feedEntryLink = bookmarkHref entry , feedEntryUpdated = bookmarkTime entry , feedEntryTitle = bookmarkDescription entry , feedEntryContent = toHtml (bookmarkExtended entry) - , feedEntryCategories = map (EntryCategory Nothing Nothing) tags + , feedEntryCategories = map (EntryCategory Nothing Nothing) (maybe [] words tags) , feedEntryEnclosure = Nothing } -toBookmarkWithTagsList :: [Entity Bookmark] -> [Entity BookmarkTag] -> [(Entity Bookmark, [Text])] -toBookmarkWithTagsList bs as = do - b <- bs - let bid = E.entityKey b - let btags = filter ((==) bid . bookmarkTagBookmarkId . E.entityVal) as - pure $ (b, map (bookmarkTagTag . E.entityVal) btags) - getUserFeedR :: UserNameP -> Handler RepRss getUserFeedR unamep@(UserNameP uname) = do mauthuname <- maybeAuthUsername @@ -125,17 +118,13 @@ getUserFeedR unamep@(UserNameP uname) = do queryp = "query" :: Text isowner = maybe False (== uname) mauthuname mquery <- lookupGetParam queryp - (_, bmarks, alltags) <- - runDB $ - do Entity userId user <- getBy404 (UniqueUserName uname) + (_, btmarks) <- runDB $ do + Entity userId user <- getBy404 (UniqueUserName uname) when (not isowner && userPrivacyLock user) (redirect (AuthR LoginR)) - (cnt, bm) <- bookmarksQuery userId SharedPublic FilterAll [] mquery limit page - tg <- tagsQuery bm - pure (cnt, bm, tg) + bookmarksTagsQuery userId SharedPublic FilterAll [] mquery limit page let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname) - entriesWithTags = toBookmarkWithTagsList bmarks alltags - entries = map bookmarkToRssEntry entriesWithTags + entries = map bookmarkToRssEntry btmarks updated <- case maximumMay (map feedEntryUpdated entries) of Nothing -> liftIO $ getCurrentTime Just m -> return m diff --git a/src/Model.hs b/src/Model.hs index 65bc4df..b4768c7 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -3,27 +3,25 @@ module Model where import qualified ClassyPrelude.Yesod as CP -import Control.Monad.Fail (MonadFail) +import qualified Control.Monad.Combinators as PC (between) import qualified Data.Aeson as A import qualified Data.Aeson.Types as A (parseFail) import qualified Data.Attoparsec.Text as P -import qualified Control.Monad.Combinators as PC -import qualified Data.List.NonEmpty as NE -import qualified Data.Time.ISO8601 as TI -import qualified Data.Time.Clock.POSIX as TI -import qualified Database.Esqueleto.Experimental as E -import qualified Database.Esqueleto.Internal.Internal as E (exists, unsafeSqlFunction) -import qualified Data.Time as TI -import ClassyPrelude.Yesod hiding ((||.)) -import Control.Monad.Trans.Maybe +import qualified Data.Time as TI (ParseTime) +import qualified Data.Time.Clock.POSIX as TI (posixSecondsToUTCTime, POSIXTime) +import qualified Data.Time.ISO8601 as TI (parseISO8601, formatISO8601Millis) +import ClassyPrelude.Yesod hiding ((==.), (||.), on, Value, groupBy, exists, (>=.), (<=.)) +import Control.Monad.Fail (MonadFail) +import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Control.Monad.Writer (tell) import Data.Char (isSpace) import Data.Either (fromRight) import Data.Foldable (foldl, foldl1, sequenceA_) import Data.List.NonEmpty (NonEmpty(..)) -import Database.Esqueleto.Experimental hiding ((==.)) -import Pretty -import System.Directory +import Database.Esqueleto.Experimental +import Database.Esqueleto.Internal.Internal (unsafeSqlFunction) +import Pretty () +import System.Directory (listDirectory) import Types import qualified Data.Map.Strict as MS @@ -142,10 +140,10 @@ migrateIndexes = sqlite_group_concat :: PersistField a - => SqlExpr (E.Value a) - -> SqlExpr (E.Value a) - -> SqlExpr (E.Value Text) -sqlite_group_concat expr sep = E.unsafeSqlFunction "GROUP_CONCAT" [expr, sep] + => SqlExpr (Value a) + -> SqlExpr (Value a) + -> SqlExpr (Value Text) +sqlite_group_concat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep] authenticatePassword :: Text -> Text -> DB (Maybe (Entity User)) authenticatePassword username password = do @@ -159,9 +157,10 @@ authenticatePassword username password = do getUserByName :: UserNameP -> DB (Maybe (Entity User)) getUserByName (UserNameP uname) = do - selectFirst [UserName ==. uname] [] + selectFirst [UserName CP.==. uname] [] -bookmarksQuery +-- returns a list of pair of bookmark with tags merged into a string +bookmarksTagsQuery :: Key User -> SharedP -> FilterP @@ -169,74 +168,92 @@ bookmarksQuery -> Maybe Text -> Limit -> Page - -> DB (Int, [Entity Bookmark]) -bookmarksQuery userId sharedp filterp tags mquery limit' page = + -> DB (Int, [(Entity Bookmark, Maybe Text)]) +bookmarksTagsQuery userId sharedp filterp tags mquery limit' page = (,) -- total count - <$> fmap (sum . fmap E.unValue) - (select $ do - b <- from $ table @Bookmark + <$> fmap (sum . fmap unValue) + (select $ from (table @Bookmark) >>= \b -> do _whereClause b - pure E.countRows) + pure countRows) -- paged data - <*> (select $ do - b <- from $ table @Bookmark + <*> (fmap . fmap . fmap) unValue + (select $ from (table @Bookmark) >>= \b -> do _whereClause b orderBy [desc (b ^. BookmarkTime)] limit limit' offset ((page - 1) * limit') - pure b) + pure (b, subSelect $ from (table @BookmarkTag) >>= \t -> do + where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) + groupBy (t ^. BookmarkTagBookmarkId) + orderBy [asc (t ^. BookmarkTagSeq)] + pure $ sqlite_group_concat (t ^. BookmarkTagTag) (val " "))) where _whereClause b = do where_ $ foldl (\expr tag -> - expr &&. (E.exists $ -- each tag becomes an exists constraint + expr &&. (exists $ -- each tag becomes an exists constraint from (table @BookmarkTag) >>= \t -> - where_ (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId &&. - (t ^. BookmarkTagTag `E.like` val tag)))) - (b ^. BookmarkUserId E.==. val userId) + where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId &&. + (t ^. BookmarkTagTag `like` val tag)))) + (b ^. BookmarkUserId ==. val userId) tags case sharedp of SharedAll -> pure () - SharedPublic -> where_ (b ^. BookmarkShared E.==. val True) - SharedPrivate -> where_ (b ^. BookmarkShared E.==. val False) + SharedPublic -> where_ (b ^. BookmarkShared ==. val True) + SharedPrivate -> where_ (b ^. BookmarkShared ==. val False) case filterp of FilterAll -> pure () - FilterUnread -> where_ (b ^. BookmarkToRead E.==. val True) - FilterStarred -> where_ (b ^. BookmarkSelected E.==. val True) - FilterSingle slug -> where_ (b ^. BookmarkSlug E.==. val slug) + FilterUnread -> where_ (b ^. BookmarkToRead ==. val True) + FilterStarred -> where_ (b ^. BookmarkSelected ==. val True) + FilterSingle slug -> where_ (b ^. BookmarkSlug ==. val slug) FilterUntagged -> where_ $ notExists $ from (table @BookmarkTag) >>= \t -> where_ $ - t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId + t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId -- search sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery) - toLikeExpr :: E.SqlExpr (Entity Bookmark) -> Text -> E.SqlExpr (E.Value Bool) + toLikeExpr :: SqlExpr (Entity Bookmark) -> Text -> SqlExpr (Value Bool) toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term) where - wild s = (E.%) ++. val s ++. (E.%) - toLikeB field s = b ^. field `E.like` wild s + wild s = (%) ++. val s ++. (%) + toLikeB field s = b ^. field `like` wild s p_allFields = (toLikeB BookmarkHref term) ||. (toLikeB BookmarkDescription term) ||. (toLikeB BookmarkExtended term) ||. - (E.exists $ from (table @BookmarkTag) >>= \t -> where_ $ - (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&. - (t ^. BookmarkTagTag `E.like` (wild term)) + (exists $ from (table @BookmarkTag) >>= \t -> where_ $ + (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) &&. + (t ^. BookmarkTagTag `like` (wild term)) ) p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before where p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText p_title = "title:" *> fmap (toLikeB BookmarkDescription) P.takeText p_description = "description:" *> fmap (toLikeB BookmarkExtended) P.takeText - p_tags = "tags:" *> fmap (\term' -> E.exists $ from (table @BookmarkTag) >>= \t -> where_ $ - (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&. - (t ^. BookmarkTagTag `E.like` wild term')) P.takeText - p_after = "after:" *> fmap ((b ^. BookmarkTime E.>=.) . val) (parseTimeText =<< P.takeText) - p_before = "before:" *> fmap ((b ^. BookmarkTime E.<=.) . val) (parseTimeText =<< P.takeText) + p_tags = "tags:" *> fmap (\term' -> exists $ from (table @BookmarkTag) >>= \t -> where_ $ + (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) &&. + (t ^. BookmarkTagTag `like` wild term')) P.takeText + p_after = "after:" *> fmap ((b ^. BookmarkTime >=.) . val) (parseTimeText =<< P.takeText) + p_before = "before:" *> fmap ((b ^. BookmarkTime <=.) . val) (parseTimeText =<< P.takeText) + +-- returns a list of pair of bookmark with tags merged into a string +allUserBookmarks :: Key User -> DB [(Entity Bookmark, Text)] +allUserBookmarks user = + (fmap . fmap . fmap) (fromMaybe "" . unValue) $ + select $ do + b <- from (table @Bookmark) + where_ (b ^. BookmarkUserId ==. val user) + orderBy [asc (b ^. BookmarkTime)] + pure (b, subSelect $ from (table @BookmarkTag) >>= \t -> do + where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) + groupBy (t ^. BookmarkTagBookmarkId) + orderBy [asc (t ^. BookmarkTagSeq)] + pure $ sqlite_group_concat (t ^. BookmarkTagTag) (val " ")) + parseSearchQuery :: - (Text -> E.SqlExpr (E.Value Bool)) + (Text -> SqlExpr (Value Bool)) -> Text - -> Maybe (E.SqlQuery ()) + -> Maybe (SqlQuery ()) parseSearchQuery toExpr = fmap where_ . either (const Nothing) Just . P.parseOnly andE where @@ -260,32 +277,24 @@ parseTimeText t = , "%s" -- 1535932800 ] -tagsQuery :: [Entity Bookmark] -> DB [Entity BookmarkTag] -tagsQuery bmarks = - select $ do - t <- from (table @BookmarkTag) - where_ (t ^. BookmarkTagBookmarkId `in_` valList (fmap entityKey bmarks)) - orderBy [asc (t ^. BookmarkTagSeq)] - pure t - withTags :: Key Bookmark -> DB [Entity BookmarkTag] -withTags key = selectList [BookmarkTagBookmarkId ==. key] [Asc BookmarkTagSeq] +withTags key = selectList [BookmarkTagBookmarkId CP.==. key] [Asc BookmarkTagSeq] -- Note List Query getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note)) getNote userKey slug = - selectFirst [NoteUserId ==. userKey, NoteSlug ==. slug] [] + selectFirst [NoteUserId CP.==. userKey, NoteSlug CP.==. slug] [] getNoteList :: Key User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [Entity Note]) getNoteList key mquery sharedp limit' page = (,) -- total count - <$> fmap (sum . fmap E.unValue) + <$> fmap (sum . fmap unValue) (select $ do b <- from (table @Note) _whereClause b - pure $ E.countRows) + pure $ countRows) <*> (select $ do b <- from (table @Note) _whereClause b @@ -295,26 +304,26 @@ getNoteList key mquery sharedp limit' page = pure b) where _whereClause b = do - where_ $ (b ^. NoteUserId E.==. val key) + where_ $ (b ^. NoteUserId ==. val key) -- search sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery) case sharedp of SharedAll -> pure () - SharedPublic -> where_ (b ^. NoteShared E.==. val True) - SharedPrivate -> where_ (b ^. NoteShared E.==. val False) + SharedPublic -> where_ (b ^. NoteShared ==. val True) + SharedPrivate -> where_ (b ^. NoteShared ==. val False) - toLikeExpr :: E.SqlExpr (Entity Note) -> Text -> E.SqlExpr (E.Value Bool) + toLikeExpr :: SqlExpr (Entity Note) -> Text -> SqlExpr (Value Bool) toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term) where - wild s = (E.%) ++. val s ++. (E.%) - toLikeN field s = b ^. field `E.like` wild s + wild s = (%) ++. val s ++. (%) + toLikeN field s = b ^. field `like` wild s p_allFields = toLikeN NoteTitle term ||. toLikeN NoteText term p_onefield = p_title <|> p_text <|> p_after <|> p_before where p_title = "title:" *> fmap (toLikeN NoteTitle) P.takeText p_text = "description:" *> fmap (toLikeN NoteText) P.takeText - p_after = "after:" *> fmap ((b ^. NoteCreated E.>=.) . val) (parseTimeText =<< P.takeText) - p_before = "before:" *> fmap ((b ^. NoteCreated E.<=.) . val) (parseTimeText =<< P.takeText) + p_after = "after:" *> fmap ((b ^. NoteCreated >=.) . val) (parseTimeText =<< P.takeText) + p_before = "before:" *> fmap ((b ^. NoteCreated <=.) . val) (parseTimeText =<< P.takeText) -- Bookmark Files @@ -462,32 +471,6 @@ getFileBookmarks user = do marks <- allUserBookmarks user pure $ fmap (\(bm, t) -> bookmarkTofileBookmark (entityVal bm) t) marks --- returns a list of pair of bookmark with tags merged into a string -allUserBookmarks :: Key User -> DB [(Entity Bookmark, Text)] -allUserBookmarks user = do - bmarks <- bquery - tags <- tquery - let tagmap = MS.fromList tags - pure $ (\bm@(Entity bid _) -> (bm, findWithDefault mempty bid tagmap)) <$> bmarks - where - bquery :: DB [Entity Bookmark] - bquery = - select $ do - b <- from (table @Bookmark) - where_ (b ^. BookmarkUserId E.==. val user) - orderBy [asc (b ^. BookmarkTime)] - pure b - tquery :: DB [(Key Bookmark, Text)] - tquery = - fmap (\(tid, tags) -> (E.unValue tid, E.unValue tags)) <$> - (select $ do - t <- from (table @BookmarkTag) - where_ (t ^. BookmarkTagUserId E.==. val user) - E.groupBy (t ^. BookmarkTagBookmarkId) - let tags = sqlite_group_concat (t ^. BookmarkTagTag) (E.val " ") - pure (t ^. BookmarkTagBookmarkId, tags)) - - data TagCloudMode = TagCloudModeTop Bool Int -- { mode: "top", value: 200 } | TagCloudModeLowerBound Bool Int -- { mode: "lowerBound", value: 20 } @@ -539,46 +522,46 @@ type Tag = Text tagCountTop :: Key User -> Int -> DB [(Text, Int)] tagCountTop user top = sortOn (toLower . fst) . - fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> + fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$> ( select $ do t <- from (table @BookmarkTag) - where_ (t ^. BookmarkTagUserId E.==. val user) - E.groupBy (E.lower_ $ t ^. BookmarkTagTag) - let countRows' = E.countRows - E.orderBy [E.desc countRows'] - E.limit ((fromIntegral . toInteger) top) + where_ (t ^. BookmarkTagUserId ==. val user) + groupBy (lower_ $ t ^. BookmarkTagTag) + let countRows' = countRows + orderBy [desc countRows'] + limit ((fromIntegral . toInteger) top) pure $ (t ^. BookmarkTagTag, countRows') ) tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)] tagCountLowerBound user lowerBound = - fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> + fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$> ( select $ do t <- from (table @BookmarkTag) - where_ (t ^. BookmarkTagUserId E.==. val user) - E.groupBy (E.lower_ $ t ^. BookmarkTagTag) - let countRows' = E.countRows - E.orderBy [E.asc (t ^. BookmarkTagTag)] - E.having (countRows' E.>=. E.val lowerBound) + where_ (t ^. BookmarkTagUserId ==. val user) + groupBy (lower_ $ t ^. BookmarkTagTag) + let countRows' = countRows + orderBy [asc (t ^. BookmarkTagTag)] + having (countRows' >=. val lowerBound) pure $ (t ^. BookmarkTagTag, countRows') ) tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)] tagCountRelated user tags = - fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> + fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$> ( select $ do t <- from (table @BookmarkTag) where_ $ foldl (\expr tag -> - expr &&. (E.exists $ do + expr &&. (exists $ do u <- from (table @BookmarkTag) - where_ (u ^. BookmarkTagBookmarkId E.==. t ^. BookmarkTagBookmarkId &&. - (u ^. BookmarkTagTag `E.like` val tag)))) - (t ^. BookmarkTagUserId E.==. val user) + where_ (u ^. BookmarkTagBookmarkId ==. t ^. BookmarkTagBookmarkId &&. + (u ^. BookmarkTagTag `like` val tag)))) + (t ^. BookmarkTagUserId ==. val user) tags - E.groupBy (E.lower_ $ t ^. BookmarkTagTag) - let countRows' = E.countRows - E.orderBy [E.asc $ E.lower_ $ (t ^. BookmarkTagTag)] + groupBy (lower_ $ t ^. BookmarkTagTag) + let countRows' = countRows + orderBy [asc $ lower_ $ (t ^. BookmarkTagTag)] pure $ (t ^. BookmarkTagTag, countRows') ) @@ -664,20 +647,20 @@ instance ToJSON BookmarkForm where toJSON = A.genericToJSON gDefaultFormOptions gDefaultFormOptions :: A.Options gDefaultFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 } -toBookmarkFormList :: [Entity Bookmark] -> [Entity BookmarkTag] -> [BookmarkForm] -toBookmarkFormList bs as = do - b <- bs - let bid = E.entityKey b - let btags = filter ((==) bid . bookmarkTagBookmarkId . E.entityVal) as - pure $ _toBookmarkForm (b, btags) +toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm] +toBookmarkFormList = fmap _toBookmarkForm' _toBookmarkForm :: (Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm -_toBookmarkForm (Entity bid Bookmark {..}, tags) = +_toBookmarkForm (bm, tags) = + _toBookmarkForm' (bm, Just $ unwords $ fmap (bookmarkTagTag . entityVal) tags) + +_toBookmarkForm' :: (Entity Bookmark, Maybe Text) -> BookmarkForm +_toBookmarkForm' (Entity bid Bookmark {..}, tags) = BookmarkForm { _url = bookmarkHref , _title = Just bookmarkDescription , _description = Just $ Textarea $ bookmarkExtended - , _tags = Just $ unwords $ fmap (bookmarkTagTag . entityVal) tags + , _tags = Just $ fromMaybe "" tags , _private = Just $ not bookmarkShared , _toread = Just $ bookmarkToRead , _bid = Just $ unBookmarkKey $ bid @@ -687,6 +670,7 @@ _toBookmarkForm (Entity bid Bookmark {..}, tags) = , _archiveUrl = bookmarkArchiveHref } + _toBookmark :: UserId -> BookmarkForm -> IO Bookmark _toBookmark userId BookmarkForm {..} = do time <- liftIO getCurrentTime @@ -739,7 +723,7 @@ upsertBookmark userId mbid bm tags = do deleteTags bid pure (Updated, bid) deleteTags bid = - deleteWhere [BookmarkTagBookmarkId ==. bid] + deleteWhere [BookmarkTagBookmarkId CP.==. bid] insertTags userId' bid' = for_ (zip [1 ..] tags) $ \(i, tag) -> void $ insert $ BookmarkTag userId' tag bid' i @@ -747,7 +731,7 @@ upsertBookmark userId mbid bm tags = do updateBookmarkArchiveUrl :: Key User -> Key Bookmark -> Maybe Text -> DB () updateBookmarkArchiveUrl userId bid marchiveUrl = do updateWhere - [BookmarkUserId ==. userId, BookmarkId ==. bid] + [BookmarkUserId CP.==. userId, BookmarkId CP.==. bid] [BookmarkArchiveHref CP.=. marchiveUrl] upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult, Key Note)