nek0/matebeamter
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

beginning polish

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

1
matebeamter.cabal
View file

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

6
src/API.hs
View file

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

3
src/Main.hs
View file

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

8
src/Types/Page.hs
View file

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

69
src/View/Buy.hs
View file

@ -139,40 +139,43 @@ buyProductsForm
-> [MT.ProductShortOverview] -> [MT.ProductShortOverview]
-> H.Html -> H.Html
buyProductsForm l10n locale prods = do buyProductsForm l10n locale prods = do
mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) -> H.div H.! HA.class_ "tile-list" $
H.div $ do mapM_ (\(MT.ProductShortOverview pid ident price amount ml maid) ->
H.div H.div
H.! HA.class_ "form-group optional" H.! HA.class_ "tile"
H.!? $ do
( isJust maid H.div
, productBgStyle (fromString $ show $ fromJust maid) H.! HA.class_ "tile-content form-group optional"
) H.!?
$ do ( isJust maid
H.label , productBgStyle (fromString $ show $ fromJust maid)
H.! HA.for ("product-select-" <> fromString (show pid)) $ )
H.toHtml ident $ do
H.input H.label
H.! HA.id ("product-select-" <> fromString (show pid)) H.! HA.for ("product-select-" <> fromString (show pid)) $
H.! HA.class_ "form-control product-select" H.toHtml ident
H.! HA.name ("productSelect-" <> fromString (show pid)) H.input
H.! HA.type_ "checkbox" H.! HA.id ("product-select-" <> fromString (show pid))
H.! HA.value "true" H.! HA.class_ "form-control product-select"
H.div H.! HA.name ("productSelect-" <> fromString (show pid))
H.! HA.class_ "form-group optional" H.! HA.type_ "checkbox"
$ do H.! HA.value "true"
H.label H.div
H.! HA.for ("product-amount-" <> fromString (show pid)) $ H.! HA.class_ "tile-content form-group optional"
H.toHtml (translate "Amount") $ do
H.input H.label
H.! HA.id ("product-amount-" <> fromString (show pid)) H.! HA.for ("product-amount-" <> fromString (show pid)) $
H.! HA.class_ "form-control product-amount" H.toHtml (translate "Amount")
H.! HA.name ("productAmount-" <> fromString (show pid)) H.input
H.! HA.type_ "number" H.! HA.id ("product-amount-" <> fromString (show pid))
H.! HA.min "0" H.! HA.class_ "form-control product-amount"
H.! HA.step "1" H.! HA.name ("productAmount-" <> fromString (show pid))
H.! HA.value "1" H.! HA.type_ "number"
) H.! HA.min "0"
prods H.! HA.step "1"
H.! HA.value "1"
)
prods
H.div H.! HA.class_ "form-group optional" $ H.div H.! HA.class_ "form-group optional" $
H.button H.button
H.! HA.class_ "btn btn-default" H.! HA.class_ "btn btn-default"

50
src/View/User.hs
View file

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

36
static/css/style.css
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 { .tile {
display: inline-block; display: inline-flex;
flex-direction: column;
align-content: stretch;
align-items: stretch;
justify-content: stretch;
border-radius: 6px; border-radius: 6px;
width: 100px;
height: 100px;
margin: 30px 15px 0;
box-shadow: 0 0 3px #c3c3c3; box-shadow: 0 0 3px #c3c3c3;
margin: 30px 15px 0;
width: 200px;
height: 200px;
text-align: center;
}
.function {
background-color: #c300d223
} }
.tile-list { .tile-list {
list-style: none; list-style: none;
} }
.tile-list li { hr {
display: inline-block; margin-top: 30px;
} }