Package list restyle (closes #18)

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)

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

templates/package-list.hamlet

@@ -1,9 +1,15 @@
 <div .container>
-    <div .alert .alert-warn>
-        <b>NOTHING TO SEE HERE MOVE ALONG
-        We'll announce when this is ready
-    <ul>
-        $forall name <- names
-            <li>
-                <a href=@{PackageR name}>#{name}
-                <b>FIXME SYNOPSIS
+    <h1>Packages
+    <div .packages>
+        <table .table>
+            <thead>
+                <th>Package
+                <th>Synopsis
+            <tbody>
+                $forall (name,synopsis) <- packages
+                    <tr>
+                        <td>
+                            <a href=@{PackageR name}>
+                                #{name}
+                        <td>
+                            #{synopsis}

templates/package-list.lucius

@@ -0,0 +1,5 @@
+.packages {
+  .table th, .table td {
+    padding-left: 0;
+  }
+}