10 random users on homepage

commercialhaskell · Oct 11, 2010 · 29e9127 · 29e9127
1 parent 1e498cc
commit 29e9127
Show file tree

Hide file tree

Showing 10 changed files with 135 additions and 73 deletions.
diff --git a/API.markdown b/API.markdown
@@ -2,6 +2,8 @@ This site runs on a RESTful API. Content is available as JSON. In order to acces
 
 ## http://www.haskellers.com/users/
 
+FIXME: This API is in flux right now, my appologies
+
 This returns a list of all publicly-viewable user accounts. The response is a JSON map with one attribute: users. users is a JSON list, each element an array with three elements: id is the numerical ID of the account, name is the user's full name and url is the user's Haskeller URL (the next resource pattern).
 
 ## http://www.haskellers.com/user/*id*

diff --git a/Controller.hs b/Controller.hs
@@ -9,6 +9,10 @@ import Settings
 import Yesod.Helpers.Static
 import Yesod.Helpers.Auth2
 import Database.Persist.GenericSql
+import Data.IORef
+import Control.Concurrent (forkIO, threadDelay)
+import Control.Monad (forever)
+import Data.Maybe (mapMaybe)
 
 -- Import all relevant handler modules here.
 import Handler.Root
@@ -45,7 +49,31 @@ withHaskellers f = Settings.withConnectionPool $ \p -> do
         migrate (undefined :: UserSkill)
         migrate (undefined :: Package)
         migrate (undefined :: Message)
-    let h = Haskellers s p
+    iprofs <- newIORef []
+    _ <- forkIO $ fillProfs p iprofs
+    let h = Haskellers s p iprofs
     toWaiApp h >>= f
   where
     s = fileLookupDir Settings.staticdir typeByExt
+
+getHomepageProfs pool = flip runConnectionPool pool $ do
+    users <-
+        selectList [ UserVerifiedEmailEq True
+                   , UserVisibleEq True
+                   , UserRealEq True
+                   , UserBlockedEq False
+                   -- FIXME , UserRealPicEq True
+                   ] [] 0 0
+    return $ flip mapMaybe users $ \(uid, u) ->
+        case userEmail u of
+            Nothing -> Nothing
+            Just e -> Just Profile
+                { profileUserId = uid
+                , profileName = userFullName u
+                , profileEmail = e
+                }
+
+fillProfs pool iprofs = forever $ do
+    profs <- getHomepageProfs pool
+    writeIORef iprofs profs
+    threadDelay $ 1000 * 1000 * 60 * 5
diff --git a/Handler/Root.hs b/Handler/Root.hs
@@ -1,11 +1,18 @@
 {-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
-module Handler.Root where
+module Handler.Root
+    ( getRootR
+    , getUsersR
+    , gravatar
+    ) where
 
 import Haskellers
 import qualified Data.ByteString.Lazy.UTF8 as L
 import Data.Digest.Pure.MD5 (md5)
 import Data.Char (toLower, isSpace)
 import Data.Maybe (fromMaybe)
+import System.Random (newStdGen)
+import System.Random.Shuffle (shuffle')
+import Data.IORef (readIORef)
 
 -- This is a handler function for the GET request method on the RootR
 -- resource pattern. All of your resource patterns are defined in
@@ -16,6 +23,10 @@ import Data.Maybe (fromMaybe)
 -- inclined, or create a single monolithic file.
 getRootR :: Handler RepHtml
 getRootR = do
+    y <- getYesod
+    allProfs <- liftIO $ readIORef $ homepageProfiles y
+    gen <- liftIO newStdGen
+    let profs = take 10 $ shuffle' allProfs (length allProfs) gen
     mu <- maybeAuth
     (public, private, unver) <- runDB $ do
         public <- count [ UserVerifiedEmailEq True
@@ -30,14 +41,27 @@ getRootR = do
                             , UserBlockedEq False
                             ]
         return (public, private, unverified)
+    defaultLayout $ do
+        setTitle "Haskellers"
+        addStyle $(cassiusFile "homepage")
+        addStyle $(cassiusFile "users")
+        $(hamletFile "homepage")
+
+getUsersR :: Handler RepHtmlJson
+getUsersR = do
     mpage <- runFormGet' $ maybeIntInput "page"
     let page = fromMaybe 0 mpage
     let perPage = 10
     let hasPrev = page > 0
+    public <- runDB $ count
+        [ UserVerifiedEmailEq True
+        , UserVisibleEq True
+        , UserBlockedEq False
+        ]
     let maxPage = (public - 1) `div` perPage
     let hasNext = page < maxPage
-    let next = (RootR, [("page", show $ page + 1)])
-    let prev = (RootR, [("page", show $ page - 1)])
+    let next = (UsersR, [("page", show $ page + 1)])
+    let prev = (UsersR, [("page", show $ page - 1)])
     let minHaskeller = page * perPage + 1
     users <- runDB $ selectList [ UserVerifiedEmailEq True
                                 , UserVisibleEq True
@@ -48,27 +72,18 @@ getRootR = do
                                 , UserFullNameAsc
                                 ] perPage (perPage * page)
     let maxHaskeller = minHaskeller + length users - 1
-    defaultLayout $ do
-        setTitle "Haskellers"
-        addStyle $(cassiusFile "homepage")
-        $(hamletFile "homepage")
-  where
-    fakeEmail = "fake@email.com"
-
-getUsersR :: Handler RepJson
-getUsersR = do
-    users <- runDB $ selectList [ UserVerifiedEmailEq True
-                                , UserVisibleEq True
-                                ] [UserFullNameAsc] 0 0
     render <- getUrlRender
-    jsonToRepJson $ json render users
+    flip defaultLayoutJson (json render users) $ do
+        addStyle $(cassiusFile "users")
+        $(hamletFile "users")
   where
     json r users = jsonMap [("users", jsonList $ map (json' r) users)]
     json' r (uid, u) = jsonMap
         [ ("id", jsonScalar $ showIntegral uid)
         , ("name", jsonScalar $ userFullName u)
         , ("url", jsonScalar $ r $ UserR uid)
         ]
+    fakeEmail = "fake@email.com"
 
 gravatar :: Int -> String -> String
 gravatar s x =

diff --git a/Haskellers.hs b/Haskellers.hs
@@ -13,6 +13,7 @@ module Haskellers
     , AuthRoute (..)
     , showIntegral
     , login
+    , Profile (..)
     ) where
 
 import Yesod
@@ -30,6 +31,7 @@ import Model
 import StaticFiles (logo_png, jquery_ui_css, google_png, yahoo_png,
                     openid_icon_small_gif, facebook_png)
 import Yesod.Form.Jquery
+import Data.IORef (IORef)
 
 -- | The site argument for your application. This can be a good place to
 -- keep settings and values requiring initialization before your application
@@ -38,6 +40,13 @@ import Yesod.Form.Jquery
 data Haskellers = Haskellers
     { getStatic :: Static -- ^ Settings for static file serving.
     , connPool :: Settings.ConnectionPool -- ^ Database connection pool.
+    , homepageProfiles :: IORef [Profile]
+    }
+
+data Profile = Profile
+    { profileUserId :: UserId
+    , profileName :: String
+    , profileEmail :: String
     }
 
 -- | A useful synonym; most of the handler functions in your application

diff --git a/Model.hs b/Model.hs
@@ -42,7 +42,7 @@ User
     haskellSince Int null Asc
     desc Textarea null id=desc
     visible Bool default=true Eq
-    real Bool default=false update Desc
+    real Bool default=false update Desc Eq
     admin Bool default=false update
     employment Employment null
     blocked Bool update Eq default=false

diff --git a/cassius/homepage.cassius b/cassius/homepage.cassius
@@ -18,22 +18,3 @@
     padding-top: 15px
     border-top: 1px dashed #0e485a
     text-align: center
-.user
-    display: inline-block
-    vertical-align: top
-.user a
-    display: block
-    width: 120px
-    margin: 5px
-    text-align: center
-    border: 1px solid #aaa
-    background: #eee
-    padding: 10px 3px
-    font-size: 80%
-.user span.name
-    display: block
-.user img
-    border: 0
-    padding-right: 10px
-.note
-    font-style: italic
diff --git a/cassius/users.cassius b/cassius/users.cassius
@@ -0,0 +1,19 @@
+.user
+    display: inline-block
+    vertical-align: top
+.user a
+    display: block
+    width: 120px
+    margin: 5px
+    text-align: center
+    border: 1px solid #aaa
+    background: #eee
+    padding: 10px 3px
+    font-size: 80%
+.user span.name
+    display: block
+.user img
+    border: 0
+    padding-right: 10px
+.note
+    font-style: italic
diff --git a/hamlet/homepage.hamlet b/hamlet/homepage.hamlet
@@ -1,41 +1,27 @@
-$if not.hasPrev
-    #topbar
-        #blurb
-            Haskellers is a centralized place for professional Haskell programmers to publish themselves. If you'd like to create a profile, simply log in on the right. If you are looking for a Haskeller, just continue down the page.
-        #login
-            $maybe mu u
-                %p
-                    You are logged in as
-                    %br
-                    %b $userFullName'.snd.u$
-                    %br
-                    %a!href=@ProfileR@ Edit my Profile
-                    %br
-                    %a!href=@AuthR.LogoutR@ Logout
-            $nothing
-                %h3 Login with
-                ^login^
+#topbar
+    #blurb
+        Haskellers is a centralized place for professional Haskell programmers to publish themselves. If you'd like to create a profile, simply log in on the right. If you are looking for a Haskeller, just continue down the page.
+    #login
+        $maybe mu u
+            %p
+                You are logged in as
+                %br
+                %b $userFullName'.snd.u$
+                %br
+                %a!href=@ProfileR@ Edit my Profile
+                %br
+                %a!href=@AuthR.LogoutR@ Logout
+        $nothing
+            %h3 Login with
+            ^login^
 #users
     .counts
         Total accounts: $show.public$ public, $show.private$ private, $show.unver$ unverified.
-    .controls
-        $if hasPrev
-            %a!href=@?prev@ Previous
-        $else
-            Previous
-        %b
-            \ Viewing Haskellers $show.minHaskeller$-$show.maxHaskeller$ $
-        $if hasNext
-            %a!href=@?next@ Next
-        $else
-            Next
-    $forall users user
+    $forall profs prof
         .user
-            %a!href=@UserR.fst.user@
-                $maybe userEmail.snd.user email
-                    %img!src=$(gravatar.80).email$!alt="Gravatar Profile Picture"
-                $nothing
-                    %img!src=$(gravatar.80).fakeEmail$!alt="Gravatar Profile Picture"
+            %a!href=@UserR.profileUserId.prof@
+                %img!src=$(gravatar.80).profileEmail.prof$!alt="Gravatar Profile Picture"
                 %span.name
-                  $userFullName'.snd.user$
-    .note Note: Haskellers are sorted by years of experience with Haskell. Also, approved accounts are shown first.
+                  $profileName.prof$
+    %p
+        %a!href=@UsersR@ Browse all public Haskellers
diff --git a/hamlet/users.hamlet b/hamlet/users.hamlet
@@ -0,0 +1,21 @@
+.controls
+    $if hasPrev
+        %a!href=@?prev@ Previous
+    $else
+        Previous
+    %b
+        \ Viewing Haskellers $show.minHaskeller$-$show.maxHaskeller$ $
+    $if hasNext
+        %a!href=@?next@ Next
+    $else
+        Next
+$forall users user
+    .user
+        %a!href=@UserR.fst.user@
+            $maybe userEmail.snd.user email
+                %img!src=$(gravatar.80).email$!alt="Gravatar Profile Picture"
+            $nothing
+                %img!src=$(gravatar.80).fakeEmail$!alt="Gravatar Profile Picture"
+            %span.name
+              $userFullName'.snd.user$
+.note Note: Haskellers are sorted by years of experience with Haskell. Also, verified users are shown first.
diff --git a/haskellers.cabal b/haskellers.cabal
@@ -35,6 +35,7 @@ executable         simple-server
                    random,
                    HsOpenSSL,
                    time,
+                   random-shuffle,
                    utf8-string
     ghc-options:   -Wall
     extensions:    TemplateHaskell, QuasiQuotes, TypeFamilies