matebeamter/src/View/User.hs

134 lines
4 KiB
Haskell
Raw Normal View History

2019-09-08 10:48:57 +00:00
{-# LANGUAGE OverloadedStrings #-}
2019-09-08 15:27:38 +00:00
{-# LANGUAGE PackageImports #-}
2019-09-08 10:48:57 +00:00
module View.User where
2019-09-16 07:44:46 +00:00
import Servant.Links
2019-09-11 04:27:54 +00:00
import qualified Text.Blaze.Html5 as H hiding (style)
2019-09-17 19:29:56 +00:00
import qualified Text.Blaze.Html5.Attributes as HA
2019-09-08 15:27:38 +00:00
import Data.Text.I18n
import Data.String (fromString)
2019-09-11 04:27:54 +00:00
import Data.Maybe (isJust, fromJust)
2019-09-08 15:27:38 +00:00
-- imports from mateamt
import qualified "mateamt" Types as MT
-- internal imports
2019-09-08 10:48:57 +00:00
2019-09-11 04:27:54 +00:00
import Util
2019-09-08 10:48:57 +00:00
import Types
2019-09-08 15:27:38 +00:00
import View.Scaffold
2019-09-16 07:44:46 +00:00
import API
2019-09-08 10:48:57 +00:00
2019-09-11 04:27:54 +00:00
userSelectPage
2019-09-08 15:27:38 +00:00
:: L10n
-> Locale
-> [MT.UserSummary]
2019-09-11 04:27:54 +00:00
-> UserSelectPage
userSelectPage l10n locale uss = scaffold l10n locale (initPage $
2019-09-16 07:44:46 +00:00
(translate "Matebeamter") <>
2019-09-11 04:27:54 +00:00
" - " <>
2019-09-16 07:44:46 +00:00
(translate "Home")
) $ do
mapM_ (\(MT.UserSummary uid ident _) -> do
2019-09-17 19:29:56 +00:00
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userOverviewLink uid)) $
2019-09-16 07:44:46 +00:00
H.toHtml ident
) uss
2019-09-17 19:29:56 +00:00
H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userNewLink)) $
H.toHtml $ translate "New user"
2019-09-16 07:44:46 +00:00
where
translate = localize l10n locale . gettext
2019-09-11 04:27:54 +00:00
userOverviewPage
:: L10n
-> Locale
-> MT.UserDetails
-> [MT.ProductShortOverview]
-> UserOverviewPage
userOverviewPage l10n locale ud pos = scaffold l10n locale (initPage $
(localize l10n locale $ gettext "Matebeamter") <>
" - " <>
(localize l10n locale $ gettext "User Menu for ") <>
(MT.userDetailsIdent ud)
) $ do
H.p $ H.toHtml $ (translate "Welcome back, ") <> (MT.userDetailsIdent ud)
<> "!"
2019-09-17 19:29:56 +00:00
H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
2019-09-11 04:27:54 +00:00
(translate "Your current balance is") <>
": " <>
(formatMoney $ MT.userDetailsBalance ud)
-- TODO: Add currency symbol
2019-09-17 19:29:56 +00:00
H.ul H.! HA.class_ "product_list" $
2019-09-11 04:27:54 +00:00
mapM_
(\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> do
2019-09-17 19:29:56 +00:00
H.li H.! HA.class_ "product" H.!?
2019-09-11 04:27:54 +00:00
(isJust avatarid
, productBgStyle (fromString $ show $ fromJust avatarid)
) $
2019-09-17 19:29:56 +00:00
H.a H.! HA.href ("#" <> fromString (show pid)) $ H.toHtml ident
2019-09-11 04:27:54 +00:00
)
pos
where
translate = localize l10n locale . gettext
2019-09-17 19:29:56 +00:00
productBgStyle aid = HA.style $ mconcat
2019-09-11 04:27:54 +00:00
[ "background-image: url(#" <> aid <> ");" -- FILLME
, "backgronud-color: blue;"
, "text-shadow:"
, " -1px 0 1px black,"
, " 0 1px 1px black,"
, " 1px 0 1px black,"
, " 0 -1px 1px black;"
]
2019-09-17 19:29:56 +00:00
userNewPage
:: L10n
-> Locale
-> UserNewPage
userNewPage l10n locale = scaffold l10n locale (initPage $
(translate "Matebeamter") <>
" - " <>
(translate "Create new user")
) $ do
H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> (fromString $ show $ linkURI $ userNewPostLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "username" $ H.toHtml $ translate "Username"
H.input
H.! HA.id "username"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitIdent"
H.! HA.type_ "text"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ do
H.label H.! HA.for "useremail" $ H.toHtml $ translate "Email"
H.input
H.! HA.id "useremail"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitEmail"
H.! HA.type_ "email"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "userpass" $ H.toHtml $ translate "Password"
H.input
H.! HA.id "userpass"
H.! HA.class_ "form-control"
H.! HA.name "userSubmitPassHash"
H.! HA.type_ "password"
H.! HA.required ""
H.! HA.value ""
H.div H.! HA.class_ "form-group optional" $ do
H.button
H.! HA.class_ "btn btn-default"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n locale . gettext