Optimize and refactor payments

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)