matebeamter/src/View/Journal.hs

88 lines
2.3 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
-> Maybe T.Text
-> Maybe Word
-> [MT.JournalEntry]
-> H.Html
journalPage l10n loc mcookie mpage entries =
scaffold l10n loc 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.button
H.! HA.type_ "submit"
H.! HA.formmethod "get"
H.! HA.formaction
("/" <> fromString (show $ linkURI $ journalCheckLink)
$ H.toHtml $ translate "Perform cash check"
where
translate = localize l10n loc . gettext