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

Package list restyle (closes #18)

Browse Source
This commit is contained in:
Chris Done 2014-11-13 15:51:48 +01:00
parent d705d63073
commit 8f0e0e7aa3
4 changed files with 31 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Application.hs
View File

@ -8,14 +8,10 @@ module Application
import qualified Aws import qualified Aws
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
import Control.Monad.Logger (runLoggingT, LoggingT) import Control.Monad.Logger (runLoggingT, LoggingT)
import Control.Monad.Reader (runReaderT, ReaderT)
import Control.Monad.Reader (MonadReader (..)) import Control.Monad.Reader (MonadReader (..))
import Control.Monad.Trans.Control import Control.Monad.Trans.Control
import Data.BlobStore (fileStore, storeWrite, cachedS3Store) import Data.BlobStore (fileStore, storeWrite, cachedS3Store)
import Data.Conduit.Lazy (MonadActive, monadActive) import Data.Conduit.Lazy (MonadActive, monadActive)
import qualified Database.Esqueleto as E
import Data.Hackage
import Data.Hackage.Views
import Data.Time (diffUTCTime) import Data.Time (diffUTCTime)
import qualified Database.Persist import qualified Database.Persist
import Filesystem (getModified, removeTree) import Filesystem (getModified, removeTree)

18
Handler/PackageList.hs
View File

@ -1,15 +1,19 @@
module Handler.PackageList where 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 qualified Database.Esqueleto as E
import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT) import Import
import Data.Time (NominalDiffTime, addUTCTime) import Yesod.Core.Types (WidgetT (WidgetT), unWidgetT)
getPackageListR :: Handler Html getPackageListR :: Handler Html
getPackageListR = do getPackageListR = do
names <- fmap (map E.unValue) $ runDB $ E.selectDistinct $ E.from $ \u -> do packages <- fmap (uniqueByKey . map (E.unValue***strip . E.unValue)) $ 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)
E.orderBy [E.asc $ u E.^. UploadedName]
return $ (u E.^. UploadedName
,m E.^. MetadataSynopsis)
defaultLayout $ do defaultLayout $ do
setTitle "Package list" setTitle "Package list"
$(combineStylesheets 'StaticR $(combineStylesheets 'StaticR
@ -17,6 +21,8 @@ getPackageListR = do
, css_bootstrap_responsive_css , css_bootstrap_responsive_css
]) ])
cachedWidget (5 * 60) "package-list" $(widgetFile "package-list") 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 -- FIXME move somewhere else, maybe even yesod-core
cachedWidget :: NominalDiffTime -> Text -> Widget -> Widget cachedWidget :: NominalDiffTime -> Text -> Widget -> Widget

22
templates/package-list.hamlet
View File

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

5
templates/package-list.lucius Normal file
View File

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