matebeamter/src/View/Journal.hs

133 lines
3.8 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
module View.Journal where
import Servant.Links (linkURI)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as HA
import Data.String (fromString)
import qualified Data.Text as T
import Data.Text.I18n
import Data.Maybe (fromMaybe)
import Control.Monad (when)
-- imports from "mateamt"
import qualified "mateamt" Types as MT
-- internal imports
import Util
import Types
import View.Scaffold
import API
journalPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> Maybe Word
-> [MT.JournalEntry]
-> JournalPage
journalPage l10n loc version mcookie mpage entries =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Journal"
) $ do
H.table $ do
H.thead $
H.tr $ do
H.th (H.toHtml $ translate "ID")
H.th (H.toHtml $ translate "Time")
H.th (H.toHtml $ translate "Description")
H.th (H.toHtml $ translate "Amount")
H.th (H.toHtml $ translate "Total amount")
mapM_
(\(MT.JournalEntry jid desc time amount total check) ->
H.tr
H.!? (check, HA.class_ "checked")
$ do
H.td (H.toHtml $ show jid)
H.td (H.toHtml $ show time)
H.td (H.toHtml desc)
H.td (H.toHtml $ formatMoney amount)
H.td (H.toHtml $ formatMoney total)
)
entries
let page = fromMaybe 0 mpage
H.form $ do
when (page /= 0) $
H.a
H.! HA.href
("/" <> fromString
(show $ linkURI (journalLink (Just $ page - 1)))
)
$ H.toHtml $ translate "Previous Page"
when (length entries == 50) $
H.a
H.! HA.href
("/" <> fromString
(show $ linkURI (journalLink (Just $ page + 1)))
)
$ H.toHtml $ translate "Next Page"
H.form $
H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI journalGetCheckLink))
$ H.toHtml $ translate "Perform cash check"
where
translate = localize l10n loc . gettext
journalCheckPage
:: L10n
-> Locale
-> T.Text
-> Maybe T.Text
-> JournalCheckPage
journalCheckPage l10n loc version mcookie =
scaffold l10n loc version mcookie (initPage $
translate "Matebeamter" <>
" - " <>
translate "Cash check"
) $ do
H.div $ do
H.p $
H.toHtml $ translate $ mconcat
[ "Please count all the cash in stock thoroughly and diligently, "
, "then submit the total amount in the field below."
]
H.p $
H.toHtml $ translate "Thank you for your cooperation."
H.div $ H.p $ H.form
H.! HA.method "post"
H.! HA.action ("/" <> fromString (show $ linkURI journalPostCheckLink))
H.! HA.enctype "application/x-www-form-urlencoded" $ do
H.div H.! HA.class_ "form-group required" $ do
H.label H.! HA.for "total" $ H.toHtml $ translate "Total amount"
H.input
H.! HA.id "total"
H.! HA.class_ "form-control"
H.! HA.name "cashCheckAmount"
H.! HA.type_ "number"
H.! HA.min "0"
H.! HA.step "0.01"
H.! HA.value "0"
H.div H.! HA.class_ "form-group optional" $
H.button
H.! HA.class_ "btn btn-primary"
H.! HA.type_ "submit"
$ H.toHtml $ translate "Submit"
where
translate = localize l10n loc . gettext