aboutsummaryrefslogtreecommitdiff
path: root/common
diff options
context:
space:
mode:
Diffstat (limited to 'common')
-rw-r--r--common/common.cabal3
-rw-r--r--common/src/Common/Message/Translation.hs2
-rw-r--r--common/src/Common/Model.hs3
-rw-r--r--common/src/Common/Model/Payer.hs202
-rw-r--r--common/src/Common/Model/Payment.hs2
-rw-r--r--common/src/Common/Model/PaymentCategory.hs25
-rw-r--r--common/src/Common/Model/PaymentPage.hs17
-rw-r--r--common/src/Common/Model/SavedPayment.hs17
-rw-r--r--common/src/Common/Util/Text.hs1
9 files changed, 12 insertions, 260 deletions
diff --git a/common/common.cabal b/common/common.cabal
index 75d6cc8..17a0ee1 100644
--- a/common/common.cabal
+++ b/common/common.cabal
@@ -35,7 +35,6 @@ Library
Common.Model.CreatePaymentForm
Common.Model.Email
Common.Model.Payment
- Common.Model.SavedPayment
Common.Model.SignInForm
Common.Model.User
Common.Msg
@@ -66,7 +65,5 @@ Library
Common.Model.IncomePage
Common.Model.Init
Common.Model.InitResult
- Common.Model.Payer
- Common.Model.PaymentCategory
Common.Model.PaymentHeader
Common.Model.PaymentPage
diff --git a/common/src/Common/Message/Translation.hs b/common/src/Common/Message/Translation.hs
index 25e9f4b..a86a371 100644
--- a/common/src/Common/Message/Translation.hs
+++ b/common/src/Common/Message/Translation.hs
@@ -702,7 +702,7 @@ m l WeeklyReport_Title =
m l NotFound_Message =
case l of
English -> "There is nothing here!"
- French -> "Vous vous êtes perdu."
+ French -> "Il n’y a rien à voir ici."
m l NotFound_LinkMessage =
case l of
diff --git a/common/src/Common/Model.hs b/common/src/Common/Model.hs
index fdeac36..00d30f6 100644
--- a/common/src/Common/Model.hs
+++ b/common/src/Common/Model.hs
@@ -17,11 +17,8 @@ import Common.Model.IncomeHeader as X
import Common.Model.IncomePage as X
import Common.Model.Init as X
import Common.Model.InitResult as X
-import Common.Model.Payer as X
import Common.Model.Payment as X
-import Common.Model.PaymentCategory as X
import Common.Model.PaymentHeader as X
import Common.Model.PaymentPage as X
-import Common.Model.SavedPayment as X
import Common.Model.SignInForm as X
import Common.Model.User as X
diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs
deleted file mode 100644
index 39a5788..0000000
--- a/common/src/Common/Model/Payer.hs
+++ /dev/null
@@ -1,202 +0,0 @@
-module Common.Model.Payer
- ( getExceedingPayers
- , useIncomesFrom
- , cumulativeIncomesSince
- ) where
-
-import qualified Data.List as List
-import qualified Data.Maybe as Maybe
-import Data.Time (NominalDiffTime, UTCTime (..))
-import qualified Data.Time as Time
-import Data.Time.Calendar (Day)
-
-import Common.Model.ExceedingPayer (ExceedingPayer (..))
-import Common.Model.Income (Income (..))
-import Common.Model.Payment (Payment (..))
-import Common.Model.User (User (..), UserId)
-
-data Payer = Payer
- { _payer_userId :: UserId
- , _payer_preIncomePayments :: Int
- , _payer_postIncomePayments :: Int
- , _payer_incomes :: [Income]
- }
-
-data PostPaymentPayer = PostPaymentPayer
- { _postPaymentPayer_userId :: UserId
- , _postPaymentPayer_preIncomePayments :: Int
- , _postPaymentPayer_cumulativeIncome :: Int
- , _postPaymentPayer_ratio :: Float
- }
-
-getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer]
-getExceedingPayers currentTime users incomes payments =
- let userIds = map _user_id users
- payers = getPayers userIds incomes payments
- exceedingPayersOnPreIncome =
- exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers
- firstPayment = safeHead . List.sort . map _payment_date $ payments
- mbSince = useIncomesFrom userIds incomes firstPayment
- in case mbSince of
- Just since ->
- let postPaymentPayers = map (getPostPaymentPayer currentTime since) payers
- mbMaxRatio = safeMaximum . map _postPaymentPayer_ratio $ postPaymentPayers
- in case mbMaxRatio of
- Just maxRatio ->
- exceedingPayersFromAmounts
- . map (\p -> (_postPaymentPayer_userId p, getFinalDiff maxRatio p))
- $ postPaymentPayers
- Nothing ->
- exceedingPayersOnPreIncome
- _ ->
- exceedingPayersOnPreIncome
-
-useIncomesFrom :: [UserId] -> [Income] -> Maybe Day -> Maybe Day
-useIncomesFrom userIds incomes firstPayment =
- case (firstPayment, incomeDefinedForAll userIds incomes) of
- (Just d1, Just d2) -> Just (max d1 d2)
- _ -> Nothing
-
-dayUTCTime :: Day -> UTCTime
-dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0)
-
-getPayers :: [UserId] -> [Income] -> [Payment] -> [Payer]
-getPayers userIds incomes payments =
- let incomesDefined = incomeDefinedForAll userIds incomes
- in flip map userIds (\userId -> Payer
- { _payer_userId = userId
- , _payer_preIncomePayments =
- totalPayments
- (\p ->
- case incomesDefined of
- Just d ->
- _payment_date p < d
-
- Nothing ->
- True
- )
- userId
- payments
- , _payer_postIncomePayments =
- totalPayments
- (\p ->
- case incomesDefined of
- Nothing -> False
- Just t -> _payment_date p >= t
- )
- userId
- payments
- , _payer_incomes = filter ((==) userId . _income_userId) incomes
- }
- )
-
-exceedingPayersFromAmounts :: [(UserId, Int)] -> [ExceedingPayer]
-exceedingPayersFromAmounts userAmounts =
- case mbMinAmount of
- Nothing ->
- []
- Just minAmount ->
- filter (\payer -> _exceedingPayer_amount payer > 0)
- . map (\userAmount ->
- ExceedingPayer
- { _exceedingPayer_userId = fst userAmount
- , _exceedingPayer_amount = snd userAmount - minAmount
- }
- )
- $ userAmounts
- where mbMinAmount = safeMinimum . map snd $ userAmounts
-
-getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer
-getPostPaymentPayer currentTime since payer =
- PostPaymentPayer
- { _postPaymentPayer_userId = _payer_userId payer
- , _postPaymentPayer_preIncomePayments = _payer_preIncomePayments payer
- , _postPaymentPayer_cumulativeIncome = cumulativeIncome
- , _postPaymentPayer_ratio = (fromIntegral . _payer_postIncomePayments $ payer) / (fromIntegral cumulativeIncome)
- }
- where cumulativeIncome = cumulativeIncomesSince currentTime since (_payer_incomes payer)
-
-getFinalDiff :: Float -> PostPaymentPayer -> Int
-getFinalDiff maxRatio payer =
- let postIncomeDiff =
- truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer)
- in postIncomeDiff + _postPaymentPayer_preIncomePayments payer
-
-incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day
-incomeDefinedForAll userIds incomes =
- let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds
- firstIncomes = map (safeHead . List.sortOn _income_date) userIncomes
- in if all Maybe.isJust firstIncomes
- then safeHead . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes
- else Nothing
-
-cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int
-cumulativeIncomesSince currentTime since incomes =
- getCumulativeIncome currentTime (getOrderedIncomesSince since incomes)
-
-getOrderedIncomesSince :: Day -> [Income] -> [Income]
-getOrderedIncomesSince since incomes =
- let mbStarterIncome = getIncomeAt since incomes
- orderedIncomesSince = filter (\income -> _income_date income >= since) incomes
- in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince
-
-getIncomeAt :: Day -> [Income] -> Maybe Income
-getIncomeAt day incomes =
- case incomes of
- [x] ->
- if _income_date x < day
- then Just $ x { _income_date = day }
- else Nothing
- x1 : x2 : xs ->
- if _income_date x1 < day && _income_date x2 >= day
- then Just $ x1 { _income_date = day }
- else getIncomeAt day (x2 : xs)
- [] ->
- Nothing
-
-getCumulativeIncome :: UTCTime -> [Income] -> Int
-getCumulativeIncome currentTime incomes =
- sum
- . map durationIncome
- . getIncomesWithDuration currentTime
- . List.sortOn incomeTime
- $ incomes
-
-getIncomesWithDuration :: UTCTime -> [Income] -> [(NominalDiffTime, Int)]
-getIncomesWithDuration currentTime incomes =
- case incomes of
- [] ->
- []
- [income] ->
- [(Time.diffUTCTime currentTime (incomeTime income), _income_amount income)]
- (income1 : income2 : xs) ->
- (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs))
-
-incomeTime :: Income -> UTCTime
-incomeTime = dayUTCTime . _income_date
-
-durationIncome :: (NominalDiffTime, Int) -> Int
-durationIncome (duration, income) =
- truncate $ duration * fromIntegral income / (nominalDay * 365 / 12)
-
-nominalDay :: NominalDiffTime
-nominalDay = 86400
-
-safeHead :: [a] -> Maybe a
-safeHead [] = Nothing
-safeHead (x : _) = Just x
-
-safeMinimum :: (Ord a) => [a] -> Maybe a
-safeMinimum [] = Nothing
-safeMinimum xs = Just . minimum $ xs
-
-safeMaximum :: (Ord a) => [a] -> Maybe a
-safeMaximum [] = Nothing
-safeMaximum xs = Just . maximum $ xs
-
-totalPayments :: (Payment -> Bool) -> UserId -> [Payment] -> Int
-totalPayments paymentFilter userId payments =
- sum
- . map _payment_cost
- . filter (\payment -> paymentFilter payment && _payment_user payment == userId)
- $ payments
diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs
index 37a090d..c232fc7 100644
--- a/common/src/Common/Model/Payment.hs
+++ b/common/src/Common/Model/Payment.hs
@@ -10,6 +10,7 @@ import Data.Time (UTCTime)
import Data.Time.Calendar (Day)
import GHC.Generics (Generic)
+import Common.Model.Category (CategoryId)
import Common.Model.Frequency
import Common.Model.User (UserId)
@@ -21,6 +22,7 @@ data Payment = Payment
, _payment_name :: Text
, _payment_cost :: Int
, _payment_date :: Day
+ , _payment_category :: CategoryId
, _payment_frequency :: Frequency
, _payment_createdAt :: UTCTime
, _payment_editedAt :: Maybe UTCTime
diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs
deleted file mode 100644
index 2a559ce..0000000
--- a/common/src/Common/Model/PaymentCategory.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module Common.Model.PaymentCategory
- ( PaymentCategoryId
- , PaymentCategory(..)
- ) where
-
-import Data.Aeson (FromJSON, ToJSON)
-import Data.Int (Int64)
-import Data.Text (Text)
-import Data.Time (UTCTime)
-import GHC.Generics (Generic)
-
-import Common.Model.Category (CategoryId)
-
-type PaymentCategoryId = Int64
-
-data PaymentCategory = PaymentCategory
- { _paymentCategory_id :: PaymentCategoryId
- , _paymentCategory_name :: Text
- , _paymentCategory_category :: CategoryId
- , _paymentCategory_createdAt :: UTCTime
- , _paymentCategory_editedAt :: Maybe UTCTime
- } deriving (Show, Generic)
-
-instance FromJSON PaymentCategory
-instance ToJSON PaymentCategory
diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs
index 76c7511..3b18bb6 100644
--- a/common/src/Common/Model/PaymentPage.hs
+++ b/common/src/Common/Model/PaymentPage.hs
@@ -2,18 +2,17 @@ module Common.Model.PaymentPage
( PaymentPage(..)
) where
-import Data.Aeson (FromJSON, ToJSON)
-import GHC.Generics (Generic)
+import Data.Aeson (FromJSON, ToJSON)
+import GHC.Generics (Generic)
-import Common.Model.Payment (Payment)
-import Common.Model.PaymentCategory (PaymentCategory)
-import Common.Model.PaymentHeader (PaymentHeader)
+import Common.Model.Payment (Payment)
+import Common.Model.PaymentHeader (PaymentHeader)
data PaymentPage = PaymentPage
- { _paymentPage_header :: PaymentHeader
- , _paymentPage_payments :: [Payment]
- , _paymentPage_paymentCategories :: [PaymentCategory]
- , _paymentPage_totalCount :: Int
+ { _paymentPage_page :: Int
+ , _paymentPage_header :: PaymentHeader
+ , _paymentPage_payments :: [Payment]
+ , _paymentPage_totalCount :: Int
} deriving (Show, Generic)
instance FromJSON PaymentPage
diff --git a/common/src/Common/Model/SavedPayment.hs b/common/src/Common/Model/SavedPayment.hs
deleted file mode 100644
index f45c479..0000000
--- a/common/src/Common/Model/SavedPayment.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-module Common.Model.SavedPayment
- ( SavedPayment(..)
- ) where
-
-import Data.Aeson (FromJSON, ToJSON)
-import GHC.Generics (Generic)
-
-import Common.Model.Payment (Payment)
-import Common.Model.PaymentCategory (PaymentCategory)
-
-data SavedPayment = SavedPayment
- { _savedPayment_payment :: Payment
- , _savedPayment_paymentCategory :: PaymentCategory
- } deriving (Show, Generic)
-
-instance FromJSON SavedPayment
-instance ToJSON SavedPayment
diff --git a/common/src/Common/Util/Text.hs b/common/src/Common/Util/Text.hs
index d7f1db4..0f9c187 100644
--- a/common/src/Common/Util/Text.hs
+++ b/common/src/Common/Util/Text.hs
@@ -1,6 +1,7 @@
module Common.Util.Text
( search
, formatSearch
+ , unaccent
) where
import Data.Text (Text)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 21:49:30 +0000