mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-12 04:08:29 +01:00
51 lines
2.0 KiB
Haskell
51 lines
2.0 KiB
Haskell
module Handler.PackageList where
|
|
|
|
import qualified Data.HashMap.Strict as M
|
|
import Data.Time (NominalDiffTime, addUTCTime)
|
|
import qualified Database.Esqueleto as E
|
|
import Import
|
|
import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT)
|
|
|
|
-- FIXME maybe just redirect to the LTS or nightly package list
|
|
getPackageListR :: Handler Html
|
|
getPackageListR = defaultLayout $ do
|
|
setTitle "Package list"
|
|
cachedWidget (20 * 60) "package-list" $ do
|
|
let clean (x, y) =
|
|
( E.unValue x
|
|
, strip $ E.unValue y
|
|
)
|
|
addDocs (x, y) = (x, Nothing, y, Nothing)
|
|
packages <- fmap (map addDocs . uniqueByKey . map clean) $ handlerToWidget $ runDB $
|
|
E.selectDistinct $ E.from $ \(u,m) -> do
|
|
E.where_ (m E.^. MetadataName E.==. u E.^. UploadedName)
|
|
E.orderBy [E.asc $ u E.^. UploadedName]
|
|
return $ (u E.^. UploadedName
|
|
,m E.^. MetadataSynopsis)
|
|
$(widgetFile "package-list")
|
|
where strip x = fromMaybe x (stripSuffix "." x)
|
|
uniqueByKey = sortBy (comparing fst) . M.toList . M.fromList
|
|
mback = Nothing
|
|
|
|
-- FIXME move somewhere else, maybe even yesod-core
|
|
cachedWidget :: NominalDiffTime -> Text -> Widget -> Widget
|
|
cachedWidget _diff _key widget = do
|
|
-- Temporarily disabled, seems to be eating up too much memory
|
|
widget
|
|
{-
|
|
ref <- widgetCache <$> getYesod
|
|
now <- liftIO getCurrentTime
|
|
mpair <- lookup key <$> readIORef ref
|
|
case mpair of
|
|
Just (expires, gw) | expires > now -> do
|
|
$logDebug "Using cached widget"
|
|
WidgetT $ \_ -> return ((), gw)
|
|
_ -> do
|
|
$logDebug "Not using cached widget"
|
|
WidgetT $ \hd -> do
|
|
((), gw) <- unWidgetT widget hd
|
|
-- FIXME render the builders in gw for more efficiency
|
|
atomicModifyIORef' ref $ \m -> (insertMap key (addUTCTime diff now, gw) m, ())
|
|
return ((), gw)
|
|
-}
|