beginning polish

This commit is contained in:
nek0 2019-12-24 13:17:45 +01:00
parent f1f0e28b4e
commit f2f9f46c4e
7 changed files with 112 additions and 61 deletions

View File

@ -63,6 +63,7 @@ executable matebeamter
, hashable
, warp
, wai
, wai-app-static
, wai-logger
, wai-session
, http-client

View File

@ -11,7 +11,7 @@ module API where
import Servant.API
import Servant.Links
-- import Servant.RawM
import Servant.RawM
import Servant.HTML.Blaze
import Data.Proxy
@ -96,6 +96,7 @@ type UserAPI =
:> Post '[HTML] UserSelectPage
:<|> "auth" :> "logout"
:> Post '[HTML] UserOverviewPage
:<|> "static" :> RawM
)
( userSelectLink :<|>
@ -122,5 +123,6 @@ type UserAPI =
productPostNewLink :<|>
authLink :<|>
authPostLink :<|>
authLogoutLink
authLogoutLink :<|>
staticLink
) = allLinks (Proxy :: Proxy UserAPI)

View File

@ -20,6 +20,8 @@ import Data.YAML
import Options.Applicative
import Network.Wai.Application.Static
-- imports from "mateamt"
import qualified "mateamt" Types as MT
@ -107,6 +109,7 @@ userApp initState = serveWithContext userApi EmptyContext $
:<|> authControl mcookie
:<|> authPostControl mcookie
:<|> authLogoutControl mcookie
:<|> (\_ -> return $ staticApp (defaultFileServerSettings "static")) mcookie
)
userApi :: Proxy UserAPI

View File

@ -1,8 +1,10 @@
{-# LANGUAGE OverloadedStrings #-}
module Types.Page where
import qualified Data.Text as T
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
data Page markup attr = Page
{ pageTitle :: attr -- ^ Page title
@ -34,7 +36,11 @@ initPage title = Page
title
mempty
mempty
mempty
(H.link
H.! HA.rel "stylesheet"
H.! HA.type_ "text/css"
H.! HA.href "/static/css/style.css"
)
template
:: Page H.Html T.Text

View File

@ -139,10 +139,13 @@ buyProductsForm
-> [MT.ProductShortOverview]
-> H.Html
buyProductsForm l10n locale prods = do
H.div H.! HA.class_ "tile-list" $
mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) ->
H.div $ do
H.div
H.! HA.class_ "form-group optional"
H.! HA.class_ "tile"
$ do
H.div
H.! HA.class_ "tile-content form-group optional"
H.!?
( isJust maid
, productBgStyle (fromString $ show $ fromJust maid)
@ -158,7 +161,7 @@ buyProductsForm l10n locale prods = do
H.! HA.type_ "checkbox"
H.! HA.value "true"
H.div
H.! HA.class_ "form-group optional"
H.! HA.class_ "tile-content form-group optional"
$ do
H.label
H.! HA.for ("product-amount-" <> fromString (show pid)) $

View File

@ -39,17 +39,25 @@ userSelectPage l10n locale uss version mcookie =
translate "Matebeamter" <>
" - " <>
translate "Home"
) $ do
H.a H.! HA.href ("/" <> fromString
) $ H.ul
H.! HA.class_ "tile-list"
$ do
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content function"
H.! HA.href ("/" <> fromString
(show $ linkURI $ cashBuyLink Nothing)
) $
H.toHtml $ translate "Buy with cash"
mapM_ (\(MT.UserSummary uid ident _) ->
H.a H.! HA.href ("/" <> fromString (show $ linkURI $
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content"
H.! HA.href ("/" <> fromString (show $ linkURI $
userOverviewLink uid Nothing)) $
H.toHtml ident
) uss
H.a H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
H.li H.! HA.class_ "tile" $ H.a
H.! HA.class_ "tile-content function"
H.! HA.href ("/" <> fromString (show $ linkURI userNewLink)) $
H.toHtml $ translate "New user"
where
translate = localize l10n locale . gettext
@ -146,14 +154,18 @@ productList
-> H.Html
productList pos =
H.p $
H.ul H.! HA.class_ "product_list" $
H.ul H.! HA.class_ "tile-list" $
mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) ->
H.li H.! HA.class_ "product" H.!?
H.li
H.! HA.class_ "tile"
H.!?
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
H.a H.! HA.href ("#" <> fromString (show pid)) $
H.a
H.! HA.class_ "tile-content"
H.! HA.href ("#" <> fromString (show pid)) $
H.toHtml ident
)
pos

View File

@ -1,16 +1,40 @@
.tile-content {
flex: 1 1 auto;
background-color: #36c30023;
display: flex;
justify-content: center;
flex-direction: column;
}
.tile-content * {
}
.tile-content label, .tile-content div {
width: 100%;
}
.tile {
display: inline-block;
display: inline-flex;
flex-direction: column;
align-content: stretch;
align-items: stretch;
justify-content: stretch;
border-radius: 6px;
width: 100px;
height: 100px;
margin: 30px 15px 0;
box-shadow: 0 0 3px #c3c3c3;
margin: 30px 15px 0;
width: 200px;
height: 200px;
text-align: center;
}
.function {
background-color: #c300d223
}
.tile-list {
list-style: none;
}
.tile-list li {
display: inline-block;
hr {
margin-top: 30px;
}