diff options
Diffstat (limited to 'src/server')
| -rw-r--r-- | src/server/Controller/Payment.hs | 6 | ||||
| -rw-r--r-- | src/server/Design/Color.hs | 4 | ||||
| -rw-r--r-- | src/server/Design/Global.hs | 24 | ||||
| -rw-r--r-- | src/server/Main.hs | 6 | ||||
| -rw-r--r-- | src/server/Model/Payment.hs | 7 |
5 files changed, 36 insertions, 11 deletions
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index dc1083e..271d970 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -25,10 +25,10 @@ import Model.Json.Number import Model.Message import Model.Message.Key (Key(PaymentNotDeleted)) -getPaymentsAction :: ActionM () -getPaymentsAction = +getPaymentsAction :: Int -> Int -> ActionM () +getPaymentsAction page perPage = Secure.loggedAction (\_ -> do - payments <- liftIO $ runDb getPayments + payments <- liftIO $ runDb (getPayments page perPage) json payments ) diff --git a/src/server/Design/Color.hs b/src/server/Design/Color.hs index c1c4057..adbe50f 100644 --- a/src/server/Design/Color.hs +++ b/src/server/Design/Color.hs @@ -23,8 +23,8 @@ blue = C.rgb 108 162 164 paymentFocus :: C.Color paymentFocus = C.rgb 255 223 196 -darkgrey :: C.Color -darkgrey = C.rgb 150 150 150 +darkGrey :: C.Color +darkGrey = C.rgb 150 150 150 grey :: C.Color grey = C.rgb 200 200 200 diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs index 4933300..5efb2bf 100644 --- a/src/server/Design/Global.hs +++ b/src/server/Design/Global.hs @@ -78,7 +78,7 @@ global = do display inlineBlock width (px 60) textAlign (alignSide sideCenter) - backgroundColor C.darkgrey + backgroundColor C.darkGrey color C.white height (px inputHeight) lineHeight (px inputHeight) @@ -167,6 +167,26 @@ global = do color C.white visibility hidden + ".pages" ? do + padding (px 30) (px 30) (px 30) (px 30) + clearFix + ".page" ? do + border solid (px 2) C.darkGrey + borderRadius (px 2) (px 2) (px 2) (px 2) + marginRight (px 10) + cursor pointer + let side = 50 + width (px side) + height (px side) + lineHeight (px side) + textAlign (alignSide (sideCenter)) + float floatLeft + fontWeight bold + + ".current" & do + borderColor C.red + color C.red + ".signIn" ? do form ? do @@ -214,6 +234,6 @@ defaultInput inputHeight = do height (px inputHeight) padding (px 10) (px 10) (px 10) (px 10) borderRadius (px 3) (px 3) (px 3) (px 3) - border solid (px 1) C.darkgrey + border solid (px 1) C.darkGrey focus & borderColor C.grey verticalAlign middle diff --git a/src/server/Main.hs b/src/server/Main.hs index ce652d0..8a77598 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -42,8 +42,10 @@ main = do get "/userName" $ getUserName - get "/payments" $ - getPaymentsAction + get "/payments" $ do + page <- param "page" :: ActionM Int + perPage <- param "perPage" :: ActionM Int + getPaymentsAction page perPage post "/payment/add" $ do name <- param "name" :: ActionM Text diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index db1f36f..ce8c5a1 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -23,12 +23,15 @@ import Model.Database import qualified Model.Json.Payment as P import qualified Model.Json.TotalPayment as TP -getPayments :: Persist [P.Payment] -getPayments = do +getPayments :: Int -> Int -> Persist [P.Payment] +getPayments page perPage = do xs <- select $ from $ \(payment `InnerJoin` user) -> do on (payment ^. PaymentUserId E.==. user ^. UserId) where_ (isNothing (payment ^. PaymentDeletedAt)) + orderBy [desc (payment ^. PaymentCreation)] + limit . fromIntegral $ perPage + offset . fromIntegral $ (page - 1) * perPage return (payment, user) return (map getJsonPayment xs) |