Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-04-02 04:53:07 +00:00
Code Issues Packages Projects Releases Wiki Activity

reprganize database calls and marketplaces types

Browse Source
This commit is contained in:
Lucy Cifferello
2021-11-24 18:20:32 -07:00
parent b8a84f540a
commit 1610c8c9fd
5 changed files with 199 additions and 185 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
src/Database/Marketplace.hs
View File

@@ -15,8 +15,6 @@ import Database.Esqueleto.Experimental
, (&&.)
, (++.)
, (==.)
, Entity(entityKey, entityVal)
, SqlBackend
, (^.)
, desc
, from
@@ -31,12 +29,15 @@ import Database.Esqueleto.Experimental
, valList
, where_
, (||.)
, Value(unValue)
)
import Database.Esqueleto.Experimental
( (:&)(..)
, table
)
import Lib.Types.AppIndex ( PkgId )
import Lib.Types.AppIndex ( VersionInfo(..)
, PkgId
)
import Lib.Types.Category
import Lib.Types.Emver ( Version
, VersionRange
@@ -47,6 +48,14 @@ import Startlude hiding ( (%)
, on
, yield
)
import qualified Data.HashMap.Internal.Strict as HM
import Handler.Types.Marketplace ( ReleaseNotes(ReleaseNotes) )
import qualified Database.Persist as P
import Database.Persist.Postgresql
hiding ( (||.)
, selectSource
, (==.)
)
searchServices :: (MonadResource m, MonadIO m)
=> Maybe CategoryTitle
@@ -112,3 +121,50 @@ filterOsCompatible :: Monad m
filterOsCompatible p = awaitForever $ \(app, versions, requestedVersion) -> do
let compatible = filter (p . versionRecordOsVersion . entityVal) versions
when (not $ null compatible) $ yield (app, compatible, requestedVersion)
fetchAllAppVersions :: MonadUnliftIO m => ConnectionPool -> PkgId -> m ([VersionInfo], ReleaseNotes)
fetchAllAppVersions appConnPool appId = do
entityAppVersions <- runSqlPool (P.selectList [VersionRecordPkgId P.==. PkgRecordKey appId] []) appConnPool
let vers = entityVal <$> entityAppVersions
let vv = mapSVersionToVersionInfo vers
let mappedVersions = ReleaseNotes $ HM.fromList $ (\v -> (versionInfoVersion v, versionInfoReleaseNotes v)) <$> vv
pure $ (sortOn (Down . versionInfoVersion) vv, mappedVersions)
where
mapSVersionToVersionInfo :: [VersionRecord] -> [VersionInfo]
mapSVersionToVersionInfo sv = do
(\v -> VersionInfo { versionInfoVersion = versionRecordNumber v
, versionInfoReleaseNotes = versionRecordReleaseNotes v
, versionInfoDependencies = HM.empty
, versionInfoOsVersion = versionRecordOsVersion v
, versionInfoInstallAlert = Nothing
}
)
<$> sv
fetchLatestApp :: MonadIO m => PkgId -> ReaderT SqlBackend m (Maybe (P.Entity PkgRecord, P.Entity VersionRecord))
fetchLatestApp appId = fmap headMay . sortResults . select $ do
(service :& version) <-
from
$ table @PkgRecord
`innerJoin` table @VersionRecord
`on` (\(service :& version) -> service ^. PkgRecordId ==. version ^. VersionRecordPkgId)
where_ (service ^. PkgRecordId ==. val (PkgRecordKey appId))
pure (service, version)
where sortResults = fmap $ sortOn (Down . versionRecordNumber . entityVal . snd)
fetchAppCategories :: MonadIO m => [PkgId] -> ReaderT SqlBackend m (HM.HashMap PkgId [Category])
fetchAppCategories appIds = do
raw <- select $ do
(sc :& app :& cat) <-
from
$ table @PkgCategory
`innerJoin` table @PkgRecord
`on` (\(sc :& app) -> sc ^. PkgCategoryPkgId ==. app ^. PkgRecordId)
`innerJoin` table @Category
`on` (\(sc :& _ :& cat) -> sc ^. PkgCategoryCategoryId ==. cat ^. CategoryId)
where_ (sc ^. PkgCategoryPkgId `in_` valList (PkgRecordKey <$> appIds))
pure (app ^. PkgRecordId, cat)
let ls = fmap (first (unPkgRecordKey . unValue) . second (pure . entityVal)) raw
pure $ HM.fromListWith (++) ls