我在做PetShop系统。我有一个列出所有动物的表格。我的项目中已有Session。如何添加动物链接到会话ID,并在列出动物的页面中,列出该用户的动物。
这是与之相关的部分。
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Animals
nome Text
idade Int
racaid RacaId
deriving Show
Users
nome Text
login Text
senha Text
deriving Show
Raca
nome Text
apelido Text sqltype=varchar(10)
deriving Show
|]
--Form that include animals
formAnimal :: Form Animals
formAnimal = renderDivs $ Animals <$>
areq textField "Nome: " Nothing <*>
areq intField "Idade: " Nothing <*>
areq (selectField racas) "Raca" Nothing
--Form that include Users
formUser :: Form Users
formUser = renderDivs $ Users <$>
areq textField "Nome: " Nothing <*>
areq textField "Login: " Nothing <*>
areq passwordField "Password: " Nothing
--Function do include animals
getAnimalR :: Handler Html
getAnimalR = do
(widget, enctype) <- generateFormPost formAnimal
defaultLayout $ do
toWidget [cassius|
label
color:blue;
|]
[whamlet|
<form .form-horizontal method=post enctype=#{enctype} action=@{AnimalR}>
^{widget}
<input type="submit" value="Cadastrar Animal">
|]
--Part that list all Animals (need to list just of the User)
getListarAnimalR :: Handler Html
getListarAnimalR = do
listaAnm <- runDB $ selectList [] [Asc AnimalsNome]
defaultLayout $ [whamlet|
<h1> Animais cadastrados:
$forall Entity pid animals <- listaAnm
<a href=@{ChecarAnimalR pid}> #{animalsNome animals}
<form method=post action=@{ChecarAnimalR pid}>
<input type="submit" value="Deletar Animal"><br>
|] >> toWidget [lucius|
form { display:inline; }
input { background-color: #ecc; border:0;}
|]
--Function that get the User. Check in database if contain any user with that login and pass
postLoginR :: Handler Html
postLoginR = do
((result, _), _) <- runFormPost formLogin
case result of
FormSuccess ("admin","admin") -> setSession "_ID" "admin" >> redirect AdminR
FormSuccess (login,senha) -> do
user <- runDB $ selectFirst [UsersLogin ==. login, UsersSenha ==. senha] []
case user of
Nothing -> redirect LoginR
Just (Entity pid u) -> setSession "_ID" (pack $ show $ fromSqlKey pid) >> redirect (PerfilR pid)