fix bug wto show multiple versions in metadata

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

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

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