From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 8 Nov 2017 23:47:26 +0100 Subject: Use a better project structure --- common/src/Common/Model/Category.hs | 26 +++++++++++++++++++++++ common/src/Common/Model/CreateCategory.hs | 16 +++++++++++++++ common/src/Common/Model/CreateIncome.hs | 16 +++++++++++++++ common/src/Common/Model/CreatePayment.hs | 23 +++++++++++++++++++++ common/src/Common/Model/Currency.hs | 14 +++++++++++++ common/src/Common/Model/EditCategory.hs | 19 +++++++++++++++++ common/src/Common/Model/EditIncome.hs | 19 +++++++++++++++++ common/src/Common/Model/EditPayment.hs | 25 ++++++++++++++++++++++ common/src/Common/Model/Frequency.hs | 16 +++++++++++++++ common/src/Common/Model/Income.hs | 29 ++++++++++++++++++++++++++ common/src/Common/Model/Init.hs | 28 +++++++++++++++++++++++++ common/src/Common/Model/InitResult.hs | 19 +++++++++++++++++ common/src/Common/Model/Payment.hs | 33 ++++++++++++++++++++++++++++++ common/src/Common/Model/PaymentCategory.hs | 27 ++++++++++++++++++++++++ common/src/Common/Model/SignIn.hs | 16 +++++++++++++++ common/src/Common/Model/User.hs | 29 ++++++++++++++++++++++++++ 16 files changed, 355 insertions(+) create mode 100644 common/src/Common/Model/Category.hs create mode 100644 common/src/Common/Model/CreateCategory.hs create mode 100644 common/src/Common/Model/CreateIncome.hs create mode 100644 common/src/Common/Model/CreatePayment.hs create mode 100644 common/src/Common/Model/Currency.hs create mode 100644 common/src/Common/Model/EditCategory.hs create mode 100644 common/src/Common/Model/EditIncome.hs create mode 100644 common/src/Common/Model/EditPayment.hs create mode 100644 common/src/Common/Model/Frequency.hs create mode 100644 common/src/Common/Model/Income.hs create mode 100644 common/src/Common/Model/Init.hs create mode 100644 common/src/Common/Model/InitResult.hs create mode 100644 common/src/Common/Model/Payment.hs create mode 100644 common/src/Common/Model/PaymentCategory.hs create mode 100644 common/src/Common/Model/SignIn.hs create mode 100644 common/src/Common/Model/User.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs new file mode 100644 index 0000000..53a6bdb --- /dev/null +++ b/common/src/Common/Model/Category.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Category + ( CategoryId + , Category(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +type CategoryId = Int64 + +data Category = Category + { _category_id :: CategoryId + , _category_name :: Text + , _category_color :: Text + , _category_createdAt :: UTCTime + , _category_editedAt :: Maybe UTCTime + , _category_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Category +instance ToJSON Category diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs new file mode 100644 index 0000000..bfe24c5 --- /dev/null +++ b/common/src/Common/Model/CreateCategory.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreateCategory + ( CreateCategory(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateCategory = CreateCategory + { _createCategory_name :: Text + , _createCategory_color :: Text + } deriving (Show, Generic) + +instance FromJSON CreateCategory diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs new file mode 100644 index 0000000..4ee3a50 --- /dev/null +++ b/common/src/Common/Model/CreateIncome.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreateIncome + ( CreateIncome(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +data CreateIncome = CreateIncome + { _createIncome_date :: Day + , _createIncome_amount :: Int + } deriving (Show, Generic) + +instance FromJSON CreateIncome diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs new file mode 100644 index 0000000..b5b6256 --- /dev/null +++ b/common/src/Common/Model/CreatePayment.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.CreatePayment + ( CreatePayment(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) + +data CreatePayment = CreatePayment + { _createPayment_name :: Text + , _createPayment_cost :: Int + , _createPayment_date :: Day + , _createPayment_category :: CategoryId + , _createPayment_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON CreatePayment diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs new file mode 100644 index 0000000..7c12545 --- /dev/null +++ b/common/src/Common/Model/Currency.hs @@ -0,0 +1,14 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Currency + ( Currency(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Currency = Currency Text deriving (Show, Generic) + +instance FromJSON Currency +instance ToJSON Currency diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs new file mode 100644 index 0000000..2a3a697 --- /dev/null +++ b/common/src/Common/Model/EditCategory.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditCategory + ( EditCategory(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) + +data EditCategory = EditCategory + { _editCategory_id :: CategoryId + , _editCategory_name :: Text + , _editCategory_color :: Text + } deriving (Show, Generic) + +instance FromJSON EditCategory diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs new file mode 100644 index 0000000..a55c39e --- /dev/null +++ b/common/src/Common/Model/EditIncome.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditIncome + ( EditIncome(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Income (IncomeId) + +data EditIncome = EditIncome + { _editIncome_id :: IncomeId + , _editIncome_date :: Day + , _editIncome_amount :: Int + } deriving (Show, Generic) + +instance FromJSON EditIncome diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs new file mode 100644 index 0000000..172c0c1 --- /dev/null +++ b/common/src/Common/Model/EditPayment.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.EditPayment + ( EditPayment(..) + ) where + +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) + +data EditPayment = EditPayment + { _editPayment_id :: PaymentId + , _editPayment_name :: Text + , _editPayment_cost :: Int + , _editPayment_date :: Day + , _editPayment_category :: CategoryId + , _editPayment_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON EditPayment diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs new file mode 100644 index 0000000..7c46605 --- /dev/null +++ b/common/src/Common/Model/Frequency.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Frequency + ( Frequency(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +data Frequency = + Punctual + | Monthly + deriving (Eq, Read, Show, Generic) + +instance FromJSON Frequency +instance ToJSON Frequency diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs new file mode 100644 index 0000000..280812f --- /dev/null +++ b/common/src/Common/Model/Income.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Income + ( IncomeId + , Income(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +type IncomeId = Int64 + +data Income = Income + { _income_id :: IncomeId + , _income_userId :: UserId + , _income_date :: Day + , _income_amount :: Int + , _income_createdAt :: UTCTime + , _income_editedAt :: Maybe UTCTime + , _income_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Income +instance ToJSON Income diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs new file mode 100644 index 0000000..68fcfb8 --- /dev/null +++ b/common/src/Common/Model/Init.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Init + ( Init(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Category (Category) +import Common.Model.Currency (Currency) +import Common.Model.Income (Income) +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.User (UserId, User) + +data Init = Init + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_payments :: [Payment] + , _init_incomes :: [Income] + , _init_categories :: [Category] + , _init_paymentCategories :: [PaymentCategory] + , _init_currency :: Currency + } deriving (Show, Generic) + +instance FromJSON Init +instance ToJSON Init diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs new file mode 100644 index 0000000..43c16f9 --- /dev/null +++ b/common/src/Common/Model/InitResult.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.InitResult + ( InitResult(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Init (Init) + +data InitResult = + InitSuccess Init + | InitEmpty (Either Text (Maybe Text)) + deriving (Show, Generic) + +instance FromJSON InitResult +instance ToJSON InitResult diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs new file mode 100644 index 0000000..804b501 --- /dev/null +++ b/common/src/Common/Model/Payment.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.Payment + ( PaymentId + , Payment(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Frequency +import Common.Model.User (UserId) + +type PaymentId = Int64 + +data Payment = Payment + { _payment_id :: PaymentId + , _payment_user :: UserId + , _payment_name :: Text + , _payment_cost :: Int + , _payment_date :: Day + , _payment_frequency :: Frequency + , _payment_createdAt :: UTCTime + , _payment_editedAt :: Maybe UTCTime + , _payment_deletedAt :: Maybe UTCTime + } deriving (Show, Generic) + +instance FromJSON Payment +instance ToJSON Payment diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs new file mode 100644 index 0000000..a0e94f9 --- /dev/null +++ b/common/src/Common/Model/PaymentCategory.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE DeriveGeneric #-} + +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/SignIn.hs b/common/src/Common/Model/SignIn.hs new file mode 100644 index 0000000..f4da97f --- /dev/null +++ b/common/src/Common/Model/SignIn.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.SignIn + ( SignIn(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SignIn = SignIn + { _signIn_email :: Text + } deriving (Show, Generic) + +instance FromJSON SignIn +instance ToJSON SignIn diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs new file mode 100644 index 0000000..694c70e --- /dev/null +++ b/common/src/Common/Model/User.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Common.Model.User + ( UserId + , User(..) + , findUser + ) where + +import Data.Aeson (FromJSON, ToJSON) +import qualified Data.List as L +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) + +type UserId = Int64 + +data User = User + { _user_id :: UserId + , _user_creation :: UTCTime + , _user_email :: Text + , _user_name :: Text + } deriving (Show, Generic) + +instance FromJSON User +instance ToJSON User + +findUser :: UserId -> [User] -> Maybe User +findUser userId users = L.find ((== userId) . _user_id) users -- cgit v1.2.3 From 5a63f7be9375e3ab888e4232dd7ef72c2f1ffae1 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 13 Nov 2017 23:56:40 +0100 Subject: Setup stylish-haskell --- common/src/Common/Model/Category.hs | 18 +++++++++--------- common/src/Common/Model/CreateCategory.hs | 8 ++++---- common/src/Common/Model/CreateIncome.hs | 8 ++++---- common/src/Common/Model/CreatePayment.hs | 20 ++++++++++---------- common/src/Common/Model/Currency.hs | 6 +++--- common/src/Common/Model/EditCategory.hs | 12 ++++++------ common/src/Common/Model/EditIncome.hs | 12 ++++++------ common/src/Common/Model/EditPayment.hs | 24 ++++++++++++------------ common/src/Common/Model/Frequency.hs | 4 ++-- common/src/Common/Model/Income.hs | 22 +++++++++++----------- common/src/Common/Model/Init.hs | 28 ++++++++++++++-------------- common/src/Common/Model/InitResult.hs | 8 ++++---- common/src/Common/Model/Payment.hs | 28 ++++++++++++++-------------- common/src/Common/Model/PaymentCategory.hs | 20 ++++++++++---------- common/src/Common/Model/SignIn.hs | 6 +++--- common/src/Common/Model/User.hs | 18 +++++++++--------- 16 files changed, 121 insertions(+), 121 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index 53a6bdb..bbd3c33 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -5,20 +5,20 @@ module Common.Model.Category , Category(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) type CategoryId = Int64 data Category = Category - { _category_id :: CategoryId - , _category_name :: Text - , _category_color :: Text + { _category_id :: CategoryId + , _category_name :: Text + , _category_color :: Text , _category_createdAt :: UTCTime - , _category_editedAt :: Maybe UTCTime + , _category_editedAt :: Maybe UTCTime , _category_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs index bfe24c5..11d84e9 100644 --- a/common/src/Common/Model/CreateCategory.hs +++ b/common/src/Common/Model/CreateCategory.hs @@ -4,12 +4,12 @@ module Common.Model.CreateCategory ( CreateCategory(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) data CreateCategory = CreateCategory - { _createCategory_name :: Text + { _createCategory_name :: Text , _createCategory_color :: Text } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs index 4ee3a50..583ebbb 100644 --- a/common/src/Common/Model/CreateIncome.hs +++ b/common/src/Common/Model/CreateIncome.hs @@ -4,12 +4,12 @@ module Common.Model.CreateIncome ( CreateIncome(..) ) where -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) data CreateIncome = CreateIncome - { _createIncome_date :: Day + { _createIncome_date :: Day , _createIncome_amount :: Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index b5b6256..7a283e5 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -4,19 +4,19 @@ module Common.Model.CreatePayment ( CreatePayment(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) data CreatePayment = CreatePayment - { _createPayment_name :: Text - , _createPayment_cost :: Int - , _createPayment_date :: Day - , _createPayment_category :: CategoryId + { _createPayment_name :: Text + , _createPayment_cost :: Int + , _createPayment_date :: Day + , _createPayment_category :: CategoryId , _createPayment_frequency :: Frequency } deriving (Show, Generic) diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs index 7c12545..6d74ea7 100644 --- a/common/src/Common/Model/Currency.hs +++ b/common/src/Common/Model/Currency.hs @@ -4,9 +4,9 @@ module Common.Model.Currency ( Currency(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) newtype Currency = Currency Text deriving (Show, Generic) diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs index 2a3a697..5b08b86 100644 --- a/common/src/Common/Model/EditCategory.hs +++ b/common/src/Common/Model/EditCategory.hs @@ -4,15 +4,15 @@ module Common.Model.EditCategory ( EditCategory(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) +import Common.Model.Category (CategoryId) data EditCategory = EditCategory - { _editCategory_id :: CategoryId - , _editCategory_name :: Text + { _editCategory_id :: CategoryId + , _editCategory_name :: Text , _editCategory_color :: Text } deriving (Show, Generic) diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs index a55c39e..867b406 100644 --- a/common/src/Common/Model/EditIncome.hs +++ b/common/src/Common/Model/EditIncome.hs @@ -4,15 +4,15 @@ module Common.Model.EditIncome ( EditIncome(..) ) where -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Income (IncomeId) +import Common.Model.Income (IncomeId) data EditIncome = EditIncome - { _editIncome_id :: IncomeId - , _editIncome_date :: Day + { _editIncome_id :: IncomeId + , _editIncome_date :: Day , _editIncome_amount :: Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index 172c0c1..32228f0 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -4,21 +4,21 @@ module Common.Model.EditPayment ( EditPayment(..) ) where -import Data.Aeson (FromJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON) +import Data.Text (Text) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) -import Common.Model.Payment (PaymentId) +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) data EditPayment = EditPayment - { _editPayment_id :: PaymentId - , _editPayment_name :: Text - , _editPayment_cost :: Int - , _editPayment_date :: Day - , _editPayment_category :: CategoryId + { _editPayment_id :: PaymentId + , _editPayment_name :: Text + , _editPayment_cost :: Int + , _editPayment_date :: Day + , _editPayment_category :: CategoryId , _editPayment_frequency :: Frequency } deriving (Show, Generic) diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index 7c46605..085163d 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -4,8 +4,8 @@ module Common.Model.Frequency ( Frequency(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) data Frequency = Punctual diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 280812f..10b4cf2 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -5,23 +5,23 @@ module Common.Model.Income , Income(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Time (UTCTime) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.User (UserId) +import Common.Model.User (UserId) type IncomeId = Int64 data Income = Income - { _income_id :: IncomeId - , _income_userId :: UserId - , _income_date :: Day - , _income_amount :: Int + { _income_id :: IncomeId + , _income_userId :: UserId + , _income_date :: Day + , _income_amount :: Int , _income_createdAt :: UTCTime - , _income_editedAt :: Maybe UTCTime + , _income_editedAt :: Maybe UTCTime , _income_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index 68fcfb8..ae23bb5 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -4,24 +4,24 @@ module Common.Model.Init ( Init(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) -import Common.Model.Category (Category) -import Common.Model.Currency (Currency) -import Common.Model.Income (Income) -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) -import Common.Model.User (UserId, User) +import Common.Model.Category (Category) +import Common.Model.Currency (Currency) +import Common.Model.Income (Income) +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.User (User, UserId) data Init = Init - { _init_users :: [User] - , _init_currentUser :: UserId - , _init_payments :: [Payment] - , _init_incomes :: [Income] - , _init_categories :: [Category] + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_payments :: [Payment] + , _init_incomes :: [Income] + , _init_categories :: [Category] , _init_paymentCategories :: [PaymentCategory] - , _init_currency :: Currency + , _init_currency :: Currency } deriving (Show, Generic) instance FromJSON Init diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 43c16f9..12be65a 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -4,11 +4,11 @@ module Common.Model.InitResult ( InitResult(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) -import Common.Model.Init (Init) +import Common.Model.Init (Init) data InitResult = InitSuccess Init diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index 804b501..4741058 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -5,27 +5,27 @@ module Common.Model.Payment , Payment(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.Frequency -import Common.Model.User (UserId) +import Common.Model.Frequency +import Common.Model.User (UserId) type PaymentId = Int64 data Payment = Payment - { _payment_id :: PaymentId - , _payment_user :: UserId - , _payment_name :: Text - , _payment_cost :: Int - , _payment_date :: Day + { _payment_id :: PaymentId + , _payment_user :: UserId + , _payment_name :: Text + , _payment_cost :: Int + , _payment_date :: Day , _payment_frequency :: Frequency , _payment_createdAt :: UTCTime - , _payment_editedAt :: Maybe UTCTime + , _payment_editedAt :: Maybe UTCTime , _payment_deletedAt :: Maybe UTCTime } deriving (Show, Generic) diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs index a0e94f9..24cf9e1 100644 --- a/common/src/Common/Model/PaymentCategory.hs +++ b/common/src/Common/Model/PaymentCategory.hs @@ -5,22 +5,22 @@ module Common.Model.PaymentCategory , PaymentCategory(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +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) +import Common.Model.Category (CategoryId) type PaymentCategoryId = Int64 data PaymentCategory = PaymentCategory - { _paymentCategory_id :: PaymentCategoryId - , _paymentCategory_name :: Text - , _paymentCategory_category :: CategoryId + { _paymentCategory_id :: PaymentCategoryId + , _paymentCategory_name :: Text + , _paymentCategory_category :: CategoryId , _paymentCategory_createdAt :: UTCTime - , _paymentCategory_editedAt :: Maybe UTCTime + , _paymentCategory_editedAt :: Maybe UTCTime } deriving (Show, Generic) instance FromJSON PaymentCategory diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs index f4da97f..baccd88 100644 --- a/common/src/Common/Model/SignIn.hs +++ b/common/src/Common/Model/SignIn.hs @@ -4,9 +4,9 @@ module Common.Model.SignIn ( SignIn(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) data SignIn = SignIn { _signIn_email :: Text diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs index 694c70e..e491c31 100644 --- a/common/src/Common/Model/User.hs +++ b/common/src/Common/Model/User.hs @@ -6,20 +6,20 @@ module Common.Model.User , findUser ) where -import Data.Aeson (FromJSON, ToJSON) -import qualified Data.List as L -import Data.Int (Int64) -import Data.Text (Text) -import Data.Time (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int64) +import qualified Data.List as L +import Data.Text (Text) +import Data.Time (UTCTime) +import GHC.Generics (Generic) type UserId = Int64 data User = User - { _user_id :: UserId + { _user_id :: UserId , _user_creation :: UTCTime - , _user_email :: Text - , _user_name :: Text + , _user_email :: Text + , _user_name :: Text } deriving (Show, Generic) instance FromJSON User -- cgit v1.2.3 From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- common/src/Common/Model/Category.hs | 2 -- common/src/Common/Model/CreateCategory.hs | 2 -- common/src/Common/Model/CreateIncome.hs | 2 -- common/src/Common/Model/CreatePayment.hs | 2 -- common/src/Common/Model/Currency.hs | 2 -- common/src/Common/Model/EditCategory.hs | 2 -- common/src/Common/Model/EditIncome.hs | 2 -- common/src/Common/Model/EditPayment.hs | 2 -- common/src/Common/Model/Frequency.hs | 2 -- common/src/Common/Model/Income.hs | 2 -- common/src/Common/Model/Init.hs | 2 -- common/src/Common/Model/InitResult.hs | 2 -- common/src/Common/Model/Payment.hs | 2 -- common/src/Common/Model/PaymentCategory.hs | 2 -- common/src/Common/Model/SignIn.hs | 2 -- common/src/Common/Model/User.hs | 2 -- 16 files changed, 32 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index bbd3c33..db1da53 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Category ( CategoryId , Category(..) diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs index 11d84e9..51bd2a0 100644 --- a/common/src/Common/Model/CreateCategory.hs +++ b/common/src/Common/Model/CreateCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreateCategory ( CreateCategory(..) ) where diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs index 583ebbb..644a51c 100644 --- a/common/src/Common/Model/CreateIncome.hs +++ b/common/src/Common/Model/CreateIncome.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreateIncome ( CreateIncome(..) ) where diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index 7a283e5..8e2ab73 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.CreatePayment ( CreatePayment(..) ) where diff --git a/common/src/Common/Model/Currency.hs b/common/src/Common/Model/Currency.hs index 6d74ea7..175aeba 100644 --- a/common/src/Common/Model/Currency.hs +++ b/common/src/Common/Model/Currency.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Currency ( Currency(..) ) where diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs index 5b08b86..8b9d9eb 100644 --- a/common/src/Common/Model/EditCategory.hs +++ b/common/src/Common/Model/EditCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditCategory ( EditCategory(..) ) where diff --git a/common/src/Common/Model/EditIncome.hs b/common/src/Common/Model/EditIncome.hs index 867b406..0e65f12 100644 --- a/common/src/Common/Model/EditIncome.hs +++ b/common/src/Common/Model/EditIncome.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditIncome ( EditIncome(..) ) where diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index 32228f0..d2c223f 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.EditPayment ( EditPayment(..) ) where diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index 085163d..ee502e8 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Frequency ( Frequency(..) ) where diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 10b4cf2..0423704 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Income ( IncomeId , Income(..) diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index ae23bb5..68b3f5d 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Init ( Init(..) ) where diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 12be65a..542e6c7 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.InitResult ( InitResult(..) ) where diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index 4741058..37a090d 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.Payment ( PaymentId , Payment(..) diff --git a/common/src/Common/Model/PaymentCategory.hs b/common/src/Common/Model/PaymentCategory.hs index 24cf9e1..2a559ce 100644 --- a/common/src/Common/Model/PaymentCategory.hs +++ b/common/src/Common/Model/PaymentCategory.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.PaymentCategory ( PaymentCategoryId , PaymentCategory(..) diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs index baccd88..bfd7fbc 100644 --- a/common/src/Common/Model/SignIn.hs +++ b/common/src/Common/Model/SignIn.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.SignIn ( SignIn(..) ) where diff --git a/common/src/Common/Model/User.hs b/common/src/Common/Model/User.hs index e491c31..a30d104 100644 --- a/common/src/Common/Model/User.hs +++ b/common/src/Common/Model/User.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} - module Common.Model.User ( UserId , User(..) -- cgit v1.2.3 From bab2c30addf8aaed85675e2b7f7b15c97c426f74 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 15:00:07 +0100 Subject: Add exceeding payer block --- common/src/Common/Model/Payer.hs | 198 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 198 insertions(+) create mode 100644 common/src/Common/Model/Payer.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs new file mode 100644 index 0000000..d09dbf6 --- /dev/null +++ b/common/src/Common/Model/Payer.hs @@ -0,0 +1,198 @@ +module Common.Model.Payer + ( getExceedingPayers + , ExceedingPayer(..) + ) 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 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 + } + +data ExceedingPayer = ExceedingPayer + { _exceedingPayer_userId :: UserId + , _exceedingPayer_amount :: Int + } deriving (Show) + +getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] +getExceedingPayers currentTime users incomes payments = + let userIds = map _user_id users + payers = getPayers currentTime userIds incomes payments + exceedingPayersOnPreIncome = + exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers + mbSince = useIncomesFrom userIds incomes payments + 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] -> [Payment] -> Maybe UTCTime +useIncomesFrom userIds incomes payments = + let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments + mbIncomeTime = incomeDefinedForAll userIds incomes + in case (firstPaymentTime, mbIncomeTime) of + (Just t1, Just t2) -> Just (max t1 t2) + _ -> Nothing + +paymentTime :: Payment -> UTCTime +paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date + +getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer] +getPayers currentTime userIds incomes payments = + let incomesDefined = incomeDefinedForAll userIds incomes + in flip map userIds (\userId -> Payer + { _payer_userId = userId + , _payer_preIncomePayments = + totalPayments + (\p -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined)) + userId + payments + , _payer_postIncomePayments = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> paymentTime 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 -> UTCTime -> 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 UTCTime +incomeDefinedForAll userIds incomes = + let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds + firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes + in if all Maybe.isJust firstIncomes + then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes + else Nothing + +cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int +cumulativeIncomesSince currentTime since incomes = + getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) + +getOrderedIncomesSince :: UTCTime -> [Income] -> [Income] +getOrderedIncomesSince time incomes = + let mbStarterIncome = getIncomeAt time incomes + orderedIncomesSince = filter (\income -> incomeTime income >= time) incomes + in (Maybe.maybeToList mbStarterIncome) ++ orderedIncomesSince + +getIncomeAt :: UTCTime -> [Income] -> Maybe Income +getIncomeAt time incomes = + case incomes of + [x] -> + if incomeTime x < time + then Just $ x { _income_date = utctDay time } + else Nothing + x1 : x2 : xs -> + if incomeTime x1 < time && incomeTime x2 >= time + then Just $ x1 { _income_date = utctDay time } + else getIncomeAt time (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 = flip UTCTime (Time.secondsToDiffTime 0) . _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 -- cgit v1.2.3 From ab17b6339d16970c3845ec4f153bfeed89eae728 Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 5 Jan 2018 14:45:47 +0100 Subject: Add modal component --- common/src/Common/Model/Frequency.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Frequency.hs b/common/src/Common/Model/Frequency.hs index ee502e8..48e75ea 100644 --- a/common/src/Common/Model/Frequency.hs +++ b/common/src/Common/Model/Frequency.hs @@ -8,7 +8,7 @@ import GHC.Generics (Generic) data Frequency = Punctual | Monthly - deriving (Eq, Read, Show, Generic) + deriving (Eq, Read, Show, Generic, Ord) instance FromJSON Frequency instance ToJSON Frequency -- cgit v1.2.3 From 33b85b7f12798f5762d940ed5c30f775cdd7b751 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Jan 2018 12:13:09 +0100 Subject: WIP --- common/src/Common/Model/CreatePayment.hs | 3 ++- common/src/Common/Model/InitResult.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index 8e2ab73..cd0b01d 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -2,7 +2,7 @@ module Common.Model.CreatePayment ( CreatePayment(..) ) where -import Data.Aeson (FromJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Data.Time.Calendar (Day) import GHC.Generics (Generic) @@ -19,3 +19,4 @@ data CreatePayment = CreatePayment } deriving (Show, Generic) instance FromJSON CreatePayment +instance ToJSON CreatePayment diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs index 542e6c7..f4c08a9 100644 --- a/common/src/Common/Model/InitResult.hs +++ b/common/src/Common/Model/InitResult.hs @@ -10,7 +10,8 @@ import Common.Model.Init (Init) data InitResult = InitSuccess Init - | InitEmpty (Either Text (Maybe Text)) + | InitError Text + | InitEmpty deriving (Show, Generic) instance FromJSON InitResult -- cgit v1.2.3 From 40b4994797a797b1fa86cafda789a5c488730c6d Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 28 Oct 2018 17:57:58 +0100 Subject: Delete payment --- common/src/Common/Model/CreatePayment.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs index cd0b01d..c61423c 100644 --- a/common/src/Common/Model/CreatePayment.hs +++ b/common/src/Common/Model/CreatePayment.hs @@ -1,5 +1,6 @@ module Common.Model.CreatePayment - ( CreatePayment(..) + ( CreatePaymentError(..) + , CreatePayment(..) ) where import Data.Aeson (FromJSON, ToJSON) @@ -10,6 +11,17 @@ import GHC.Generics (Generic) import Common.Model.Category (CategoryId) import Common.Model.Frequency (Frequency) +data CreatePaymentError = CreatePaymentError + { _createPaymentError_name :: Maybe Text + , _createPaymentError_cost :: Maybe Text + , _createPaymentError_date :: Maybe Text + , _createPaymentError_category :: Maybe Text + , _createPaymentError_frequency :: Maybe Text + } deriving (Show, Generic) + +instance FromJSON CreatePaymentError +instance ToJSON CreatePaymentError + data CreatePayment = CreatePayment { _createPayment_name :: Text , _createPayment_cost :: Int -- cgit v1.2.3 From 2741f47ef7b87255203bc2f7f7b2b9140c70b8f0 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 1 Nov 2018 13:14:25 +0100 Subject: Implementing client side validation --- common/src/Common/Model/Email.hs | 12 ++++++++++++ common/src/Common/Model/SignIn.hs | 14 -------------- common/src/Common/Model/SignInForm.hs | 14 ++++++++++++++ 3 files changed, 26 insertions(+), 14 deletions(-) create mode 100644 common/src/Common/Model/Email.hs delete mode 100644 common/src/Common/Model/SignIn.hs create mode 100644 common/src/Common/Model/SignInForm.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Email.hs b/common/src/Common/Model/Email.hs new file mode 100644 index 0000000..e938f83 --- /dev/null +++ b/common/src/Common/Model/Email.hs @@ -0,0 +1,12 @@ +module Common.Model.Email + ( Email(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Email = Email Text deriving (Show, Generic) + +instance FromJSON Email +instance ToJSON Email diff --git a/common/src/Common/Model/SignIn.hs b/common/src/Common/Model/SignIn.hs deleted file mode 100644 index bfd7fbc..0000000 --- a/common/src/Common/Model/SignIn.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.SignIn - ( SignIn(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -data SignIn = SignIn - { _signIn_email :: Text - } deriving (Show, Generic) - -instance FromJSON SignIn -instance ToJSON SignIn diff --git a/common/src/Common/Model/SignInForm.hs b/common/src/Common/Model/SignInForm.hs new file mode 100644 index 0000000..2b8c955 --- /dev/null +++ b/common/src/Common/Model/SignInForm.hs @@ -0,0 +1,14 @@ +module Common.Model.SignInForm + ( SignInForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data SignInForm = SignInForm + { _signIn_email :: Text + } deriving (Show, Generic) + +instance FromJSON SignInForm +instance ToJSON SignInForm -- cgit v1.2.3 From bc81084933f8ec1bfe6c2834defd12243117fdd9 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 5 Aug 2019 21:53:30 +0200 Subject: Use updated payment categories from payment add in payment’s table --- common/src/Common/Model/CreatedPayment.hs | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 common/src/Common/Model/CreatedPayment.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreatedPayment.hs b/common/src/Common/Model/CreatedPayment.hs new file mode 100644 index 0000000..c1bba29 --- /dev/null +++ b/common/src/Common/Model/CreatedPayment.hs @@ -0,0 +1,17 @@ +module Common.Model.CreatedPayment + ( CreatedPayment(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) + +data CreatedPayment = CreatedPayment + { _createdPayment_payment :: Payment + , _createdPayment_paymentCategory :: PaymentCategory + } deriving (Show, Generic) + +instance FromJSON CreatedPayment +instance ToJSON CreatedPayment -- cgit v1.2.3 From 2d79ab0e0a11f55255fc21a5dfab1598d3beeba3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 11 Aug 2019 22:40:09 +0200 Subject: Add payment clone --- common/src/Common/Model/CreatedPayment.hs | 17 ----------------- common/src/Common/Model/EditPayment.hs | 3 ++- common/src/Common/Model/SavedPayment.hs | 17 +++++++++++++++++ 3 files changed, 19 insertions(+), 18 deletions(-) delete mode 100644 common/src/Common/Model/CreatedPayment.hs create mode 100644 common/src/Common/Model/SavedPayment.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreatedPayment.hs b/common/src/Common/Model/CreatedPayment.hs deleted file mode 100644 index c1bba29..0000000 --- a/common/src/Common/Model/CreatedPayment.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Common.Model.CreatedPayment - ( CreatedPayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) - -data CreatedPayment = CreatedPayment - { _createdPayment_payment :: Payment - , _createdPayment_paymentCategory :: PaymentCategory - } deriving (Show, Generic) - -instance FromJSON CreatedPayment -instance ToJSON CreatedPayment diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs index d2c223f..8860b84 100644 --- a/common/src/Common/Model/EditPayment.hs +++ b/common/src/Common/Model/EditPayment.hs @@ -2,7 +2,7 @@ module Common.Model.EditPayment ( EditPayment(..) ) where -import Data.Aeson (FromJSON) +import Data.Aeson (FromJSON, ToJSON) import Data.Text (Text) import Data.Time.Calendar (Day) import GHC.Generics (Generic) @@ -21,3 +21,4 @@ data EditPayment = EditPayment } deriving (Show, Generic) instance FromJSON EditPayment +instance ToJSON EditPayment diff --git a/common/src/Common/Model/SavedPayment.hs b/common/src/Common/Model/SavedPayment.hs new file mode 100644 index 0000000..f45c479 --- /dev/null +++ b/common/src/Common/Model/SavedPayment.hs @@ -0,0 +1,17 @@ +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 -- cgit v1.2.3 From 7529a18ff0ac443e7f9764b5e2d0f57a5d3a850b Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 9 Oct 2019 23:16:00 +0200 Subject: Use common payment validation in the backend Remove deprecated backend validation --- common/src/Common/Model/CreatePayment.hs | 34 ---------------------------- common/src/Common/Model/CreatePaymentForm.hs | 21 +++++++++++++++++ common/src/Common/Model/EditPayment.hs | 24 -------------------- common/src/Common/Model/EditPaymentForm.hs | 23 +++++++++++++++++++ 4 files changed, 44 insertions(+), 58 deletions(-) delete mode 100644 common/src/Common/Model/CreatePayment.hs create mode 100644 common/src/Common/Model/CreatePaymentForm.hs delete mode 100644 common/src/Common/Model/EditPayment.hs create mode 100644 common/src/Common/Model/EditPaymentForm.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreatePayment.hs b/common/src/Common/Model/CreatePayment.hs deleted file mode 100644 index c61423c..0000000 --- a/common/src/Common/Model/CreatePayment.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Common.Model.CreatePayment - ( CreatePaymentError(..) - , CreatePayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) - -data CreatePaymentError = CreatePaymentError - { _createPaymentError_name :: Maybe Text - , _createPaymentError_cost :: Maybe Text - , _createPaymentError_date :: Maybe Text - , _createPaymentError_category :: Maybe Text - , _createPaymentError_frequency :: Maybe Text - } deriving (Show, Generic) - -instance FromJSON CreatePaymentError -instance ToJSON CreatePaymentError - -data CreatePayment = CreatePayment - { _createPayment_name :: Text - , _createPayment_cost :: Int - , _createPayment_date :: Day - , _createPayment_category :: CategoryId - , _createPayment_frequency :: Frequency - } deriving (Show, Generic) - -instance FromJSON CreatePayment -instance ToJSON CreatePayment diff --git a/common/src/Common/Model/CreatePaymentForm.hs b/common/src/Common/Model/CreatePaymentForm.hs new file mode 100644 index 0000000..60c5423 --- /dev/null +++ b/common/src/Common/Model/CreatePaymentForm.hs @@ -0,0 +1,21 @@ +module Common.Model.CreatePaymentForm + ( CreatePaymentForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) + +data CreatePaymentForm = CreatePaymentForm + { _createPaymentForm_name :: Text + , _createPaymentForm_cost :: Text + , _createPaymentForm_date :: Text + , _createPaymentForm_category :: CategoryId + , _createPaymentForm_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON CreatePaymentForm +instance ToJSON CreatePaymentForm diff --git a/common/src/Common/Model/EditPayment.hs b/common/src/Common/Model/EditPayment.hs deleted file mode 100644 index 8860b84..0000000 --- a/common/src/Common/Model/EditPayment.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Common.Model.EditPayment - ( EditPayment(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) -import Common.Model.Frequency (Frequency) -import Common.Model.Payment (PaymentId) - -data EditPayment = EditPayment - { _editPayment_id :: PaymentId - , _editPayment_name :: Text - , _editPayment_cost :: Int - , _editPayment_date :: Day - , _editPayment_category :: CategoryId - , _editPayment_frequency :: Frequency - } deriving (Show, Generic) - -instance FromJSON EditPayment -instance ToJSON EditPayment diff --git a/common/src/Common/Model/EditPaymentForm.hs b/common/src/Common/Model/EditPaymentForm.hs new file mode 100644 index 0000000..168c9ff --- /dev/null +++ b/common/src/Common/Model/EditPaymentForm.hs @@ -0,0 +1,23 @@ +module Common.Model.EditPaymentForm + ( EditPaymentForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.Frequency (Frequency) +import Common.Model.Payment (PaymentId) + +data EditPaymentForm = EditPaymentForm + { _editPaymentForm_id :: PaymentId + , _editPaymentForm_name :: Text + , _editPaymentForm_cost :: Text + , _editPaymentForm_date :: Text + , _editPaymentForm_category :: CategoryId + , _editPaymentForm_frequency :: Frequency + } deriving (Show, Generic) + +instance FromJSON EditPaymentForm +instance ToJSON EditPaymentForm -- cgit v1.2.3 From 284214d3af39143fdbeca57ffa4864389e7d517a Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 14 Oct 2019 09:10:33 +0200 Subject: Show cumulative incomes per user in income page --- common/src/Common/Model/Payer.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index d09dbf6..40228d5 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -1,6 +1,8 @@ module Common.Model.Payer - ( getExceedingPayers - , ExceedingPayer(..) + ( ExceedingPayer(..) + , getExceedingPayers + , useIncomesFrom + , cumulativeIncomesSince ) where import qualified Data.List as List -- cgit v1.2.3 From 7aadcc97f9df0e2daccbe8a8726d8bc6c63d67f4 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 12:02:21 +0200 Subject: Add income --- common/src/Common/Model/CreateIncome.hs | 14 -------------- common/src/Common/Model/CreateIncomeForm.hs | 15 +++++++++++++++ common/src/Common/Model/EditIncomeForm.hs | 18 ++++++++++++++++++ 3 files changed, 33 insertions(+), 14 deletions(-) delete mode 100644 common/src/Common/Model/CreateIncome.hs create mode 100644 common/src/Common/Model/CreateIncomeForm.hs create mode 100644 common/src/Common/Model/EditIncomeForm.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CreateIncome.hs b/common/src/Common/Model/CreateIncome.hs deleted file mode 100644 index 644a51c..0000000 --- a/common/src/Common/Model/CreateIncome.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.CreateIncome - ( CreateIncome(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Time.Calendar (Day) -import GHC.Generics (Generic) - -data CreateIncome = CreateIncome - { _createIncome_date :: Day - , _createIncome_amount :: Int - } deriving (Show, Generic) - -instance FromJSON CreateIncome diff --git a/common/src/Common/Model/CreateIncomeForm.hs b/common/src/Common/Model/CreateIncomeForm.hs new file mode 100644 index 0000000..e83bf0a --- /dev/null +++ b/common/src/Common/Model/CreateIncomeForm.hs @@ -0,0 +1,15 @@ +module Common.Model.CreateIncomeForm + ( CreateIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateIncomeForm = CreateIncomeForm + { _createIncomeForm_amount :: Text + , _createIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON CreateIncomeForm +instance ToJSON CreateIncomeForm diff --git a/common/src/Common/Model/EditIncomeForm.hs b/common/src/Common/Model/EditIncomeForm.hs new file mode 100644 index 0000000..ff975fc --- /dev/null +++ b/common/src/Common/Model/EditIncomeForm.hs @@ -0,0 +1,18 @@ +module Common.Model.EditIncomeForm + ( EditIncomeForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Income (IncomeId) + +data EditIncomeForm = EditIncomeForm + { _editIncomeForm_id :: IncomeId + , _editIncomeForm_amount :: Text + , _editIncomeForm_date :: Text + } deriving (Show, Generic) + +instance FromJSON EditIncomeForm +instance ToJSON EditIncomeForm -- cgit v1.2.3 From 602c52acfcfa494b07fec05c20b317b60ea8a6f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 20 Oct 2019 21:31:57 +0200 Subject: Load init data per page with AJAX --- common/src/Common/Model/Init.hs | 22 +++++++--------------- 1 file changed, 7 insertions(+), 15 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Init.hs b/common/src/Common/Model/Init.hs index 68b3f5d..5ef1535 100644 --- a/common/src/Common/Model/Init.hs +++ b/common/src/Common/Model/Init.hs @@ -2,24 +2,16 @@ module Common.Model.Init ( Init(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) -import Common.Model.Category (Category) -import Common.Model.Currency (Currency) -import Common.Model.Income (Income) -import Common.Model.Payment (Payment) -import Common.Model.PaymentCategory (PaymentCategory) -import Common.Model.User (User, UserId) +import Common.Model.Currency (Currency) +import Common.Model.User (User, UserId) data Init = Init - { _init_users :: [User] - , _init_currentUser :: UserId - , _init_payments :: [Payment] - , _init_incomes :: [Income] - , _init_categories :: [Category] - , _init_paymentCategories :: [PaymentCategory] - , _init_currency :: Currency + { _init_users :: [User] + , _init_currentUser :: UserId + , _init_currency :: Currency } deriving (Show, Generic) instance FromJSON Init -- cgit v1.2.3 From b97ad942495352c3fc1e0c820cfba82a9693ac7a Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 27 Oct 2019 20:26:29 +0100 Subject: WIP Set up server side paging for incomes --- common/src/Common/Model/IncomesAndCount.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 common/src/Common/Model/IncomesAndCount.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs new file mode 100644 index 0000000..4365180 --- /dev/null +++ b/common/src/Common/Model/IncomesAndCount.hs @@ -0,0 +1,16 @@ +module Common.Model.IncomesAndCount + ( IncomesAndCount(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Income (Income) + +data IncomesAndCount = IncomesAndCount + { _incomesAndCount_incomes :: [Income] + , _incomesAndCount_count :: Int + } deriving (Show, Generic) + +instance FromJSON IncomesAndCount +instance ToJSON IncomesAndCount -- cgit v1.2.3 From 9dbb4e6f7c2f0edc1126626e2ff498144c6b9947 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 11:28:42 +0100 Subject: Show income header --- common/src/Common/Model/IncomeHeader.hs | 18 ++++++++++++++++++ common/src/Common/Model/IncomePage.hs | 18 ++++++++++++++++++ common/src/Common/Model/IncomesAndCount.hs | 16 ---------------- 3 files changed, 36 insertions(+), 16 deletions(-) create mode 100644 common/src/Common/Model/IncomeHeader.hs create mode 100644 common/src/Common/Model/IncomePage.hs delete mode 100644 common/src/Common/Model/IncomesAndCount.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs new file mode 100644 index 0000000..a1defdf --- /dev/null +++ b/common/src/Common/Model/IncomeHeader.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomeHeader + ( IncomeHeader(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Clock (UTCTime) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +data IncomeHeader = IncomeHeader + { _incomeHeader_since :: Maybe UTCTime + , _incomeHeader_byUser :: Map UserId Int + } deriving (Show, Generic) + +instance FromJSON IncomeHeader +instance ToJSON IncomeHeader diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs new file mode 100644 index 0000000..c3f478e --- /dev/null +++ b/common/src/Common/Model/IncomePage.hs @@ -0,0 +1,18 @@ +module Common.Model.IncomePage + ( IncomePage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Income (Income) +import Common.Model.IncomeHeader (IncomeHeader) + +data IncomePage = IncomePage + { _incomePage_header :: IncomeHeader + , _incomePage_incomes :: [Income] + , _incomePage_totalCount :: Int + } deriving (Show, Generic) + +instance FromJSON IncomePage +instance ToJSON IncomePage diff --git a/common/src/Common/Model/IncomesAndCount.hs b/common/src/Common/Model/IncomesAndCount.hs deleted file mode 100644 index 4365180..0000000 --- a/common/src/Common/Model/IncomesAndCount.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Common.Model.IncomesAndCount - ( IncomesAndCount(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import GHC.Generics (Generic) - -import Common.Model.Income (Income) - -data IncomesAndCount = IncomesAndCount - { _incomesAndCount_incomes :: [Income] - , _incomesAndCount_count :: Int - } deriving (Show, Generic) - -instance FromJSON IncomesAndCount -instance ToJSON IncomesAndCount -- cgit v1.2.3 From 0f85cbd8ee736b1996e3966bac1f5e47ed7d27a9 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 3 Nov 2019 15:47:11 +0100 Subject: Fetch the first payment date instead of every payment to get cumulative income --- common/src/Common/Model/IncomeHeader.hs | 12 +++--- common/src/Common/Model/Payer.hs | 71 ++++++++++++++++++--------------- 2 files changed, 45 insertions(+), 38 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs index a1defdf..87c7aae 100644 --- a/common/src/Common/Model/IncomeHeader.hs +++ b/common/src/Common/Model/IncomeHeader.hs @@ -2,15 +2,15 @@ module Common.Model.IncomeHeader ( IncomeHeader(..) ) where -import Data.Aeson (FromJSON, ToJSON) -import Data.Map (Map) -import Data.Time.Clock (UTCTime) -import GHC.Generics (Generic) +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) -import Common.Model.User (UserId) +import Common.Model.User (UserId) data IncomeHeader = IncomeHeader - { _incomeHeader_since :: Maybe UTCTime + { _incomeHeader_since :: Maybe Day , _incomeHeader_byUser :: Map UserId Int } deriving (Show, Generic) diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index 40228d5..3c816c8 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -9,6 +9,7 @@ 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.Income (Income (..)) import Common.Model.Payment (Payment (..)) @@ -36,10 +37,11 @@ data ExceedingPayer = ExceedingPayer getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] getExceedingPayers currentTime users incomes payments = let userIds = map _user_id users - payers = getPayers currentTime userIds incomes payments + payers = getPayers userIds incomes payments exceedingPayersOnPreIncome = exceedingPayersFromAmounts . map (\p -> (_payer_userId p, _payer_preIncomePayments p)) $ payers - mbSince = useIncomesFrom userIds incomes payments + 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 @@ -54,25 +56,30 @@ getExceedingPayers currentTime users incomes payments = _ -> exceedingPayersOnPreIncome -useIncomesFrom :: [UserId] -> [Income] -> [Payment] -> Maybe UTCTime -useIncomesFrom userIds incomes payments = - let firstPaymentTime = safeHead . List.sort . map paymentTime $ payments - mbIncomeTime = incomeDefinedForAll userIds incomes - in case (firstPaymentTime, mbIncomeTime) of - (Just t1, Just t2) -> Just (max t1 t2) - _ -> Nothing +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 -paymentTime :: Payment -> UTCTime -paymentTime = flip UTCTime (Time.secondsToDiffTime 0) . _payment_date +dayUTCTime :: Day -> UTCTime +dayUTCTime = flip UTCTime (Time.secondsToDiffTime 0) -getPayers :: UTCTime -> [UserId] -> [Income] -> [Payment] -> [Payer] -getPayers currentTime userIds incomes payments = +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 -> paymentTime p < (Maybe.fromMaybe currentTime incomesDefined)) + (\p -> + case incomesDefined of + Just d -> + _payment_date p < d + + Nothing -> + True + ) userId payments , _payer_postIncomePayments = @@ -80,7 +87,7 @@ getPayers currentTime userIds incomes payments = (\p -> case incomesDefined of Nothing -> False - Just t -> paymentTime p >= t + Just t -> _payment_date p >= t ) userId payments @@ -104,7 +111,7 @@ exceedingPayersFromAmounts userAmounts = $ userAmounts where mbMinAmount = safeMinimum . map snd $ userAmounts -getPostPaymentPayer :: UTCTime -> UTCTime -> Payer -> PostPaymentPayer +getPostPaymentPayer :: UTCTime -> Day -> Payer -> PostPaymentPayer getPostPaymentPayer currentTime since payer = PostPaymentPayer { _postPaymentPayer_userId = _payer_userId payer @@ -120,35 +127,35 @@ getFinalDiff maxRatio payer = truncate $ -1.0 * (maxRatio - _postPaymentPayer_ratio payer) * (fromIntegral . _postPaymentPayer_cumulativeIncome $ payer) in postIncomeDiff + _postPaymentPayer_preIncomePayments payer -incomeDefinedForAll :: [UserId] -> [Income] -> Maybe UTCTime +incomeDefinedForAll :: [UserId] -> [Income] -> Maybe Day incomeDefinedForAll userIds incomes = let userIncomes = map (\userId -> filter ((==) userId . _income_userId) $ incomes) userIds - firstIncomes = map (safeHead . List.sortOn incomeTime) userIncomes + firstIncomes = map (safeHead . List.sortOn _income_date) userIncomes in if all Maybe.isJust firstIncomes - then safeHead . reverse . List.sort . map incomeTime . Maybe.catMaybes $ firstIncomes + then safeHead . reverse . List.sort . map _income_date . Maybe.catMaybes $ firstIncomes else Nothing -cumulativeIncomesSince :: UTCTime -> UTCTime -> [Income] -> Int +cumulativeIncomesSince :: UTCTime -> Day -> [Income] -> Int cumulativeIncomesSince currentTime since incomes = getCumulativeIncome currentTime (getOrderedIncomesSince since incomes) -getOrderedIncomesSince :: UTCTime -> [Income] -> [Income] -getOrderedIncomesSince time incomes = - let mbStarterIncome = getIncomeAt time incomes - orderedIncomesSince = filter (\income -> incomeTime income >= time) 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 :: UTCTime -> [Income] -> Maybe Income -getIncomeAt time incomes = +getIncomeAt :: Day -> [Income] -> Maybe Income +getIncomeAt day incomes = case incomes of [x] -> - if incomeTime x < time - then Just $ x { _income_date = utctDay time } + if _income_date x < day + then Just $ x { _income_date = day } else Nothing x1 : x2 : xs -> - if incomeTime x1 < time && incomeTime x2 >= time - then Just $ x1 { _income_date = utctDay time } - else getIncomeAt time (x2 : xs) + if _income_date x1 < day && _income_date x2 >= day + then Just $ x1 { _income_date = day } + else getIncomeAt day (x2 : xs) [] -> Nothing @@ -171,7 +178,7 @@ getIncomesWithDuration currentTime incomes = (Time.diffUTCTime (incomeTime income2) (incomeTime income1), _income_amount income1) : (getIncomesWithDuration currentTime (income2 : xs)) incomeTime :: Income -> UTCTime -incomeTime = flip UTCTime (Time.secondsToDiffTime 0) . _income_date +incomeTime = dayUTCTime . _income_date durationIncome :: (NominalDiffTime, Int) -> Int durationIncome (duration, income) = -- cgit v1.2.3 From f4f24158a46d8c0975f1b8813bbdbbeebad8c108 Mon Sep 17 00:00:00 2001 From: Joris Date: Wed, 6 Nov 2019 19:44:15 +0100 Subject: Show the payment table with server side paging --- common/src/Common/Model/PaymentPage.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 common/src/Common/Model/PaymentPage.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs new file mode 100644 index 0000000..31039c7 --- /dev/null +++ b/common/src/Common/Model/PaymentPage.hs @@ -0,0 +1,18 @@ +module Common.Model.PaymentPage + ( PaymentPage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Payment (Payment) +import Common.Model.PaymentCategory (PaymentCategory) + +data PaymentPage = PaymentPage + { _paymentPage_payments :: [Payment] + , _paymentPage_paymentCategories :: [PaymentCategory] + , _paymentPage_totalCount :: Int + } deriving (Show, Generic) + +instance FromJSON PaymentPage +instance ToJSON PaymentPage -- cgit v1.2.3 From 4dc84dbda7ba3ea60d13e6f81eeec556974b7c72 Mon Sep 17 00:00:00 2001 From: Joris Date: Thu, 7 Nov 2019 07:59:41 +0100 Subject: Show payment header infos --- common/src/Common/Model/ExceedingPayer.hs | 16 ++++++++++++++++ common/src/Common/Model/Payer.hs | 25 ++++++++++--------------- common/src/Common/Model/PaymentHeader.hs | 18 ++++++++++++++++++ common/src/Common/Model/PaymentPage.hs | 4 +++- 4 files changed, 47 insertions(+), 16 deletions(-) create mode 100644 common/src/Common/Model/ExceedingPayer.hs create mode 100644 common/src/Common/Model/PaymentHeader.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs new file mode 100644 index 0000000..171b6ff --- /dev/null +++ b/common/src/Common/Model/ExceedingPayer.hs @@ -0,0 +1,16 @@ +module Common.Model.ExceedingPayer + ( ExceedingPayer(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.User (UserId) + +data ExceedingPayer = ExceedingPayer + { _exceedingPayer_userId :: UserId + , _exceedingPayer_amount :: Int + } deriving (Show, Generic) + +instance FromJSON ExceedingPayer +instance ToJSON ExceedingPayer diff --git a/common/src/Common/Model/Payer.hs b/common/src/Common/Model/Payer.hs index 3c816c8..39a5788 100644 --- a/common/src/Common/Model/Payer.hs +++ b/common/src/Common/Model/Payer.hs @@ -1,19 +1,19 @@ module Common.Model.Payer - ( ExceedingPayer(..) - , getExceedingPayers + ( 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 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.Income (Income (..)) -import Common.Model.Payment (Payment (..)) -import Common.Model.User (User (..), UserId) +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 @@ -29,11 +29,6 @@ data PostPaymentPayer = PostPaymentPayer , _postPaymentPayer_ratio :: Float } -data ExceedingPayer = ExceedingPayer - { _exceedingPayer_userId :: UserId - , _exceedingPayer_amount :: Int - } deriving (Show) - getExceedingPayers :: UTCTime -> [User] -> [Income] -> [Payment] -> [ExceedingPayer] getExceedingPayers currentTime users incomes payments = let userIds = map _user_id users diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs new file mode 100644 index 0000000..a522cd8 --- /dev/null +++ b/common/src/Common/Model/PaymentHeader.hs @@ -0,0 +1,18 @@ +module Common.Model.PaymentHeader + ( PaymentHeader(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import GHC.Generics (Generic) + +import Common.Model.ExceedingPayer (ExceedingPayer) +import Common.Model.User (UserId) + +data PaymentHeader = PaymentHeader + { _paymentHeader_exceedingPayers :: [ExceedingPayer] + , _paymentHeader_repartition :: Map UserId Int + } deriving (Show, Generic) + +instance FromJSON PaymentHeader +instance ToJSON PaymentHeader diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 31039c7..76c7511 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -7,9 +7,11 @@ import GHC.Generics (Generic) import Common.Model.Payment (Payment) import Common.Model.PaymentCategory (PaymentCategory) +import Common.Model.PaymentHeader (PaymentHeader) data PaymentPage = PaymentPage - { _paymentPage_payments :: [Payment] + { _paymentPage_header :: PaymentHeader + , _paymentPage_payments :: [Payment] , _paymentPage_paymentCategories :: [PaymentCategory] , _paymentPage_totalCount :: Int } deriving (Show, Generic) -- cgit v1.2.3 From c0ea63f8c1a8c7123b78798cec99726b113fb1f3 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 18:08:28 +0100 Subject: Optimize and refactor payments --- common/src/Common/Model/Payer.hs | 202 ----------------------------- common/src/Common/Model/Payment.hs | 2 + common/src/Common/Model/PaymentCategory.hs | 25 ---- common/src/Common/Model/PaymentPage.hs | 17 ++- common/src/Common/Model/SavedPayment.hs | 17 --- 5 files changed, 10 insertions(+), 253 deletions(-) delete mode 100644 common/src/Common/Model/Payer.hs delete mode 100644 common/src/Common/Model/PaymentCategory.hs delete mode 100644 common/src/Common/Model/SavedPayment.hs (limited to 'common/src/Common/Model') 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 -- cgit v1.2.3 From 3c67fcf1d524811a18f0c4db3ef6eed1270b9a12 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 17 Nov 2019 19:55:22 +0100 Subject: Hide date from monthly payments --- common/src/Common/Model/PaymentPage.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 3b18bb6..94203a2 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -5,11 +5,13 @@ module Common.Model.PaymentPage import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) +import Common.Model.Frequency (Frequency) import Common.Model.Payment (Payment) import Common.Model.PaymentHeader (PaymentHeader) data PaymentPage = PaymentPage { _paymentPage_page :: Int + , _paymentPage_frequency :: Frequency , _paymentPage_header :: PaymentHeader , _paymentPage_payments :: [Payment] , _paymentPage_totalCount :: Int -- cgit v1.2.3 From 54628c70cb33de5e4309c35b9f6b57bbe9f7a07b Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 24 Nov 2019 16:19:53 +0100 Subject: Compute cumulative income with a DB query --- common/src/Common/Model/IncomePage.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs index c3f478e..0572141 100644 --- a/common/src/Common/Model/IncomePage.hs +++ b/common/src/Common/Model/IncomePage.hs @@ -9,7 +9,8 @@ import Common.Model.Income (Income) import Common.Model.IncomeHeader (IncomeHeader) data IncomePage = IncomePage - { _incomePage_header :: IncomeHeader + { _incomePage_page :: Int + , _incomePage_header :: IncomeHeader , _incomePage_incomes :: [Income] , _incomePage_totalCount :: Int } deriving (Show, Generic) -- cgit v1.2.3 From e622e8fdd2e40b4306b5cc724d8dfb76bf976242 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 25 Nov 2019 08:17:59 +0100 Subject: Remove Loadable2 --- common/src/Common/Model/ExceedingPayer.hs | 2 +- common/src/Common/Model/Income.hs | 2 +- common/src/Common/Model/IncomeHeader.hs | 2 +- common/src/Common/Model/IncomePage.hs | 2 +- common/src/Common/Model/Payment.hs | 2 +- common/src/Common/Model/PaymentHeader.hs | 2 +- common/src/Common/Model/PaymentPage.hs | 2 +- 7 files changed, 7 insertions(+), 7 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/ExceedingPayer.hs b/common/src/Common/Model/ExceedingPayer.hs index 171b6ff..b7d3efb 100644 --- a/common/src/Common/Model/ExceedingPayer.hs +++ b/common/src/Common/Model/ExceedingPayer.hs @@ -10,7 +10,7 @@ import Common.Model.User (UserId) data ExceedingPayer = ExceedingPayer { _exceedingPayer_userId :: UserId , _exceedingPayer_amount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON ExceedingPayer instance ToJSON ExceedingPayer diff --git a/common/src/Common/Model/Income.hs b/common/src/Common/Model/Income.hs index 0423704..57d07f1 100644 --- a/common/src/Common/Model/Income.hs +++ b/common/src/Common/Model/Income.hs @@ -21,7 +21,7 @@ data Income = Income , _income_createdAt :: UTCTime , _income_editedAt :: Maybe UTCTime , _income_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Income instance ToJSON Income diff --git a/common/src/Common/Model/IncomeHeader.hs b/common/src/Common/Model/IncomeHeader.hs index 87c7aae..7e712e8 100644 --- a/common/src/Common/Model/IncomeHeader.hs +++ b/common/src/Common/Model/IncomeHeader.hs @@ -12,7 +12,7 @@ import Common.Model.User (UserId) data IncomeHeader = IncomeHeader { _incomeHeader_since :: Maybe Day , _incomeHeader_byUser :: Map UserId Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON IncomeHeader instance ToJSON IncomeHeader diff --git a/common/src/Common/Model/IncomePage.hs b/common/src/Common/Model/IncomePage.hs index 0572141..977b0ea 100644 --- a/common/src/Common/Model/IncomePage.hs +++ b/common/src/Common/Model/IncomePage.hs @@ -13,7 +13,7 @@ data IncomePage = IncomePage , _incomePage_header :: IncomeHeader , _incomePage_incomes :: [Income] , _incomePage_totalCount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON IncomePage instance ToJSON IncomePage diff --git a/common/src/Common/Model/Payment.hs b/common/src/Common/Model/Payment.hs index c232fc7..733a145 100644 --- a/common/src/Common/Model/Payment.hs +++ b/common/src/Common/Model/Payment.hs @@ -27,7 +27,7 @@ data Payment = Payment , _payment_createdAt :: UTCTime , _payment_editedAt :: Maybe UTCTime , _payment_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Payment instance ToJSON Payment diff --git a/common/src/Common/Model/PaymentHeader.hs b/common/src/Common/Model/PaymentHeader.hs index a522cd8..35f5e1a 100644 --- a/common/src/Common/Model/PaymentHeader.hs +++ b/common/src/Common/Model/PaymentHeader.hs @@ -12,7 +12,7 @@ import Common.Model.User (UserId) data PaymentHeader = PaymentHeader { _paymentHeader_exceedingPayers :: [ExceedingPayer] , _paymentHeader_repartition :: Map UserId Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON PaymentHeader instance ToJSON PaymentHeader diff --git a/common/src/Common/Model/PaymentPage.hs b/common/src/Common/Model/PaymentPage.hs index 94203a2..88d9715 100644 --- a/common/src/Common/Model/PaymentPage.hs +++ b/common/src/Common/Model/PaymentPage.hs @@ -15,7 +15,7 @@ data PaymentPage = PaymentPage , _paymentPage_header :: PaymentHeader , _paymentPage_payments :: [Payment] , _paymentPage_totalCount :: Int - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON PaymentPage instance ToJSON PaymentPage -- cgit v1.2.3 From 316bda10c6bec8b5ccc9e23f1f677c076205f046 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 8 Dec 2019 11:39:37 +0100 Subject: Add category page --- common/src/Common/Model/Category.hs | 2 +- common/src/Common/Model/CategoryPage.hs | 17 +++++++++++++++++ common/src/Common/Model/CreateCategory.hs | 14 -------------- common/src/Common/Model/CreateCategoryForm.hs | 15 +++++++++++++++ common/src/Common/Model/EditCategory.hs | 17 ----------------- common/src/Common/Model/EditCategoryForm.hs | 18 ++++++++++++++++++ 6 files changed, 51 insertions(+), 32 deletions(-) create mode 100644 common/src/Common/Model/CategoryPage.hs delete mode 100644 common/src/Common/Model/CreateCategory.hs create mode 100644 common/src/Common/Model/CreateCategoryForm.hs delete mode 100644 common/src/Common/Model/EditCategory.hs create mode 100644 common/src/Common/Model/EditCategoryForm.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/Category.hs b/common/src/Common/Model/Category.hs index db1da53..cc3f795 100644 --- a/common/src/Common/Model/Category.hs +++ b/common/src/Common/Model/Category.hs @@ -18,7 +18,7 @@ data Category = Category , _category_createdAt :: UTCTime , _category_editedAt :: Maybe UTCTime , _category_deletedAt :: Maybe UTCTime - } deriving (Show, Generic) + } deriving (Eq, Show, Generic) instance FromJSON Category instance ToJSON Category diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs new file mode 100644 index 0000000..476b4ce --- /dev/null +++ b/common/src/Common/Model/CategoryPage.hs @@ -0,0 +1,17 @@ +module Common.Model.CategoryPage + ( CategoryPage(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import GHC.Generics (Generic) + +import Common.Model.Category (Category) + +data CategoryPage = CategoryPage + { _categoryPage_page :: Int + , _categoryPage_categories :: [Category] + , _categoryPage_totalCount :: Int + } deriving (Eq, Show, Generic) + +instance FromJSON CategoryPage +instance ToJSON CategoryPage diff --git a/common/src/Common/Model/CreateCategory.hs b/common/src/Common/Model/CreateCategory.hs deleted file mode 100644 index 51bd2a0..0000000 --- a/common/src/Common/Model/CreateCategory.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Common.Model.CreateCategory - ( CreateCategory(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -data CreateCategory = CreateCategory - { _createCategory_name :: Text - , _createCategory_color :: Text - } deriving (Show, Generic) - -instance FromJSON CreateCategory diff --git a/common/src/Common/Model/CreateCategoryForm.hs b/common/src/Common/Model/CreateCategoryForm.hs new file mode 100644 index 0000000..4668ef4 --- /dev/null +++ b/common/src/Common/Model/CreateCategoryForm.hs @@ -0,0 +1,15 @@ +module Common.Model.CreateCategoryForm + ( CreateCategoryForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +data CreateCategoryForm = CreateCategoryForm + { _createCategoryForm_name :: Text + , _createCategoryForm_color :: Text + } deriving (Show, Generic) + +instance FromJSON CreateCategoryForm +instance ToJSON CreateCategoryForm diff --git a/common/src/Common/Model/EditCategory.hs b/common/src/Common/Model/EditCategory.hs deleted file mode 100644 index 8b9d9eb..0000000 --- a/common/src/Common/Model/EditCategory.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Common.Model.EditCategory - ( EditCategory(..) - ) where - -import Data.Aeson (FromJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -import Common.Model.Category (CategoryId) - -data EditCategory = EditCategory - { _editCategory_id :: CategoryId - , _editCategory_name :: Text - , _editCategory_color :: Text - } deriving (Show, Generic) - -instance FromJSON EditCategory diff --git a/common/src/Common/Model/EditCategoryForm.hs b/common/src/Common/Model/EditCategoryForm.hs new file mode 100644 index 0000000..a2ceca0 --- /dev/null +++ b/common/src/Common/Model/EditCategoryForm.hs @@ -0,0 +1,18 @@ +module Common.Model.EditCategoryForm + ( EditCategoryForm(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) + +data EditCategoryForm = EditCategoryForm + { _editCategoryForm_id :: CategoryId + , _editCategoryForm_name :: Text + , _editCategoryForm_color :: Text + } deriving (Show, Generic) + +instance FromJSON EditCategoryForm +instance ToJSON EditCategoryForm -- cgit v1.2.3 From da2a0c13aa89705c65fdb9df2f496fb4eea29654 Mon Sep 17 00:00:00 2001 From: Joris Date: Sat, 4 Jan 2020 19:22:45 +0100 Subject: Allow to remove only unused categories --- common/src/Common/Model/CategoryPage.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/CategoryPage.hs b/common/src/Common/Model/CategoryPage.hs index 476b4ce..e20f49f 100644 --- a/common/src/Common/Model/CategoryPage.hs +++ b/common/src/Common/Model/CategoryPage.hs @@ -5,12 +5,13 @@ module Common.Model.CategoryPage import Data.Aeson (FromJSON, ToJSON) import GHC.Generics (Generic) -import Common.Model.Category (Category) +import Common.Model.Category (Category, CategoryId) data CategoryPage = CategoryPage - { _categoryPage_page :: Int - , _categoryPage_categories :: [Category] - , _categoryPage_totalCount :: Int + { _categoryPage_page :: Int + , _categoryPage_categories :: [Category] + , _categoryPage_usedCategories :: [CategoryId] + , _categoryPage_totalCount :: Int } deriving (Eq, Show, Generic) instance FromJSON CategoryPage -- cgit v1.2.3 From af8353c6164aaaaa836bfed181f883ac86bb76a5 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Jan 2020 14:03:31 +0100 Subject: Sign in with email and password --- common/src/Common/Model/InitResult.hs | 18 ------------------ common/src/Common/Model/Password.hs | 12 ++++++++++++ common/src/Common/Model/SignInForm.hs | 3 ++- 3 files changed, 14 insertions(+), 19 deletions(-) delete mode 100644 common/src/Common/Model/InitResult.hs create mode 100644 common/src/Common/Model/Password.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/InitResult.hs b/common/src/Common/Model/InitResult.hs deleted file mode 100644 index f4c08a9..0000000 --- a/common/src/Common/Model/InitResult.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Common.Model.InitResult - ( InitResult(..) - ) where - -import Data.Aeson (FromJSON, ToJSON) -import Data.Text (Text) -import GHC.Generics (Generic) - -import Common.Model.Init (Init) - -data InitResult = - InitSuccess Init - | InitError Text - | InitEmpty - deriving (Show, Generic) - -instance FromJSON InitResult -instance ToJSON InitResult diff --git a/common/src/Common/Model/Password.hs b/common/src/Common/Model/Password.hs new file mode 100644 index 0000000..1b51a47 --- /dev/null +++ b/common/src/Common/Model/Password.hs @@ -0,0 +1,12 @@ +module Common.Model.Password + ( Password(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Text (Text) +import GHC.Generics (Generic) + +newtype Password = Password Text deriving (Show, Generic) + +instance FromJSON Password +instance ToJSON Password diff --git a/common/src/Common/Model/SignInForm.hs b/common/src/Common/Model/SignInForm.hs index 2b8c955..7a25935 100644 --- a/common/src/Common/Model/SignInForm.hs +++ b/common/src/Common/Model/SignInForm.hs @@ -7,7 +7,8 @@ import Data.Text (Text) import GHC.Generics (Generic) data SignInForm = SignInForm - { _signIn_email :: Text + { _signInForm_email :: Text + , _signInForm_password :: Text } deriving (Show, Generic) instance FromJSON SignInForm -- cgit v1.2.3 From 47c2a4d6b68c54eed5f7b45671b1ccaf8c0db200 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 20 Jan 2020 19:47:23 +0100 Subject: Show payment stats --- common/src/Common/Model/PaymentStats.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 common/src/Common/Model/PaymentStats.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/PaymentStats.hs b/common/src/Common/Model/PaymentStats.hs new file mode 100644 index 0000000..2dea640 --- /dev/null +++ b/common/src/Common/Model/PaymentStats.hs @@ -0,0 +1,10 @@ +module Common.Model.PaymentStats + ( PaymentStats + ) where + +import Data.Map (Map) +import Data.Time.Calendar (Day) + +import Common.Model.Category (CategoryId) + +type PaymentStats = [(Day, Map CategoryId Int)] -- cgit v1.2.3 From 79e1d8b0099d61b580a499311f1714b1b7eb07b5 Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 27 Jan 2020 22:07:18 +0100 Subject: Show total incom by month in statistics --- common/src/Common/Model/PaymentStats.hs | 10 ---------- common/src/Common/Model/Stats.hs | 23 +++++++++++++++++++++++ 2 files changed, 23 insertions(+), 10 deletions(-) delete mode 100644 common/src/Common/Model/PaymentStats.hs create mode 100644 common/src/Common/Model/Stats.hs (limited to 'common/src/Common/Model') diff --git a/common/src/Common/Model/PaymentStats.hs b/common/src/Common/Model/PaymentStats.hs deleted file mode 100644 index 2dea640..0000000 --- a/common/src/Common/Model/PaymentStats.hs +++ /dev/null @@ -1,10 +0,0 @@ -module Common.Model.PaymentStats - ( PaymentStats - ) where - -import Data.Map (Map) -import Data.Time.Calendar (Day) - -import Common.Model.Category (CategoryId) - -type PaymentStats = [(Day, Map CategoryId Int)] diff --git a/common/src/Common/Model/Stats.hs b/common/src/Common/Model/Stats.hs new file mode 100644 index 0000000..86e6ab9 --- /dev/null +++ b/common/src/Common/Model/Stats.hs @@ -0,0 +1,23 @@ +module Common.Model.Stats + ( Stats + , MonthStats(..) + ) where + +import Data.Aeson (FromJSON, ToJSON) +import Data.Map (Map) +import Data.Time.Calendar (Day) +import GHC.Generics (Generic) + +import Common.Model.Category (CategoryId) +import Common.Model.User (UserId) + +type Stats = [MonthStats] + +data MonthStats = MonthStats + { _monthStats_start :: Day + , _monthStats_paymentsByCategory :: Map CategoryId Int + , _monthStats_incomeByUser :: Map UserId Int + } deriving (Eq, Show, Generic) + +instance FromJSON MonthStats +instance ToJSON MonthStats -- cgit v1.2.3