aboutsummaryrefslogtreecommitdiff
path: root/src/server/View
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/View')
-rw-r--r--src/server/View/Mail/SignIn.hs24
-rw-r--r--src/server/View/Mail/WeeklyReport.hs102
-rw-r--r--src/server/View/Page.hs43
3 files changed, 0 insertions, 169 deletions
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
deleted file mode 100644
index 12c4f34..0000000
--- a/src/server/View/Mail/SignIn.hs
+++ /dev/null
@@ -1,24 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Mail.SignIn
- ( mail
- ) where
-
-import Data.Text (Text)
-
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model.User (User(..))
-
-import Conf (Conf)
-import qualified Conf as Conf
-import qualified Model.Mail as M
-
-mail :: Conf -> User -> Text -> [Text] -> M.Mail
-mail conf user url to =
- M.Mail
- { M.from = Conf.noReplyMail conf
- , M.to = to
- , M.subject = Message.get Key.SignIn_MailTitle
- , M.plainBody = Message.get (Key.SignIn_MailBody (_user_name user) url)
- }
diff --git a/src/server/View/Mail/WeeklyReport.hs b/src/server/View/Mail/WeeklyReport.hs
deleted file mode 100644
index 0bafb70..0000000
--- a/src/server/View/Mail/WeeklyReport.hs
+++ /dev/null
@@ -1,102 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Mail.WeeklyReport
- ( mail
- ) where
-
-import Data.List (sortOn)
-import Data.Map (Map)
-import Data.Maybe (catMaybes, fromMaybe)
-import Data.Monoid ((<>))
-import Data.Text (Text)
-import Data.Time.Clock (UTCTime)
-import qualified Data.Map as M
-import qualified Data.Text as T
-
-import qualified Common.Message as Message
-import qualified Common.Message.Key as Key
-import Common.Model (Payment(..), User(..), UserId, Income(..))
-import qualified Common.Model.User as User
-import qualified Common.View.Format as Format
-
-import Model.Mail (Mail(Mail))
-import Model.Payment ()
-import qualified Model.Income ()
-import qualified Model.Mail as M
-import Resource (Status(..), groupByStatus, statuses)
-import Conf (Conf)
-import qualified Conf as Conf
-
-mail :: Conf -> [User] -> [Payment] -> [Income] -> UTCTime -> UTCTime -> Mail
-mail conf users payments incomes start end =
- Mail
- { M.from = Conf.noReplyMail conf
- , M.to = map _user_email users
- , M.subject = T.concat
- [ Message.get Key.App_Title
- , " − "
- , Message.get Key.WeeklyReport_Title
- ]
- , M.plainBody = body conf users (groupByStatus start end payments) (groupByStatus start end incomes)
- }
-
-body :: Conf -> [User] -> Map Status [Payment] -> Map Status [Income] -> Text
-body conf users paymentsByStatus incomesByStatus =
- if M.null paymentsByStatus && M.null incomesByStatus
- then
- Message.get Key.WeeklyReport_Empty
- else
- T.intercalate "\n" . catMaybes . concat $
- [ map (\s -> paymentSection s conf users <$> M.lookup s paymentsByStatus) statuses
- , map (\s -> incomeSection s conf users <$> M.lookup s incomesByStatus) statuses
- ]
-
-paymentSection :: Status -> Conf -> [User] -> [Payment] -> Text
-paymentSection status conf users payments =
- section sectionTitle sectionItems
- where count = length payments
- sectionTitle = Message.get $ case status of
- Created -> if count > 1 then Key.WeeklyReport_PaymentsCreated count else Key.WeeklyReport_PaymentCreated count
- Edited -> if count > 1 then Key.WeeklyReport_PaymentsEdited count else Key.WeeklyReport_PaymentEdited count
- Deleted -> if count > 1 then Key.WeeklyReport_PaymentsDeleted count else Key.WeeklyReport_PaymentDeleted count
- sectionItems = map (payedFor status conf users) . sortOn _payment_date $ payments
-
-payedFor :: Status -> Conf -> [User] -> Payment -> Text
-payedFor status conf users payment =
- case status of
- Deleted -> Message.get (Key.WeeklyReport_PayedForNot name amount for at)
- _ -> Message.get (Key.WeeklyReport_PayedFor name amount for at)
- where name = formatUserName (_payment_user payment) users
- amount = Format.price (Conf.currency conf) . _payment_cost $ payment
- for = _payment_name payment
- at = Format.longDay $ _payment_date payment
-
-incomeSection :: Status -> Conf -> [User] -> [Income] -> Text
-incomeSection status conf users incomes =
- section sectionTitle sectionItems
- where count = length incomes
- sectionTitle = Message.get $ case status of
- Created -> if count > 1 then Key.WeeklyReport_IncomesCreated count else Key.WeeklyReport_IncomeCreated count
- Edited -> if count > 1 then Key.WeeklyReport_IncomesEdited count else Key.WeeklyReport_IncomeEdited count
- Deleted -> if count > 1 then Key.WeeklyReport_IncomesDeleted count else Key.WeeklyReport_IncomeDeleted count
- sectionItems = map (isPayedFrom status conf users) . sortOn _income_date $ incomes
-
-isPayedFrom :: Status -> Conf -> [User] -> Income -> Text
-isPayedFrom status conf users income =
- case status of
- Deleted -> Message.get (Key.WeeklyReport_PayedFromNot name amount for)
- _ -> Message.get (Key.WeeklyReport_PayedFrom name amount for)
- where name = formatUserName (_income_userId income) users
- amount = Format.price (Conf.currency conf) . _income_amount $ income
- for = Format.longDay $ _income_date income
-
-formatUserName :: UserId -> [User] -> Text
-formatUserName userId = fromMaybe "−" . fmap _user_name . User.find userId
-
-section :: Text -> [Text] -> Text
-section title items =
- T.concat
- [ title
- , "\n\n"
- , T.unlines . map (" - " <>) $ items
- ]
diff --git a/src/server/View/Page.hs b/src/server/View/Page.hs
deleted file mode 100644
index 1c072a4..0000000
--- a/src/server/View/Page.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module View.Page
- ( page
- ) where
-
-import Data.Text.Internal.Lazy (Text)
-import Data.Text.Lazy.Encoding (decodeUtf8)
-import Data.Aeson (encode)
-import qualified Data.Aeson.Types as Json
-
-import Text.Blaze.Html
-import Text.Blaze.Html5
-import qualified Text.Blaze.Html5 as H
-import Text.Blaze.Html5.Attributes
-import qualified Text.Blaze.Html5.Attributes as A
-import Text.Blaze.Html.Renderer.Text (renderHtml)
-
-import qualified Common.Message as Message
-import Common.Model.InitResult (InitResult)
-import qualified Common.Message.Key as Key
-
-import Design.Global (globalDesign)
-
-page :: InitResult -> Text
-page initResult =
- renderHtml . docTypeHtml $ do
- H.head $ do
- meta ! charset "UTF-8"
- meta ! name "viewport" ! content "width=device-width, initial-scale=1, maximum-scale=1, user-scalable=0"
- H.title (toHtml $ Message.get Key.App_Title)
- script ! src "javascript/main.js" $ ""
- jsonScript "init" initResult
- link ! rel "stylesheet" ! type_ "text/css" ! href "css/reset.css"
- link ! rel "icon" ! type_ "image/png" ! href "images/icon.png"
- H.style $ toHtml globalDesign
-
-jsonScript :: Json.ToJSON a => Text -> a -> Html
-jsonScript scriptId json =
- script
- ! A.id (toValue scriptId)
- ! type_ "application/json"
- $ toHtml . decodeUtf8 . encode $ json