Create an h-card widget and display my h-card on the homepage - needs more info but it's a good start
This commit is contained in:
parent
5eccafa9c2
commit
006264e77f
6 changed files with 27 additions and 2 deletions
|
@ -1,5 +1,7 @@
|
||||||
User
|
User
|
||||||
ident Text sqltype=varchar(255)
|
ident Text sqltype=varchar(255)
|
||||||
|
fullName Text sqltype=varchar(500)
|
||||||
|
avatar Text Maybe sqltype=varchar(255) default=NULL
|
||||||
password Text Maybe sqltype=varchar(255) default=NULL
|
password Text Maybe sqltype=varchar(255) default=NULL
|
||||||
UniqueUser ident
|
UniqueUser ident
|
||||||
deriving Typeable
|
deriving Typeable
|
||||||
|
|
|
@ -217,7 +217,9 @@ instance YesodAuth App where
|
||||||
case x of
|
case x of
|
||||||
Just (Entity uid _) -> return $ Authenticated uid
|
Just (Entity uid _) -> return $ Authenticated uid
|
||||||
Nothing -> Authenticated <$> insert User
|
Nothing -> Authenticated <$> insert User
|
||||||
{ userIdent = credsIdent creds
|
{ userAvatar = Nothing
|
||||||
|
, userIdent = credsIdent creds
|
||||||
|
, userFullName = ""
|
||||||
, userPassword = Nothing
|
, userPassword = Nothing
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -6,6 +6,9 @@
|
||||||
module Handler.Home where
|
module Handler.Home where
|
||||||
|
|
||||||
import Import
|
import Import
|
||||||
|
import Widget.Hcard (hcard)
|
||||||
|
|
||||||
getHomeR :: Handler Html
|
getHomeR :: Handler Html
|
||||||
getHomeR = defaultLayout $(widgetFile "home")
|
getHomeR = do
|
||||||
|
(Entity _ user) <- runDB . getBy404 $ UniqueUser "dani"
|
||||||
|
defaultLayout $(widgetFile "home")
|
||||||
|
|
12
src/Widget/Hcard.hs
Normal file
12
src/Widget/Hcard.hs
Normal file
|
@ -0,0 +1,12 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
module Widget.Hcard (hcard) where
|
||||||
|
|
||||||
|
import Import
|
||||||
|
|
||||||
|
img :: Text -> Route App
|
||||||
|
img file = StaticR . flip StaticRoute [] $ ["img", file]
|
||||||
|
|
||||||
|
hcard :: User -> Widget
|
||||||
|
hcard user = $(widgetFile "hcard")
|
5
templates/hcard.hamlet
Normal file
5
templates/hcard.hamlet
Normal file
|
@ -0,0 +1,5 @@
|
||||||
|
<div .card.h-card>
|
||||||
|
$maybe avatar <- userAvatar user
|
||||||
|
<img .card-img-top.u-photo src=@{img avatar} alt="Avatar for #{userFullName user}">
|
||||||
|
<div .card-body>
|
||||||
|
<h4 .card-title.p-name>#{userFullName user}
|
|
@ -0,0 +1 @@
|
||||||
|
^{hcard user}
|
Loading…
Reference in a new issue