haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-05 23:57:28 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Better caching of package list

Browse Source
This commit is contained in:
Michael Snoyman 2014-11-17 12:22:20 +02:00
parent ae05eaf8fd
commit aae52c21e9
1 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
Handler/PackageList.hs
View File

@ -7,16 +7,16 @@ import Import
import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT) import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT)
getPackageListR :: Handler Html getPackageListR :: Handler Html
getPackageListR = do getPackageListR = defaultLayout $ do
packages <- fmap (uniqueByKey . map (E.unValue***strip . E.unValue)) $ runDB $ setTitle "Package list"
E.selectDistinct $ E.from $ \(u,m) -> do cachedWidget (20 * 60) "package-list" $ do
E.where_ (m E.^. MetadataName E.==. u E.^. UploadedName) packages <- fmap (uniqueByKey . map (E.unValue***strip . E.unValue)) $ handlerToWidget $ runDB $
E.orderBy [E.asc $ u E.^. UploadedName] E.selectDistinct $ E.from $ \(u,m) -> do
return $ (u E.^. UploadedName E.where_ (m E.^. MetadataName E.==. u E.^. UploadedName)
,m E.^. MetadataSynopsis) E.orderBy [E.asc $ u E.^. UploadedName]
defaultLayout $ do return $ (u E.^. UploadedName
setTitle "Package list" ,m E.^. MetadataSynopsis)
cachedWidget (5 * 60) "package-list" $(widgetFile "package-list") $(widgetFile "package-list")
where strip x = fromMaybe x (stripSuffix "." x) where strip x = fromMaybe x (stripSuffix "." x)
uniqueByKey = sortBy (comparing fst) . M.toList . M.fromList uniqueByKey = sortBy (comparing fst) . M.toList . M.fromList