diff --git a/Application.hs b/Application.hs index 1c2a961..78870f6 100644 --- a/Application.hs +++ b/Application.hs @@ -8,14 +8,10 @@ module Application import qualified Aws import Control.Concurrent (forkIO, threadDelay) import Control.Monad.Logger (runLoggingT, LoggingT) -import Control.Monad.Reader (runReaderT, ReaderT) import Control.Monad.Reader (MonadReader (..)) import Control.Monad.Trans.Control import Data.BlobStore (fileStore, storeWrite, cachedS3Store) import Data.Conduit.Lazy (MonadActive, monadActive) -import qualified Database.Esqueleto as E -import Data.Hackage -import Data.Hackage.Views import Data.Time (diffUTCTime) import qualified Database.Persist import Filesystem (getModified, removeTree) diff --git a/Handler/PackageList.hs b/Handler/PackageList.hs index 08c3e63..76630d1 100644 --- a/Handler/PackageList.hs +++ b/Handler/PackageList.hs @@ -1,15 +1,19 @@ module Handler.PackageList where -import Import +import qualified Data.HashMap.Strict as M +import Data.Time (NominalDiffTime, addUTCTime) import qualified Database.Esqueleto as E -import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT) -import Data.Time (NominalDiffTime, addUTCTime) +import Import +import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT) getPackageListR :: Handler Html getPackageListR = do - names <- fmap (map E.unValue) $ runDB $ E.selectDistinct $ E.from $ \u -> do - E.orderBy [E.asc $ u E.^. UploadedName] - return $ u E.^. UploadedName + packages <- fmap (uniqueByKey . map (E.unValue***strip . E.unValue)) $ 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) defaultLayout $ do setTitle "Package list" $(combineStylesheets 'StaticR @@ -17,6 +21,8 @@ getPackageListR = do , css_bootstrap_responsive_css ]) cachedWidget (5 * 60) "package-list" $(widgetFile "package-list") + where strip x = fromMaybe x (stripSuffix "." x) + uniqueByKey = sortBy (comparing fst) . M.toList . M.fromList -- FIXME move somewhere else, maybe even yesod-core cachedWidget :: NominalDiffTime -> Text -> Widget -> Widget diff --git a/templates/package-list.hamlet b/templates/package-list.hamlet index 287b253..977da28 100644 --- a/templates/package-list.hamlet +++ b/templates/package-list.hamlet @@ -1,9 +1,15 @@
| Package + | Synopsis + | + $forall (name,synopsis) <- packages +
|---|---|
| + + #{name} + | + #{synopsis} diff --git a/templates/package-list.lucius b/templates/package-list.lucius new file mode 100644 index 0000000..54a842d --- /dev/null +++ b/templates/package-list.lucius @@ -0,0 +1,5 @@ +.packages { + .table th, .table td { + padding-left: 0; + } +} |