matebeamter/src/View/User.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module View.User where

import Servant.Links

import qualified Text.Blaze.Html5 as H hiding (style)
import qualified Text.Blaze.Html5.Attributes as HA

import Data.Text.I18n

import Data.String (fromString)

import Data.Maybe (isJust, fromJust)

-- imports from mateamt

import qualified "mateamt" Types as MT

-- internal imports

import Util
import Types
import View.Scaffold
import API

userSelectPage
  :: L10n
  -> Locale
  -> [MT.UserSummary]
  -> UserSelectPage
userSelectPage l10n locale uss = scaffold l10n locale (initPage $
  (translate "Matebeamter") <>
  " - " <>
  (translate "Home")
  ) $ do
    mapM_ (\(MT.UserSummary uid ident _) -> do
      H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userOverviewLink uid)) $
        H.toHtml ident
      ) uss
    H.a H.! HA.href ("/" <> (fromString $ show $ linkURI $ userNewLink)) $
      H.toHtml $ translate "New user"
  where
    translate = localize l10n locale . gettext

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)
      <> "!"
    H.p H.!? (MT.userDetailsBalance ud < 0, HA.class_ "debt") $ H.toHtml $
      (translate "Your current balance is") <>
      ": " <>
      (formatMoney $ MT.userDetailsBalance ud)
      -- TODO: Add currency symbol
    H.ul H.! HA.class_ "product_list" $
      mapM_
        (\(MT.ProductShortOverview pid ident _ _ _ avatarid) -> do
          H.li H.! HA.class_ "product" H.!?
            (isJust avatarid
            , productBgStyle (fromString $ show $ fromJust avatarid)
            ) $
              H.a H.! HA.href ("#" <> fromString (show pid)) $ H.toHtml ident
        )
        pos
  where
    translate = localize l10n locale . gettext
    productBgStyle aid = HA.style $ mconcat
      [ "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;"
      ]

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