add index and deindex endpoints

This commit is contained in:
Keagan McClelland
2022-05-23 16:16:14 -06:00
parent 729e9bf507
commit 411d186517
8 changed files with 176 additions and 56 deletions

View File

@@ -1,6 +1,7 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveGeneric #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Fuse on/on" #-}
module Database.Marketplace where
@@ -54,24 +55,24 @@ type CategoryTitle = Text
searchServices :: (MonadResource m, MonadIO m)
=> Maybe CategoryTitle
-> Text
-> ConduitT () (Entity PkgRecord) (ReaderT SqlBackend m) ()
-> ConduitT () (Entity VersionRecord) (ReaderT SqlBackend m) ()
searchServices Nothing query = selectSource $ do
service <- from $ table @PkgRecord
service <- from $ table @VersionRecord
where_
( (service ^. PkgRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordTitle `ilike` (%) ++. val query ++. (%))
( (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
)
orderBy [desc (service ^. PkgRecordUpdatedAt)]
orderBy [desc (service ^. VersionRecordUpdatedAt)]
pure service
searchServices (Just category) query = selectSource $ do
services <- from
(do
(service :& _ :& cat) <-
from
$ table @PkgRecord
$ table @VersionRecord
`innerJoin` table @PkgCategory
`on` (\(s :& sc) -> sc ^. PkgCategoryPkgId ==. s ^. PkgRecordId)
`on` (\(s :& sc) -> sc ^. PkgCategoryPkgId ==. s ^. VersionRecordPkgId)
`innerJoin` table @Category
`on` (\(_ :& sc :& cat) -> sc ^. PkgCategoryCategoryId ==. cat ^. CategoryId)
-- if there is a cateogry, only search in category
@@ -80,13 +81,13 @@ searchServices (Just category) query = selectSource $ do
$ cat
^. CategoryName
==. val category
&&. ( (service ^. PkgRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. PkgRecordTitle `ilike` (%) ++. val query ++. (%))
&&. ( (service ^. VersionRecordDescShort `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordDescLong `ilike` (%) ++. val query ++. (%))
||. (service ^. VersionRecordTitle `ilike` (%) ++. val query ++. (%))
)
pure service
)
orderBy [desc (services ^. PkgRecordUpdatedAt)]
orderBy [desc (services ^. VersionRecordUpdatedAt)]
pure services
getPkgData :: (MonadResource m, MonadIO m) => [PkgId] -> ConduitT () (Entity PkgRecord) (ReaderT SqlBackend m) ()
@@ -98,20 +99,19 @@ getPkgData pkgs = selectSource $ do
getPkgDependencyData :: MonadIO m
=> Key PkgRecord
-> Version
-> ReaderT SqlBackend m ([(Entity PkgDependency, Entity PkgRecord)])
-> ReaderT SqlBackend m [(Entity PkgDependency, Entity PkgRecord)]
getPkgDependencyData pkgId pkgVersion = select $ do
pd <- from
from
(do
(pkgDepRecord :& depPkgRecord) <-
from
$ table @PkgDependency
`innerJoin` table @PkgRecord
`on` (\(pdr :& dpr) -> dpr ^. PkgRecordId ==. pdr ^. PkgDependencyDepId)
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. (val pkgId))
where_ (pkgDepRecord ^. PkgDependencyPkgId ==. val pkgId)
where_ (pkgDepRecord ^. PkgDependencyPkgVersion ==. val pkgVersion)
pure (pkgDepRecord, depPkgRecord)
)
pure pd
zipCategories :: MonadUnliftIO m
=> ConduitT
@@ -147,7 +147,7 @@ zipDependencyVersions :: (Monad m, MonadIO m)
=> (Entity PkgDependency, Entity PkgRecord)
-> ReaderT SqlBackend m PackageDependencyMetadata
zipDependencyVersions (pkgDepRecord, depRecord) = do
let pkgDbId = entityKey $ depRecord
let pkgDbId = entityKey depRecord
depVers <- select $ do
v <- from $ table @VersionRecord
where_ $ v ^. VersionRecordPkgId ==. val pkgDbId

View File

@@ -1,15 +1,38 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Database.Queries where
import Database.Persist.Sql
import Lib.Types.AppIndex
import Lib.Types.Emver
import Model
import Database.Persist.Sql ( PersistStoreRead(get)
, PersistStoreWrite(insertKey, insert_, repsert)
, SqlBackend
)
import Lib.Types.AppIndex ( PackageManifest(..)
, PkgId
)
import Lib.Types.Emver ( Version )
import Model ( Key(PkgRecordKey, VersionRecordKey)
, Metric(Metric)
, PkgRecord(PkgRecord)
, VersionRecord(VersionRecord)
)
import Orphans.Emver ( )
import Startlude hiding ( get )
import Startlude ( ($)
, (.)
, ConvertText(toS)
, Maybe(..)
, MonadIO(..)
, ReaderT
, SomeException
, getCurrentTime
, maybe
)
import System.FilePath ( takeExtension )
import UnliftIO ( MonadUnliftIO
, try
)
fetchApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe PkgRecord)
fetchApp = get . PkgRecordKey
@@ -21,3 +44,22 @@ createMetric :: MonadIO m => PkgId -> Version -> ReaderT SqlBackend m ()
createMetric appId version = do
time <- liftIO getCurrentTime
insert_ $ Metric time (PkgRecordKey appId) version
upsertPackageVersion :: (MonadUnliftIO m) => PackageManifest -> ReaderT SqlBackend m ()
upsertPackageVersion PackageManifest {..} = do
now <- liftIO getCurrentTime
let iconType = maybe "png" (toS . takeExtension . toS) packageManifestIcon
let pkgId = PkgRecordKey packageManifestId
let ins = VersionRecord now
(Just now)
pkgId
packageManifestVersion
packageManifestTitle
packageManifestDescriptionShort
packageManifestDescriptionLong
iconType
packageManifestReleaseNotes
packageManifestEosVersion
Nothing
_res <- try @_ @SomeException $ insertKey pkgId (PkgRecord now (Just now))
repsert (VersionRecordKey pkgId packageManifestVersion) ins