yogsototh/inmanis
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Better model + removed some warning

Browse source
This commit is contained in:
Yann Esposito (Yogsototh) 2012-08-09 08:27:07 +02:00
parent 932fc347df
commit 5eb841c9db
3 changed files with 24 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Foundation.hs
View file

@ -16,7 +16,6 @@ import Prelude
import Yesod import Yesod
import Yesod.Static import Yesod.Static
import Yesod.Auth import Yesod.Auth
import Yesod.Auth.Email
import Yesod.Auth.BrowserId import Yesod.Auth.BrowserId
import Yesod.Auth.GoogleEmail import Yesod.Auth.GoogleEmail
import Yesod.Default.Config import Yesod.Default.Config

29
Handler/Home.hs
View file

@ -10,7 +10,6 @@ module Handler.Home
where where
import Import import Import
import Data.Text (pack)
import Handler.Helper import Handler.Helper
import Yesod.Auth import Yesod.Auth
import Data.Maybe (isNothing) import Data.Maybe (isNothing)
@ -57,10 +56,10 @@ getHomeR = do
-- We create a new resource -- We create a new resource
postHomeR :: Handler RepHtml postHomeR :: Handler RepHtml
postHomeR = do postHomeR = do
currentUserId <- maybeAuthId userId <- maybeAuthId
case currentUserId of case userId of
Nothing -> errorPage "You're not logged" Nothing -> errorPage "You're not logged"
_ -> do -- errorPage "You're logged" Just currentUserId -> do -- errorPage "You're logged"
((res,_),_) <- runFormPost entryForm ((res,_),_) <- runFormPost entryForm
case res of case res of
FormSuccess personRequest -> do FormSuccess personRequest -> do
@ -80,17 +79,16 @@ getEntryR entryId = do
let titleEntry = maybe "" entryTitle maybeEntry let titleEntry = maybe "" entryTitle maybeEntry
errorPageJson titleEntry errorPageJson titleEntry
testLogged :: (UserId -> Handler RepHtmlJson) -> Handler RepHtmlJson
testLogged :: Handler RepHtmlJson -> Handler RepHtmlJson
testLogged v = do testLogged v = do
currentUserId <- maybeAuthId maybeUserId <- maybeAuthId
case currentUserId of case maybeUserId of
Nothing -> errorPageJson "You're not logged" Nothing -> errorPageJson "You're not logged"
_ -> v Just currentUserId -> (v currentUserId)
postEntryR :: EntryId -> Handler RepHtmlJson postEntryR :: EntryId -> Handler RepHtmlJson
postEntryR entry = do postEntryR entry = do
testLogged $ do testLogged $ \userId -> do
req <- runRequestBody req <- runRequestBody
let yeah = lookup "yeah" (fst req) let yeah = lookup "yeah" (fst req)
neah = lookup "neah" (fst req) neah = lookup "neah" (fst req)
@ -98,8 +96,15 @@ postEntryR entry = do
Nothing -> Nothing ->
case neah of case neah of
Nothing -> errorPageJson $ "Neither Yeah nor Neah!" Nothing -> errorPageJson $ "Neither Yeah nor Neah!"
_ -> errorPageJson $ "NEAH!" _ -> downvote userId entry
_ -> errorPageJson $ "YEAH!" _ -> upvote userId entry
downvote :: UserId -> EntryId -> Handler RepHtmlJson
downvote user entry =
errorPageJson $ "NEAH!"
upvote :: UserId -> EntryId -> Handler RepHtmlJson
upvote user entry = errorPageJson $ "YEAH!"
putEntryR :: EntryId -> Handler RepHtmlJson putEntryR :: EntryId -> Handler RepHtmlJson
putEntryR = undefined putEntryR = undefined

9
config/models
View file

@ -8,14 +8,19 @@ Email
verkey Text Maybe verkey Text Maybe
UniqueEmail email UniqueEmail email
Entry Entry
creator UserId Maybe creator UserId
title Text title Text
url Text url Text
yeah Int yeah Int
neah Int neah Int
UniqueEntry url UniqueEntry url
Vote
creator UserId
entry EntryId
value Int
Comment Comment
entry EntryId Maybe creator UserId
entry EntryId
content Text content Text