aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Model')
-rw-r--r--src/server/Model/Income.hs14
-rw-r--r--src/server/Model/Json/Income.hs6
-rw-r--r--src/server/Model/Payer.hs46
-rw-r--r--src/server/Model/Payer/Income.hs22
4 files changed, 13 insertions, 75 deletions
diff --git a/src/server/Model/Income.hs b/src/server/Model/Income.hs
index 70b9149..2177617 100644
--- a/src/server/Model/Income.hs
+++ b/src/server/Model/Income.hs
@@ -1,5 +1,5 @@
module Model.Income
- ( getIncome
+ ( getJsonIncome
, getFirstIncome
, getIncomes
, setIncome
@@ -12,13 +12,15 @@ import Control.Monad.IO.Class (liftIO)
import Database.Persist
import Model.Database
+import qualified Model.Json.Income as Json
-getIncome :: UserId -> Persist (Maybe Income)
-getIncome userId =
- fmap entityVal <$> selectFirst [IncomeUserId ==. userId] [Desc IncomeCreation]
+getJsonIncome :: Entity Income -> Json.Income
+getJsonIncome incomeEntity =
+ Json.Income (entityKey incomeEntity) (incomeUserId income) (incomeCreation income) (incomeAmount income)
+ where income = entityVal incomeEntity
-getIncomes :: Persist [Income]
-getIncomes = map entityVal <$> selectList [] []
+getIncomes :: Persist [Entity Income]
+getIncomes = selectList [] []
getFirstIncome :: UserId -> Persist (Maybe Income)
getFirstIncome userId =
diff --git a/src/server/Model/Json/Income.hs b/src/server/Model/Json/Income.hs
index 4549ca5..6ad331a 100644
--- a/src/server/Model/Json/Income.hs
+++ b/src/server/Model/Json/Income.hs
@@ -9,8 +9,12 @@ import GHC.Generics
import Data.Aeson
import Data.Time.Clock (UTCTime)
+import Model.Database (IncomeId, UserId)
+
data Income = Income
- { creation :: UTCTime
+ { id :: IncomeId
+ , userId :: UserId
+ , creation :: UTCTime
, amount :: Int
} deriving (Show, Generic)
diff --git a/src/server/Model/Payer.hs b/src/server/Model/Payer.hs
deleted file mode 100644
index 3893765..0000000
--- a/src/server/Model/Payer.hs
+++ /dev/null
@@ -1,46 +0,0 @@
-module Model.Payer
- ( getPayers
- )
- where
-
-import Control.Monad.IO.Class (liftIO)
-
-import Data.Time.Clock (getCurrentTime)
-import Data.List (find)
-import Data.Maybe (fromMaybe, fromMaybe)
-
-import Database.Persist
-
-import Model.Database
-import Model.Payer.Payment (getTotalPaymentsBefore, getTotalPaymentsAfter)
-import Model.Payer.Income (incomeDefinedForAll)
-import Model.User (getUsers)
-import Model.Income (getIncomes)
-
-import qualified Model.Json.Payer as Json
-import qualified Model.Json.Income as Json
-
-getPayers :: Persist [Json.Payer]
-getPayers = do
- userIds <- map entityKey <$> getUsers
- incomes <- getIncomes
- now <- liftIO getCurrentTime
- incomeIsDefined <- fromMaybe now <$> incomeDefinedForAll
- preIncomePaymentSums <- getTotalPaymentsBefore incomeIsDefined
- postIncomePaymentSums <- getTotalPaymentsAfter incomeIsDefined
- return $ map (getPayer incomes preIncomePaymentSums postIncomePaymentSums) userIds
-
-getPayer :: [Income] -> [(UserId, Int)] -> [(UserId, Int)] -> UserId -> Json.Payer
-getPayer incomes preIncomePaymentSums postIncomePaymentSums userId =
- Json.Payer
- { Json.userId = userId
- , Json.preIncomePaymentSum = findOrDefault userId 0 preIncomePaymentSums
- , Json.postIncomePaymentSum = findOrDefault userId 0 postIncomePaymentSums
- , Json.incomes =
- map (\income -> Json.Income (incomeCreation income) (incomeAmount income))
- . filter ((==) userId . incomeUserId)
- $ incomes
- }
-
-findOrDefault :: (Eq a) => a -> b -> [(a, b)] -> b
-findOrDefault a b = fromMaybe b . fmap snd . find ((==) a . fst)
diff --git a/src/server/Model/Payer/Income.hs b/src/server/Model/Payer/Income.hs
deleted file mode 100644
index f4bc9fd..0000000
--- a/src/server/Model/Payer/Income.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-module Model.Payer.Income
- ( incomeDefinedForAll
- ) where
-
-import Data.Time.Clock (UTCTime)
-import Data.List (sort)
-import Data.Maybe
-
-import Database.Persist
-
-import Model.Database
-import Model.User (getUsers)
-import Model.Income (getFirstIncome)
-
-incomeDefinedForAll :: Persist (Maybe UTCTime)
-incomeDefinedForAll = do
- userIds <- map entityKey <$> getUsers
- firstIncomes <- mapM getFirstIncome userIds
- return $
- if all isJust firstIncomes
- then listToMaybe . reverse . sort . map incomeCreation . catMaybes $ firstIncomes
- else Nothing