1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
module Controller.Payment
( list
, create
, edit
, delete
, searchCategory
) where
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import qualified Data.Maybe as Maybe
import Data.Text (Text)
import qualified Data.Time.Calendar as Calendar
import qualified Data.Time.Clock as Clock
import Data.Validation (Validation (Failure, Success))
import Web.Scotty (ActionM)
import qualified Web.Scotty as S
import Common.Model (Category (..), CreatePaymentForm (..),
EditPaymentForm (..), Frequency,
PaymentHeader (..), PaymentId,
PaymentPage (..), User (..))
import qualified Common.Msg as Msg
import qualified Controller.Helper as ControllerHelper
import Model.CreatePayment (CreatePayment (..))
import Model.EditPayment (EditPayment (..))
import qualified Model.Query as Query
import qualified Payer as Payer
import qualified Persistence.Category as CategoryPersistence
import qualified Persistence.Income as IncomePersistence
import qualified Persistence.Payment as PaymentPersistence
import qualified Persistence.User as UserPersistence
import qualified Secure
import qualified Validation.Payment as PaymentValidation
list :: Frequency -> Int -> Int -> Text -> ActionM ()
list frequency page perPage search =
Secure.loggedAction (\_ -> do
currentTime <- liftIO Clock.getCurrentTime
(liftIO . Query.run $ do
count <- PaymentPersistence.count frequency search
payments <- PaymentPersistence.listActivePage frequency page perPage search
users <- UserPersistence.list
incomes <- IncomePersistence.listAll -- TODO optimize
paymentRange <- PaymentPersistence.getRange
searchRepartition <-
case paymentRange of
Just (from, to) ->
PaymentPersistence.repartition frequency search from (Calendar.addDays 1 to)
Nothing ->
return M.empty
(preIncomeRepartition, postIncomeRepartition) <-
PaymentPersistence.getPreAndPostPaymentRepartition paymentRange users
let exceedingPayers = Payer.getExceedingPayers currentTime users incomes preIncomeRepartition postIncomeRepartition (fst <$> paymentRange)
header = PaymentHeader
{ _paymentHeader_exceedingPayers = exceedingPayers
, _paymentHeader_repartition = searchRepartition
}
return $ PaymentPage page frequency header payments count) >>= S.json
)
create :: CreatePaymentForm -> ActionM ()
create form =
Secure.loggedAction (\user ->
(liftIO . Query.run $ do
cs <- map _category_id <$> CategoryPersistence.list
case PaymentValidation.createPayment cs form of
Success (CreatePayment name cost date category frequency) ->
Right <$> PaymentPersistence.create (_user_id user) name cost date category frequency
Failure validationError ->
return $ Left validationError
) >>= ControllerHelper.jsonOrBadRequest
)
edit :: EditPaymentForm -> ActionM ()
edit form =
Secure.loggedAction (\user ->
(liftIO . Query.run $ do
cs <- map _category_id <$> CategoryPersistence.list
case PaymentValidation.editPayment cs form of
Success (EditPayment paymentId name cost date category frequency) -> do
editedPayment <- PaymentPersistence.edit (_user_id user) paymentId name cost date category frequency
if Maybe.isJust editedPayment then
return . Right $ editedPayment
else
return . Left $ Msg.get Msg.Error_PaymentEdit
Failure validationError ->
return $ Left validationError
) >>= ControllerHelper.jsonOrBadRequest
)
delete :: PaymentId -> ActionM ()
delete paymentId =
Secure.loggedAction (\user ->
liftIO . Query.run $ PaymentPersistence.delete (_user_id user) paymentId
)
searchCategory :: Text -> ActionM ()
searchCategory paymentName =
Secure.loggedAction (\_ -> do
(liftIO $ Query.run (PaymentPersistence.searchCategory paymentName))
>>= S.json
)
|
