adding profile page and prepared upload

This commit is contained in:
nek0 2014-08-12 23:45:33 +02:00
parent cfad7cc3c8
commit 97f72aca36
12 changed files with 53 additions and 8 deletions

View file

@ -31,6 +31,8 @@ import Handler.Home
import Handler.Signup
import Handler.Login
import Handler.Activate
import Handler.Profile
import Handler.Upload
-- This line actually creates our YesodDispatch instance. It is the second half
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the

View file

@ -20,6 +20,7 @@ import Text.Hamlet (hamletFile)
import Yesod.Core.Types (Logger)
-- costom imports
import Data.Maybe
import Data.Text
-- | The site argument for your application. This can be a good place to
-- keep settings and values requiring initialization before your application

View file

@ -1,11 +1,10 @@
module Handler.Activate where
import Import as I
import Data.Text as T
getActivateR :: String -> Handler Html
getActivateR :: Text -> Handler Html
getActivateR token = do
t <- runDB $ selectList [TokenToken ==. (T.pack token)] []
t <- runDB $ selectList [TokenToken ==. token] []
case t of
[] -> do
setMessage $ [shamlet|<pre>Invalid Token!|]

View file

@ -12,7 +12,7 @@ import Import
-- inclined, or create a single monolithic file.
getHomeR :: Handler Html
getHomeR = do
recentMedia <- runDB $ selectList [] [Desc MediaTime]
recentMedia <- runDB $ selectList [] [Desc MediumTime]
defaultLayout $ do
$(widgetFile "home")

10
Handler/Profile.hs Normal file
View file

@ -0,0 +1,10 @@
module Handler.Profile where
import Import
getProfileR :: Text -> Handler Html
getProfileR username = do
msu <- lookupSession "username"
userMedia <- runDB $ selectList [MediumOwner ==. username] [Desc MediumTime]
defaultLayout $ do
$(widgetFile "profile")

View file

@ -23,7 +23,7 @@ postSignupR = do
True -> do
tokenString <- liftIO generateString
uId <- runDB $ insert $ Token tokenString user
activateLink <- ($ ActivateR $ T.unpack tokenString) <$> getUrlRender
activateLink <- ($ ActivateR tokenString) <$> getUrlRender
sendMail (userEmail user) "Please activate your account!" $
[shamlet|
<h1> Welcome to Eidolon!

9
Handler/Upload.hs Normal file
View file

@ -0,0 +1,9 @@
module Handler.Upload where
import Import
getUploadR :: Handler Html
getUploadR = error "Not yet implemented: getUploadR"
postUploadR :: Handler Html
postUploadR = error "Not yet implemented: postUploadR"

View file

@ -6,13 +6,17 @@ User
Token
token Text
user User
Media
Album
title Text
owner Text
content [MediumId]
Medium
title Text
path FilePath
thumbPath FilePath
time UTCTime
owner Text
description Text
tags Texts
tags [Text]
-- By default this file is used in Model.hs (which is imported by Foundation.hs)

View file

@ -7,4 +7,6 @@
/signup SignupR GET POST
/login LoginR GET POST
/logout LogoutR GET
/activate/#String ActivateR GET
/activate/#Text ActivateR GET
/user/#Text ProfileR GET
/upload UploadR GET POST

View file

@ -23,6 +23,8 @@ library
Handler.Signup
Handler.Login
Handler.Activate
Handler.Profile
Handler.Upload
if flag(dev) || flag(library-only)
cpp-options: -DDEVELOPMENT

View file

@ -5,6 +5,8 @@
Logged in as #{fromJust msu}
<li>
<a href=@{LogoutR}>Logout
<li>
<a href=@{UploadR}>Upload image
$nothing
<li>
<a href=@{LoginR}>Login

14
templates/profile.hamlet Normal file
View file

@ -0,0 +1,14 @@
$newline always
<h3>Profile of #{username}
$if msu == (Just username)
Coming soon: create new album
<br>
$if null userMedia
Dieser Benutzer hat noch keine Medien hochgeladen.
$else
Neueste Medien:
$forall (Entity mediaId medium) <- userMedia
<div class="thumbnails">
<div class="single">