yogsototh/espial
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

always get tags via subquery instead of separate query

Browse source
This commit is contained in:
Jon Schoning 2021-07-24 20:21:13 -05:00
parent c98030139b
commit 6545aaea17
2 changed files with 127 additions and 154 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
src/Handler/User.hs
View file

@ -6,7 +6,6 @@ import Handler.Common
import Import import Import
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
import Yesod.RssFeed import Yesod.RssFeed
import qualified Database.Esqueleto.Experimental as E
import qualified Data.Map as Map import qualified Data.Map as Map
getUserR :: UserNameP -> Handler Html getUserR :: UserNameP -> Handler Html
@ -40,14 +39,11 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
queryp = "query" :: Text queryp = "query" :: Text
mquery <- lookupGetParam queryp mquery <- lookupGetParam queryp
let mqueryp = fmap (\q -> (queryp, q)) mquery let mqueryp = fmap (\q -> (queryp, q)) mquery
(bcount, bmarks, alltags) <- (bcount, btmarks) <- runDB $ do
runDB $ Entity userId user <- getBy404 (UniqueUserName uname)
do Entity userId user <- getBy404 (UniqueUserName uname)
when (not isowner && userPrivacyLock user) when (not isowner && userPrivacyLock user)
(redirect (AuthR LoginR)) (redirect (AuthR LoginR))
(cnt, bm) <- bookmarksQuery userId sharedp filterp pathtags mquery limit page bookmarksTagsQuery userId sharedp filterp pathtags mquery limit page
tg <- tagsQuery bm
pure (cnt, bm, tg)
when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ()) when (bcount == 0) (case filterp of FilterSingle _ -> notFound; _ -> pure ())
mroute <- getCurrentRoute mroute <- getCurrentRoute
tagCloudMode <- getTagCloudMode isowner pathtags tagCloudMode <- getTagCloudMode isowner pathtags
@ -60,14 +56,18 @@ _getUser unamep@(UserNameP uname) sharedp' filterp' (TagsP pathtags) = do
rssLink (UserFeedR unamep) "feed" rssLink (UserFeedR unamep) "feed"
$(widgetFile "user") $(widgetFile "user")
toWidgetBody [julius| toWidgetBody [julius|
app.dat.bmarks = #{ toJSON $ toBookmarkFormList bmarks alltags } || []; app.dat.bmarks = #{ toJSON $ toBookmarkFormList btmarks } || [];
app.dat.isowner = #{ isowner }; app.dat.isowner = #{ isowner };
app.userR = "@{UserR unamep}"; app.userR = "@{UserR unamep}";
app.tagCloudMode = #{ toJSON $ tagCloudMode } || {}; app.tagCloudMode = #{ toJSON $ tagCloudMode } || {};
|] |]
toWidget [julius| toWidget [julius|
PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)(); setTimeout(() => {
PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)(); PS['Main'].renderBookmarks('##{rawJS renderEl}')(app.dat.bmarks)();
}, 0);
setTimeout(() => {
PS['Main'].renderTagCloud('##{rawJS tagCloudRenderEl}')(app.tagCloudMode)();
}, 0);
|] |]
-- Form -- Form
@ -98,24 +98,17 @@ _updateTagCloudMode mode =
TagCloudModeRelated _ _ -> setTagCloudMode mode TagCloudModeRelated _ _ -> setTagCloudMode mode
TagCloudModeNone -> notFound TagCloudModeNone -> notFound
bookmarkToRssEntry :: (Entity Bookmark, [Text]) -> FeedEntry Text bookmarkToRssEntry :: (Entity Bookmark, Maybe Text) -> FeedEntry Text
bookmarkToRssEntry ((Entity entryId entry), tags) = bookmarkToRssEntry ((Entity entryId entry), tags) =
FeedEntry FeedEntry
{ feedEntryLink = bookmarkHref entry { feedEntryLink = bookmarkHref entry
, feedEntryUpdated = bookmarkTime entry , feedEntryUpdated = bookmarkTime entry
, feedEntryTitle = bookmarkDescription entry , feedEntryTitle = bookmarkDescription entry
, feedEntryContent = toHtml (bookmarkExtended entry) , feedEntryContent = toHtml (bookmarkExtended entry)
, feedEntryCategories = map (EntryCategory Nothing Nothing) tags , feedEntryCategories = map (EntryCategory Nothing Nothing) (maybe [] words tags)
, feedEntryEnclosure = Nothing , 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 :: UserNameP -> Handler RepRss
getUserFeedR unamep@(UserNameP uname) = do getUserFeedR unamep@(UserNameP uname) = do
mauthuname <- maybeAuthUsername mauthuname <- maybeAuthUsername
@ -125,17 +118,13 @@ getUserFeedR unamep@(UserNameP uname) = do
queryp = "query" :: Text queryp = "query" :: Text
isowner = maybe False (== uname) mauthuname isowner = maybe False (== uname) mauthuname
mquery <- lookupGetParam queryp mquery <- lookupGetParam queryp
(_, bmarks, alltags) <- (_, btmarks) <- runDB $ do
runDB $ Entity userId user <- getBy404 (UniqueUserName uname)
do Entity userId user <- getBy404 (UniqueUserName uname)
when (not isowner && userPrivacyLock user) when (not isowner && userPrivacyLock user)
(redirect (AuthR LoginR)) (redirect (AuthR LoginR))
(cnt, bm) <- bookmarksQuery userId SharedPublic FilterAll [] mquery limit page bookmarksTagsQuery userId SharedPublic FilterAll [] mquery limit page
tg <- tagsQuery bm
pure (cnt, bm, tg)
let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname) let (descr :: Html) = toHtml $ H.text ("Bookmarks saved by " <> uname)
entriesWithTags = toBookmarkWithTagsList bmarks alltags entries = map bookmarkToRssEntry btmarks
entries = map bookmarkToRssEntry entriesWithTags
updated <- case maximumMay (map feedEntryUpdated entries) of updated <- case maximumMay (map feedEntryUpdated entries) of
Nothing -> liftIO $ getCurrentTime Nothing -> liftIO $ getCurrentTime
Just m -> return m Just m -> return m

238
src/Model.hs
View file

@ -3,27 +3,25 @@
module Model where module Model where
import qualified ClassyPrelude.Yesod as CP 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 as A
import qualified Data.Aeson.Types as A (parseFail) import qualified Data.Aeson.Types as A (parseFail)
import qualified Data.Attoparsec.Text as P import qualified Data.Attoparsec.Text as P
import qualified Control.Monad.Combinators as PC import qualified Data.Time as TI (ParseTime)
import qualified Data.List.NonEmpty as NE import qualified Data.Time.Clock.POSIX as TI (posixSecondsToUTCTime, POSIXTime)
import qualified Data.Time.ISO8601 as TI import qualified Data.Time.ISO8601 as TI (parseISO8601, formatISO8601Millis)
import qualified Data.Time.Clock.POSIX as TI import ClassyPrelude.Yesod hiding ((==.), (||.), on, Value, groupBy, exists, (>=.), (<=.))
import qualified Database.Esqueleto.Experimental as E import Control.Monad.Fail (MonadFail)
import qualified Database.Esqueleto.Internal.Internal as E (exists, unsafeSqlFunction) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import qualified Data.Time as TI
import ClassyPrelude.Yesod hiding ((||.))
import Control.Monad.Trans.Maybe
import Control.Monad.Writer (tell) import Control.Monad.Writer (tell)
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.Either (fromRight) import Data.Either (fromRight)
import Data.Foldable (foldl, foldl1, sequenceA_) import Data.Foldable (foldl, foldl1, sequenceA_)
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty(..))
import Database.Esqueleto.Experimental hiding ((==.)) import Database.Esqueleto.Experimental
import Pretty import Database.Esqueleto.Internal.Internal (unsafeSqlFunction)
import System.Directory import Pretty ()
import System.Directory (listDirectory)
import Types import Types
import qualified Data.Map.Strict as MS import qualified Data.Map.Strict as MS
@ -142,10 +140,10 @@ migrateIndexes =
sqlite_group_concat :: sqlite_group_concat ::
PersistField a PersistField a
=> SqlExpr (E.Value a) => SqlExpr (Value a)
-> SqlExpr (E.Value a) -> SqlExpr (Value a)
-> SqlExpr (E.Value Text) -> SqlExpr (Value Text)
sqlite_group_concat expr sep = E.unsafeSqlFunction "GROUP_CONCAT" [expr, sep] sqlite_group_concat expr sep = unsafeSqlFunction "GROUP_CONCAT" [expr, sep]
authenticatePassword :: Text -> Text -> DB (Maybe (Entity User)) authenticatePassword :: Text -> Text -> DB (Maybe (Entity User))
authenticatePassword username password = do authenticatePassword username password = do
@ -159,9 +157,10 @@ authenticatePassword username password = do
getUserByName :: UserNameP -> DB (Maybe (Entity User)) getUserByName :: UserNameP -> DB (Maybe (Entity User))
getUserByName (UserNameP uname) = do 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 :: Key User
-> SharedP -> SharedP
-> FilterP -> FilterP
@ -169,74 +168,92 @@ bookmarksQuery
-> Maybe Text -> Maybe Text
-> Limit -> Limit
-> Page -> Page
-> DB (Int, [Entity Bookmark]) -> DB (Int, [(Entity Bookmark, Maybe Text)])
bookmarksQuery userId sharedp filterp tags mquery limit' page = bookmarksTagsQuery userId sharedp filterp tags mquery limit' page =
(,) -- total count (,) -- total count
<$> fmap (sum . fmap E.unValue) <$> fmap (sum . fmap unValue)
(select $ do (select $ from (table @Bookmark) >>= \b -> do
b <- from $ table @Bookmark
_whereClause b _whereClause b
pure E.countRows) pure countRows)
-- paged data -- paged data
<*> (select $ do <*> (fmap . fmap . fmap) unValue
b <- from $ table @Bookmark (select $ from (table @Bookmark) >>= \b -> do
_whereClause b _whereClause b
orderBy [desc (b ^. BookmarkTime)] orderBy [desc (b ^. BookmarkTime)]
limit limit' limit limit'
offset ((page - 1) * 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 where
_whereClause b = do _whereClause b = do
where_ $ where_ $
foldl (\expr tag -> foldl (\expr tag ->
expr &&. (E.exists $ -- each tag becomes an exists constraint expr &&. (exists $ -- each tag becomes an exists constraint
from (table @BookmarkTag) >>= \t -> from (table @BookmarkTag) >>= \t ->
where_ (t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId &&. where_ (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId &&.
(t ^. BookmarkTagTag `E.like` val tag)))) (t ^. BookmarkTagTag `like` val tag))))
(b ^. BookmarkUserId E.==. val userId) (b ^. BookmarkUserId ==. val userId)
tags tags
case sharedp of case sharedp of
SharedAll -> pure () SharedAll -> pure ()
SharedPublic -> where_ (b ^. BookmarkShared E.==. val True) SharedPublic -> where_ (b ^. BookmarkShared ==. val True)
SharedPrivate -> where_ (b ^. BookmarkShared E.==. val False) SharedPrivate -> where_ (b ^. BookmarkShared ==. val False)
case filterp of case filterp of
FilterAll -> pure () FilterAll -> pure ()
FilterUnread -> where_ (b ^. BookmarkToRead E.==. val True) FilterUnread -> where_ (b ^. BookmarkToRead ==. val True)
FilterStarred -> where_ (b ^. BookmarkSelected E.==. val True) FilterStarred -> where_ (b ^. BookmarkSelected ==. val True)
FilterSingle slug -> where_ (b ^. BookmarkSlug E.==. val slug) FilterSingle slug -> where_ (b ^. BookmarkSlug ==. val slug)
FilterUntagged -> where_ $ notExists $ from (table @BookmarkTag) >>= \t -> where_ $ FilterUntagged -> where_ $ notExists $ from (table @BookmarkTag) >>= \t -> where_ $
t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId
-- search -- search
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery) 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) toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term)
where where
wild s = (E.%) ++. val s ++. (E.%) wild s = (%) ++. val s ++. (%)
toLikeB field s = b ^. field `E.like` wild s toLikeB field s = b ^. field `like` wild s
p_allFields = p_allFields =
(toLikeB BookmarkHref term) ||. (toLikeB BookmarkHref term) ||.
(toLikeB BookmarkDescription term) ||. (toLikeB BookmarkDescription term) ||.
(toLikeB BookmarkExtended term) ||. (toLikeB BookmarkExtended term) ||.
(E.exists $ from (table @BookmarkTag) >>= \t -> where_ $ (exists $ from (table @BookmarkTag) >>= \t -> where_ $
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&. (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) &&.
(t ^. BookmarkTagTag `E.like` (wild term)) (t ^. BookmarkTagTag `like` (wild term))
) )
p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before p_onefield = p_url <|> p_title <|> p_description <|> p_tags <|> p_after <|> p_before
where where
p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText p_url = "url:" *> fmap (toLikeB BookmarkHref) P.takeText
p_title = "title:" *> fmap (toLikeB BookmarkDescription) P.takeText p_title = "title:" *> fmap (toLikeB BookmarkDescription) P.takeText
p_description = "description:" *> fmap (toLikeB BookmarkExtended) P.takeText p_description = "description:" *> fmap (toLikeB BookmarkExtended) P.takeText
p_tags = "tags:" *> fmap (\term' -> E.exists $ from (table @BookmarkTag) >>= \t -> where_ $ p_tags = "tags:" *> fmap (\term' -> exists $ from (table @BookmarkTag) >>= \t -> where_ $
(t ^. BookmarkTagBookmarkId E.==. b ^. BookmarkId) &&. (t ^. BookmarkTagBookmarkId ==. b ^. BookmarkId) &&.
(t ^. BookmarkTagTag `E.like` wild term')) P.takeText (t ^. BookmarkTagTag `like` wild term')) P.takeText
p_after = "after:" *> fmap ((b ^. BookmarkTime E.>=.) . val) (parseTimeText =<< P.takeText) p_after = "after:" *> fmap ((b ^. BookmarkTime >=.) . val) (parseTimeText =<< P.takeText)
p_before = "before:" *> fmap ((b ^. BookmarkTime E.<=.) . 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 :: parseSearchQuery ::
(Text -> E.SqlExpr (E.Value Bool)) (Text -> SqlExpr (Value Bool))
-> Text -> Text
-> Maybe (E.SqlQuery ()) -> Maybe (SqlQuery ())
parseSearchQuery toExpr = parseSearchQuery toExpr =
fmap where_ . either (const Nothing) Just . P.parseOnly andE fmap where_ . either (const Nothing) Just . P.parseOnly andE
where where
@ -260,32 +277,24 @@ parseTimeText t =
, "%s" -- 1535932800 , "%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 Bookmark -> DB [Entity BookmarkTag]
withTags key = selectList [BookmarkTagBookmarkId ==. key] [Asc BookmarkTagSeq] withTags key = selectList [BookmarkTagBookmarkId CP.==. key] [Asc BookmarkTagSeq]
-- Note List Query -- Note List Query
getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note)) getNote :: Key User -> NtSlug -> DB (Maybe (Entity Note))
getNote userKey slug = 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 User -> Maybe Text -> SharedP -> Limit -> Page -> DB (Int, [Entity Note])
getNoteList key mquery sharedp limit' page = getNoteList key mquery sharedp limit' page =
(,) -- total count (,) -- total count
<$> fmap (sum . fmap E.unValue) <$> fmap (sum . fmap unValue)
(select $ do (select $ do
b <- from (table @Note) b <- from (table @Note)
_whereClause b _whereClause b
pure $ E.countRows) pure $ countRows)
<*> (select $ do <*> (select $ do
b <- from (table @Note) b <- from (table @Note)
_whereClause b _whereClause b
@ -295,26 +304,26 @@ getNoteList key mquery sharedp limit' page =
pure b) pure b)
where where
_whereClause b = do _whereClause b = do
where_ $ (b ^. NoteUserId E.==. val key) where_ $ (b ^. NoteUserId ==. val key)
-- search -- search
sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery) sequenceA_ (parseSearchQuery (toLikeExpr b) =<< mquery)
case sharedp of case sharedp of
SharedAll -> pure () SharedAll -> pure ()
SharedPublic -> where_ (b ^. NoteShared E.==. val True) SharedPublic -> where_ (b ^. NoteShared ==. val True)
SharedPrivate -> where_ (b ^. NoteShared E.==. val False) 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) toLikeExpr b term = fromRight p_allFields (P.parseOnly p_onefield term)
where where
wild s = (E.%) ++. val s ++. (E.%) wild s = (%) ++. val s ++. (%)
toLikeN field s = b ^. field `E.like` wild s toLikeN field s = b ^. field `like` wild s
p_allFields = toLikeN NoteTitle term ||. toLikeN NoteText term p_allFields = toLikeN NoteTitle term ||. toLikeN NoteText term
p_onefield = p_title <|> p_text <|> p_after <|> p_before p_onefield = p_title <|> p_text <|> p_after <|> p_before
where where
p_title = "title:" *> fmap (toLikeN NoteTitle) P.takeText p_title = "title:" *> fmap (toLikeN NoteTitle) P.takeText
p_text = "description:" *> fmap (toLikeN NoteText) P.takeText p_text = "description:" *> fmap (toLikeN NoteText) P.takeText
p_after = "after:" *> fmap ((b ^. NoteCreated E.>=.) . val) (parseTimeText =<< P.takeText) p_after = "after:" *> fmap ((b ^. NoteCreated >=.) . val) (parseTimeText =<< P.takeText)
p_before = "before:" *> fmap ((b ^. NoteCreated E.<=.) . val) (parseTimeText =<< P.takeText) p_before = "before:" *> fmap ((b ^. NoteCreated <=.) . val) (parseTimeText =<< P.takeText)
-- Bookmark Files -- Bookmark Files
@ -462,32 +471,6 @@ getFileBookmarks user = do
marks <- allUserBookmarks user marks <- allUserBookmarks user
pure $ fmap (\(bm, t) -> bookmarkTofileBookmark (entityVal bm) t) marks 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 data TagCloudMode
= TagCloudModeTop Bool Int -- { mode: "top", value: 200 } = TagCloudModeTop Bool Int -- { mode: "top", value: 200 }
| TagCloudModeLowerBound Bool Int -- { mode: "lowerBound", value: 20 } | TagCloudModeLowerBound Bool Int -- { mode: "lowerBound", value: 20 }
@ -539,46 +522,46 @@ type Tag = Text
tagCountTop :: Key User -> Int -> DB [(Text, Int)] tagCountTop :: Key User -> Int -> DB [(Text, Int)]
tagCountTop user top = tagCountTop user top =
sortOn (toLower . fst) . sortOn (toLower . fst) .
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
( select $ do ( select $ do
t <- from (table @BookmarkTag) t <- from (table @BookmarkTag)
where_ (t ^. BookmarkTagUserId E.==. val user) where_ (t ^. BookmarkTagUserId ==. val user)
E.groupBy (E.lower_ $ t ^. BookmarkTagTag) groupBy (lower_ $ t ^. BookmarkTagTag)
let countRows' = E.countRows let countRows' = countRows
E.orderBy [E.desc countRows'] orderBy [desc countRows']
E.limit ((fromIntegral . toInteger) top) limit ((fromIntegral . toInteger) top)
pure $ (t ^. BookmarkTagTag, countRows') pure $ (t ^. BookmarkTagTag, countRows')
) )
tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)] tagCountLowerBound :: Key User -> Int -> DB [(Text, Int)]
tagCountLowerBound user lowerBound = tagCountLowerBound user lowerBound =
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
( select $ do ( select $ do
t <- from (table @BookmarkTag) t <- from (table @BookmarkTag)
where_ (t ^. BookmarkTagUserId E.==. val user) where_ (t ^. BookmarkTagUserId ==. val user)
E.groupBy (E.lower_ $ t ^. BookmarkTagTag) groupBy (lower_ $ t ^. BookmarkTagTag)
let countRows' = E.countRows let countRows' = countRows
E.orderBy [E.asc (t ^. BookmarkTagTag)] orderBy [asc (t ^. BookmarkTagTag)]
E.having (countRows' E.>=. E.val lowerBound) having (countRows' >=. val lowerBound)
pure $ (t ^. BookmarkTagTag, countRows') pure $ (t ^. BookmarkTagTag, countRows')
) )
tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)] tagCountRelated :: Key User -> [Tag] -> DB [(Text, Int)]
tagCountRelated user tags = tagCountRelated user tags =
fmap (\(tname, tcount) -> (E.unValue tname, E.unValue tcount)) <$> fmap (\(tname, tcount) -> (unValue tname, unValue tcount)) <$>
( select $ do ( select $ do
t <- from (table @BookmarkTag) t <- from (table @BookmarkTag)
where_ $ where_ $
foldl (\expr tag -> foldl (\expr tag ->
expr &&. (E.exists $ do expr &&. (exists $ do
u <- from (table @BookmarkTag) u <- from (table @BookmarkTag)
where_ (u ^. BookmarkTagBookmarkId E.==. t ^. BookmarkTagBookmarkId &&. where_ (u ^. BookmarkTagBookmarkId ==. t ^. BookmarkTagBookmarkId &&.
(u ^. BookmarkTagTag `E.like` val tag)))) (u ^. BookmarkTagTag `like` val tag))))
(t ^. BookmarkTagUserId E.==. val user) (t ^. BookmarkTagUserId ==. val user)
tags tags
E.groupBy (E.lower_ $ t ^. BookmarkTagTag) groupBy (lower_ $ t ^. BookmarkTagTag)
let countRows' = E.countRows let countRows' = countRows
E.orderBy [E.asc $ E.lower_ $ (t ^. BookmarkTagTag)] orderBy [asc $ lower_ $ (t ^. BookmarkTagTag)]
pure $ (t ^. BookmarkTagTag, countRows') pure $ (t ^. BookmarkTagTag, countRows')
) )
@ -664,20 +647,20 @@ instance ToJSON BookmarkForm where toJSON = A.genericToJSON gDefaultFormOptions
gDefaultFormOptions :: A.Options gDefaultFormOptions :: A.Options
gDefaultFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 } gDefaultFormOptions = A.defaultOptions { A.fieldLabelModifier = drop 1 }
toBookmarkFormList :: [Entity Bookmark] -> [Entity BookmarkTag] -> [BookmarkForm] toBookmarkFormList :: [(Entity Bookmark, Maybe Text)] -> [BookmarkForm]
toBookmarkFormList bs as = do toBookmarkFormList = fmap _toBookmarkForm'
b <- bs
let bid = E.entityKey b
let btags = filter ((==) bid . bookmarkTagBookmarkId . E.entityVal) as
pure $ _toBookmarkForm (b, btags)
_toBookmarkForm :: (Entity Bookmark, [Entity BookmarkTag]) -> BookmarkForm _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 BookmarkForm
{ _url = bookmarkHref { _url = bookmarkHref
, _title = Just bookmarkDescription , _title = Just bookmarkDescription
, _description = Just $ Textarea $ bookmarkExtended , _description = Just $ Textarea $ bookmarkExtended
, _tags = Just $ unwords $ fmap (bookmarkTagTag . entityVal) tags , _tags = Just $ fromMaybe "" tags
, _private = Just $ not bookmarkShared , _private = Just $ not bookmarkShared
, _toread = Just $ bookmarkToRead , _toread = Just $ bookmarkToRead
, _bid = Just $ unBookmarkKey $ bid , _bid = Just $ unBookmarkKey $ bid
@ -687,6 +670,7 @@ _toBookmarkForm (Entity bid Bookmark {..}, tags) =
, _archiveUrl = bookmarkArchiveHref , _archiveUrl = bookmarkArchiveHref
} }
_toBookmark :: UserId -> BookmarkForm -> IO Bookmark _toBookmark :: UserId -> BookmarkForm -> IO Bookmark
_toBookmark userId BookmarkForm {..} = do _toBookmark userId BookmarkForm {..} = do
time <- liftIO getCurrentTime time <- liftIO getCurrentTime
@ -739,7 +723,7 @@ upsertBookmark userId mbid bm tags = do
deleteTags bid deleteTags bid
pure (Updated, bid) pure (Updated, bid)
deleteTags bid = deleteTags bid =
deleteWhere [BookmarkTagBookmarkId ==. bid] deleteWhere [BookmarkTagBookmarkId CP.==. bid]
insertTags userId' bid' = insertTags userId' bid' =
for_ (zip [1 ..] tags) $ for_ (zip [1 ..] tags) $
\(i, tag) -> void $ insert $ BookmarkTag userId' tag bid' i \(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 :: Key User -> Key Bookmark -> Maybe Text -> DB ()
updateBookmarkArchiveUrl userId bid marchiveUrl = do updateBookmarkArchiveUrl userId bid marchiveUrl = do
updateWhere updateWhere
[BookmarkUserId ==. userId, BookmarkId ==. bid] [BookmarkUserId CP.==. userId, BookmarkId CP.==. bid]
[BookmarkArchiveHref CP.=. marchiveUrl] [BookmarkArchiveHref CP.=. marchiveUrl]
upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult, Key Note) upsertNote :: Key User -> Maybe (Key Note) -> Note -> DB (UpsertResult, Key Note)