diff options
Diffstat (limited to 'src/server/Model')
-rw-r--r-- | src/server/Model/Income.hs | 14 | ||||
-rw-r--r-- | src/server/Model/Json/Income.hs | 6 | ||||
-rw-r--r-- | src/server/Model/Payer.hs | 46 | ||||
-rw-r--r-- | src/server/Model/Payer/Income.hs | 22 |
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 |