diff --git a/src/Application.hs b/src/Application.hs index 5a19bbd..d79ce17 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -24,7 +24,7 @@ module Application , getAppSettings -- * for GHCI , handler - ) where + ,db) where import Startlude hiding (Handler) @@ -67,6 +67,8 @@ import Network.HTTP.Types.Header ( hOrigin ) import Data.List (lookup) import Network.Wai.Middleware.RequestLogger.JSON import System.Directory (createDirectoryIfMissing) +import Database.Persist.Sql (SqlBackend) +import Yesod -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the @@ -342,3 +344,7 @@ develMain = do -- | Run a handler handler :: Handler a -> IO a handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h + +-- | Run DB queries +db :: ReaderT SqlBackend (HandlerFor RegistryCtx) a -> IO a +db = handler . runDB \ No newline at end of file diff --git a/src/Handler/Marketplace.hs b/src/Handler/Marketplace.hs index 195d685..dd8833a 100644 --- a/src/Handler/Marketplace.hs +++ b/src/Handler/Marketplace.hs @@ -318,6 +318,66 @@ getPackageListR = do + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + where getPackageDetails :: MonadIO m => (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) @@ -473,7 +533,8 @@ fetchLatestAppAtVersion appId version' = selectOne $ do where_ $ (service ^. SAppAppId ==. val appId) &&. (version ^. SVersionNumber ==. val version') pure (service, version) -fetchPackageMetadata :: MonadUnliftIO m => ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) +fetchPackageMetadata :: (MonadLogger m, MonadUnliftIO m) + => ReaderT SqlBackend m (HM.HashMap AppIdentifier ([Version], [CategoryTitle])) fetchPackageMetadata = do let categoriesQuery = select $ do (service :& category) <- @@ -501,7 +562,8 @@ fetchPackageMetadata = do c = foreach categories $ \(appId, categories') -> (unValue appId, catMaybes $ fromMaybe [] (unValue categories')) let v = foreach versions $ \(appId, versions') -> (unValue appId, fromMaybe [] (unValue versions')) - pure $ HM.intersectionWith (\vers cts -> (vers, cts)) (HM.fromList v) (HM.fromList c) + let vv = HM.fromListWithKey (\_ vers vers' -> (++) vers vers') v + pure $ HM.intersectionWith (\vers cts -> (cts, vers)) (HM.fromList c) vv fetchAppCategories :: MonadIO m => Key SApp -> ReaderT SqlBackend m [P.Entity ServiceCategory] fetchAppCategories appId = select $ do diff --git a/src/Lib/Types/Category.hs b/src/Lib/Types/Category.hs index d302ae9..20aede7 100644 --- a/src/Lib/Types/Category.hs +++ b/src/Lib/Types/Category.hs @@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE DeriveGeneric #-} module Lib.Types.Category where @@ -16,7 +17,7 @@ data CategoryTitle = FEATURED | MESSAGING | SOCIAL | ALTCOIN - deriving (Eq, Enum, Show, Read) + deriving (Eq, Enum, Show, Read, Generic) instance PersistField CategoryTitle where fromPersistValue = fromPersistValueJSON toPersistValue = toPersistValueJSON @@ -46,3 +47,4 @@ instance ToContent CategoryTitle where toContent = toContent . toJSON instance ToTypedContent CategoryTitle where toTypedContent = toTypedContent . toJSON +instance Hashable CategoryTitle