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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
module Controller.Payment
( list
, listPaymentCategories
, create
, edit
, delete
) where
import Control.Monad.IO.Class (liftIO)
import qualified Data.Map as M
import qualified Data.Time.Clock as Clock
import Data.Validation (Validation (Failure, Success))
import qualified Network.HTTP.Types.Status as Status
import Web.Scotty (ActionM)
import qualified Web.Scotty as S
import Common.Model (Category (..),
CreatePaymentForm (..),
EditPaymentForm (..),
Frequency (Punctual),
Payment (..), PaymentHeader (..),
PaymentId, PaymentPage (..),
SavedPayment (..), User (..))
import qualified Common.Model as CM
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 Persistence.Category as CategoryPersistence
import qualified Persistence.Income as IncomePersistence
import qualified Persistence.Payment as PaymentPersistence
import qualified Persistence.PaymentCategory as PaymentCategoryPersistence
import qualified Persistence.User as UserPersistence
import qualified Secure
import qualified Util.List as L
import qualified Validation.Payment as PaymentValidation
list :: Int -> Int -> ActionM ()
list page perPage =
Secure.loggedAction (\_ -> do
currentTime <- liftIO Clock.getCurrentTime
(liftIO . Query.run $ do
count <- PaymentPersistence.count
payments <- PaymentPersistence.listActivePage page perPage
paymentCategories <- PaymentCategoryPersistence.list
users <- UserPersistence.list
incomes <- IncomePersistence.listAll
allPayments <- PaymentPersistence.listActive Punctual
let exceedingPayers = CM.getExceedingPayers currentTime users incomes allPayments
repartition =
M.fromList
. map (\(u, xs) -> (u, sum . map snd $ xs))
. L.groupBy fst
. map (\p -> (_payment_user p, _payment_cost p))
$ allPayments
header = PaymentHeader
{ _paymentHeader_exceedingPayers = exceedingPayers
, _paymentHeader_repartition = repartition
}
return $ PaymentPage header payments paymentCategories count) >>= S.json
)
listPaymentCategories :: ActionM ()
listPaymentCategories =
Secure.loggedAction (\_ ->
(liftIO . Query.run $ PaymentCategoryPersistence.list) >>= 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) -> do
pc <- PaymentCategoryPersistence.save name category
p <- PaymentPersistence.create (_user_id user) name cost date frequency
return . Right $ SavedPayment p pc
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 frequency
case editedPayment of
Just (old, new) -> do
pc <- PaymentCategoryPersistence.save name category
PaymentCategoryPersistence.deleteIfUnused (_payment_name old)
return . Right $ SavedPayment new pc
Nothing ->
return . Left $ Msg.get Msg.Error_PaymentEdit
Failure validationError ->
return $ Left validationError
) >>= ControllerHelper.jsonOrBadRequest
)
delete :: PaymentId -> ActionM ()
delete paymentId =
Secure.loggedAction (\user -> do
deleted <- liftIO . Query.run $ do
payment <- PaymentPersistence.find paymentId
case payment of
Just p | _payment_user p == _user_id user -> do
PaymentPersistence.delete (_user_id user) paymentId
PaymentCategoryPersistence.deleteIfUnused (_payment_name p)
return True
_ ->
return False
if deleted then
S.status Status.ok200
else
S.status Status.badRequest400
)
|
