Permalink
Browse files

paginate directory by letters

  • Loading branch information...
1 parent e956d63 commit ce4e2fd1b40708df7c18cf7597680302b01d26b8 @astro committed Mar 22, 2013
Showing with 161 additions and 30 deletions.
  1. +68 −24 Handler/Directory.hs
  2. +34 −4 Model.hs
  3. +21 −1 PathPieces.hs
  4. +6 −1 README.md
  5. +1 −0 config/routes
  6. +31 −0 static/style.css
View
@@ -2,6 +2,8 @@ module Handler.Directory where
import Data.List
import qualified Data.ByteString.Char8 as BC
+import Data.Char (toLower, isAlpha)
+import qualified Data.Text as T
import PathPieces
import qualified Model
@@ -11,8 +13,8 @@ import Handler.Browse (renderFeedsList, addFeedsLinks)
getDirectoryR :: Handler RepHtml
getDirectoryR = do
- dir <- groupDirectory `fmap` withDB (Model.getDirectory)
- --let (dir1, dir2) = splitAt ((length dir + 1) `div` 2) dir
+ pages <- groupUsers `fmap` withDB Model.getActiveUsers
+ liftIO $ putStrLn $ "pages: " ++ show (map fst pages)
defaultLayout $ do
setTitleI MsgTitleDirectory
addFilterScript
@@ -23,26 +25,73 @@ getDirectoryR = do
[whamlet|$newline always
<h2>_{MsgHeadingDirectory}
^{renderFeedsList links}
+ <section .directory>
+ $forall page <- pages
+ ^{renderLetter page}
+ |]
+ where renderLetter (letter, users) =
+ [hamlet|$newline always
+ <article class="directory-page">
+ <p class="letter">
+ <a href="@{DirectoryPageR letter}">
+ #{show letter}
+ <ul class="users">
+ $forall u <- users
+ <li xml:lang="#{Model.activeFeedLangs u}"
+ data-types="#{Model.activeFeedTypes u}">
+ <a href="@{UserR $ Model.activeUser u}">
+ #{T.unpack $ Model.userName $ Model.activeUser u}
+ <span .feedcount>
+ (#{Model.activeFeeds u})
+ |]
+
+
+groupUsers :: [(Model.ActiveUser)] -> [(DirectoryPage, [Model.ActiveUser])]
+groupUsers [] = []
+groupUsers (u:us) =
+ let getLetter u' =
+ case T.unpack $ userName $ activeUser u' of
+ c:_ | isAlpha c ->
+ DirectoryLetter $ toLower c
+ _ ->
+ DirectoryDigit
+ letter = getLetter u
+ (us', us'') = break ((letter /=) . getLetter) us
+ in (letter, (u : us')) : groupUsers us''
+
+getDirectoryPageR :: DirectoryPage -> Handler RepHtml
+getDirectoryPageR page = do
+ dir <- groupDirectory `fmap` withDB (Model.getDirectory $ Just page)
+ defaultLayout $ do
+ setTitleI MsgTitleDirectory
+ addFilterScript
+ [whamlet|$newline always
+ <h2>_{MsgHeadingDirectory}: #{show page}
<section class="directory">
- ^{renderEntries dir}
+ $forall es <- dir
+ ^{renderEntry es}
|]
- where renderEntries entries =
+ where renderEntry es =
[hamlet|$newline always
- $forall es <- entries
- <article class="meta">
- <img class="logo"
- src="@{UserThumbnailR (Model.dirUser $ head es) (Thumbnail 64)}">
- <div class="title">
- <h3>
- <a href="@{UserR $ Model.dirUser $ head es}">#{Model.dirUserTitle $ head es}
- <ul class="feeds">
- $forall e <- es
- <li xml:lang="#{Model.dirFeedLang e}"
- data-types="#{Model.dirFeedTypes e}">
- <a href="@{UserFeedR (Model.dirUser e) (Model.dirFeedSlug e)}">
- #{Model.dirFeedTitle e}
+ <article class="meta">
+ <img class="logo"
+ src="@{UserThumbnailR (Model.dirUser $ head es) (Thumbnail 64)}">
+ <div class="title">
+ <h3>
+ <a href="@{UserR $ Model.dirUser $ head es}">#{Model.dirUserTitle $ head es}
+ <ul class="feeds">
+ $forall e <- es
+ <li xml:lang="#{Model.dirFeedLang e}"
+ data-types="#{Model.dirFeedTypes e}">
+ <a href="@{UserFeedR (Model.dirUser e) (Model.dirFeedSlug e)}">
+ #{Model.dirFeedTitle e}
|]
+groupDirectory :: [Model.DirectoryEntry] -> [[Model.DirectoryEntry]]
+groupDirectory = groupBy $
+ \e1 e2 ->
+ Model.dirUser e1 == Model.dirUser e2
+
typeOpml :: ContentType
typeOpml = "text/x-opml"
@@ -55,7 +104,7 @@ instance HasReps RepOpml where
getDirectoryOpmlR :: Handler RepOpml
getDirectoryOpmlR = do
- dir <- groupDirectory `fmap` withDB (Model.getDirectory)
+ dir <- groupDirectory `fmap` withDB (Model.getDirectory Nothing)
url <- getFullUrlRender
RepOpml `fmap`
hamletToContent [xhamlet|$newline always
@@ -72,9 +121,4 @@ getDirectoryOpmlR = do
htmlUrl="#{url $ UserFeedR (Model.dirUser e) (Model.dirFeedSlug e)}"
xmlUrl="#{url $ MapFeedR (Model.dirUser e) (Model.dirFeedSlug e)}">
|]
-
-
-groupDirectory :: [Model.DirectoryEntry] -> [[Model.DirectoryEntry]]
-groupDirectory = groupBy $
- \e1 e2 ->
- Model.dirUser e1 == Model.dirUser e2
+
View
@@ -5,6 +5,8 @@ module Model (
Torrent (..),
torrentByName,
purgeTorrent,
+ ActiveUser (..),
+ getActiveUsers,
DirectoryEntry (..),
getDirectory,
-- Model.Query
@@ -77,6 +79,7 @@ import Model.Feed
import Model.User
import Model.Token
import Model.Stats
+import PathPieces (DirectoryPage (..))
infoHashByName :: UserName -> Text -> Text -> Query InfoHash
@@ -110,7 +113,26 @@ purgeTorrent user slug name db =
quickQuery' db "SELECT * FROM purge_download(?, ?, ?)"
[toSql user, toSql slug, toSql name]
-
+data ActiveUser = ActiveUser
+ { activeUser :: UserName
+ , activeFeeds :: Int
+ , activeFeedLangs :: Text
+ , activeFeedTypes :: Text
+ } deriving (Show, Typeable)
+
+instance Convertible [SqlValue] ActiveUser where
+ safeConvert (userVal:feedsVal:langsVal:typesVal:[]) =
+ ActiveUser <$>
+ safeFromSql userVal <*>
+ safeFromSql feedsVal <*>
+ safeFromSql langsVal <*>
+ safeFromSql typesVal
+ safeConvert vals = convError "ActiveUser" vals
+
+getActiveUsers :: Query ActiveUser
+getActiveUsers =
+ query "SELECT \"user\", \"feeds\", array_to_string(\"langs\", ','), array_to_string(\"types\", ',') FROM active_users" []
+
data DirectoryEntry = DirectoryEntry
{ dirUser :: UserName
, dirUserTitle :: Text
@@ -134,7 +156,15 @@ instance Convertible [SqlValue] DirectoryEntry where
safeFromSql feedTypesVal
safeConvert vals = convError "DirectoryEntry" vals
-getDirectory :: Query DirectoryEntry
-getDirectory =
- query "SELECT \"user\", COALESCE(\"title\", \"user\"), COALESCE(\"image\", ''), \"slug\", COALESCE(\"feed_title\", \"slug\"), COALESCE(\"lang\", ''), array_to_string(\"types\", ',') FROM directory" []
+getDirectory :: Maybe DirectoryPage -> Query DirectoryEntry
+getDirectory mPage =
+ let (cond, params) =
+ case mPage of
+ Nothing ->
+ ("", [])
+ Just DirectoryDigit ->
+ (" WHERE \"user\" ~* E'^[^a-z]'", [])
+ Just (DirectoryLetter c) ->
+ (" WHERE LOWER(LEFT(\"user\", 1)) = ?", [toSql [c]])
+ in query ("SELECT \"user\", COALESCE(\"title\", \"user\"), COALESCE(\"image\", ''), \"slug\", COALESCE(\"feed_title\", \"slug\"), COALESCE(\"lang\", ''), array_to_string(\"types\", ',') FROM directory" ++ cond) params
View
@@ -5,6 +5,7 @@ module PathPieces where
import Prelude
import Yesod (PathPiece (..))
import qualified Data.Text as T
+import Data.Char
import Utils
import Model.User
@@ -101,4 +102,23 @@ instance PathPiece Thumbnail where
, s
, ".png"
]
-
+
+data DirectoryPage = DirectoryDigit
+ | DirectoryLetter Char
+ deriving (Ord, Eq, Read)
+
+instance Show DirectoryPage where
+ show (DirectoryLetter c) = [toUpper c]
+ show DirectoryDigit = "#"
+
+instance PathPiece DirectoryPage where
+ fromPathPiece c =
+ case T.unpack c of
+ [c] | isAlpha c ->
+ Just $ DirectoryLetter c
+ "0-9" ->
+ Just DirectoryDigit
+ _ ->
+ Nothing
+ toPathPiece (DirectoryLetter c) = T.singleton c
+ toPathPiece DirectoryDigit = "0-9"
View
@@ -37,7 +37,12 @@ Now point your browser to `http://localhost:8081/`.
## TODO
-* Filter for directory
+* Paginated directory
+* Filter for directory?
+
+* GET .torrent stats
+* event=complete heuristics
+
* Per-item pages
* MapFeed content-type
* URL longener?
View
@@ -35,6 +35,7 @@
/widget/powerpress.js WidgetPowerpressR GET
/directory DirectoryR GET
+/directory/#DirectoryPage DirectoryPageR GET
/directory.opml DirectoryOpmlR GET
/#UserName UserR GET
View
@@ -820,6 +820,37 @@ ul.feeds li {
.directory .meta .title { margin-bottom: 1em; }
.directory h3 { text-align: left; }
+.directory .letter {
+ float: left;
+ width: 1em;
+ height: 1em;
+ font-family: "Patua One";
+ text-align: center;
+ font-size: 3em;
+ line-height: 1em;
+ padding: 0;
+ margin: 0;
+}
+.directory .letter a {
+ color: black;
+}
+.directory .letter a:hover {
+ color: #1067B9;
+ text-decoration: none;
+}
+.directory .users {
+ text-align: left;
+ margin: 0 0 0 2em;
+ min-height: 3.3em;
+}
+.directory .users li {
+ display: inline-block;
+ list-style-type: none;
+ margin: 0.1em 1em 0.2em 0;
+}
+.directory .feedcount {
+ color: #666;
+}
/***************************************************************************
* FILTER (BUTTON/DIALOG) SECTION
***************************************************************************/

0 comments on commit ce4e2fd

Please sign in to comment.