diff --git a/Handler/PackageList.hs b/Handler/PackageList.hs index 7c93fd3..18e264e 100644 --- a/Handler/PackageList.hs +++ b/Handler/PackageList.hs @@ -1,52 +1,13 @@ module Handler.PackageList where -import qualified Data.HashMap.Strict as M -import Data.Time (NominalDiffTime) -import qualified Database.Esqueleto as E -import Import +import Import +import Stackage.Database -- FIXME maybe just redirect to the LTS or nightly package list getPackageListR :: Handler Html getPackageListR = defaultLayout $ do - error "getPackageListR" - {- 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 $ \m -> do - E.orderBy [E.asc $ m E.^. MetadataName] - return $ (m E.^. MetadataName - ,m E.^. MetadataSynopsis) - $(widgetFile "package-list") + packages <- getAllPackages + $(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) - -} - -} diff --git a/Stackage/Database.hs b/Stackage/Database.hs index 504ae03..b88fc58 100644 --- a/Stackage/Database.hs +++ b/Stackage/Database.hs @@ -9,6 +9,7 @@ module Stackage.Database , lookupSnapshot , snapshotTitle , PackageListingInfo (..) + , getAllPackages , getPackages , createStackageDatabase , openStackageDatabase @@ -390,6 +391,18 @@ prettyName name ghc = SNLts x y -> concat ["LTS Haskell ", tshow x, ".", tshow y] SNNightly d -> "Stackage Nightly " ++ tshow d +getAllPackages :: GetStackageDatabase m => m [(Text, Text, Text)] +getAllPackages = liftM (map toPair) $ run $ do + E.select $ E.from $ \p -> do + E.orderBy [E.asc $ p E.^. PackageName] + return + ( p E.^. PackageName + , p E.^. PackageLatest + , p E.^. PackageSynopsis + ) + where + toPair (E.Value x, E.Value y, E.Value z) = (x, y, z) + data PackageListingInfo = PackageListingInfo { pliName :: !Text , pliVersion :: !Text diff --git a/templates/package-list.hamlet b/templates/package-list.hamlet index 6365a88..1099140 100644 --- a/templates/package-list.hamlet +++ b/templates/package-list.hamlet @@ -1,24 +1,14 @@
- #{asText backText}
Package
- Docs
Synopsis
- $forall (name,mversion,synopsis,mdoc) <- packages
+ $forall (name, version, synopsis) <- packages
-
- #{name}
- $maybe version <- mversion
- -#{asText version}
+ #{name}-#{version}
- $maybe doc <- mdoc
- Docs
-
- #{synopsis}
+ #{strip synopsis}