query and show a user from the database

This commit is contained in:
Christine Dodrill 2015-07-28 08:51:02 -07:00
parent d4cefb71b1
commit fd944b3e34
2 changed files with 8 additions and 5 deletions

View File

@ -19,6 +19,8 @@ main = do
-- Simple tests to prove we're reading from SQLite -- Simple tests to prove we're reading from SQLite
r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post] r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post]
let h = head r let h = head r
users <- Db.query_ conn "SELECT * FROM Users WHERE id=1" :: IO [User.User]
let user = head users
-- Set up the URL router -- Set up the URL router
S.runSpock 5000 $ S.spockT id $ do S.runSpock 5000 $ S.spockT id $ do
@ -27,7 +29,6 @@ main = do
S.get S.root $ S.get S.root $
S.html $ toStrict (renderHtml (Materialize.base "The OP" (Post.render h))) S.html $ toStrict (renderHtml (Materialize.base "The OP" (Post.render h)))
{-S.get ("users" <//> S.var) $ \id ->
S.text renderHtml $ User.render $ do S.get "user" $
res <- Db.query_ conn "SELECT * FROM Users WHERE id=?" id :: IO [User.User] S.html $ toStrict (renderHtml (Materialize.base "The first poster" (User.render user)))
head res-}

View File

@ -24,4 +24,6 @@ render user = do
H.div ! A.class_ "card blue-grey darken-1" $ do H.div ! A.class_ "card blue-grey darken-1" $ do
H.div ! A.class_ "card-content white-text" $ do H.div ! A.class_ "card-content white-text" $ do
H.span ! A.class_ "card-title" $ H.toHtml $ unpack (name user) H.span ! A.class_ "card-title" $ H.toHtml $ unpack (name user)
H.br
H.a ! A.href (H.toValue ("https://derpibooru.org/profiles/" ++ unpack (oID user))) $ do
H.img ! A.src (H.toValue $ unpack $ avatar user) H.img ! A.src (H.toValue $ unpack $ avatar user)