diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/client/Main.elm | 7 | ||||
-rw-r--r-- | src/client/Model/View/PaymentView.elm | 6 | ||||
-rw-r--r-- | src/client/Update.elm | 6 | ||||
-rw-r--r-- | src/server/Controller/Payment.hs | 8 | ||||
-rw-r--r-- | src/server/Main.hs | 3 | ||||
-rw-r--r-- | src/server/Model/Json/Number.hs | 15 | ||||
-rw-r--r-- | src/server/Model/Message/Translations.hs | 2 | ||||
-rw-r--r-- | src/server/Model/Payment.hs | 9 |
8 files changed, 48 insertions, 8 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm index 57e41d4..6ca2743 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -9,7 +9,7 @@ import Html exposing (Html) import Http import Task exposing (..) import Time exposing (..) -import Json.Decode as Json +import Json.Decode as Json exposing ((:=)) import Model exposing (Model, initialModel) import Model.Payment exposing (Payments, paymentsDecoder) @@ -56,7 +56,7 @@ port initView = Just msg -> Signal.send actions.address (SignInError msg) Nothing -> - Task.map3 GoPaymentView getUserName getPayments getPayers + Task.map4 GoPaymentView getUserName getPayments getPaymentsCount getPayers |> flip Task.andThen (Signal.send actions.address) |> flip Task.onError (\_ -> Signal.send actions.address GoSignInView) @@ -66,6 +66,9 @@ getUserName = Http.get messageDecoder "/userName" getPayments : Task Http.Error Payments getPayments = Http.get paymentsDecoder "/payments" +getPaymentsCount : Task Http.Error Int +getPaymentsCount = Http.get ("number" := Json.int) "/payments/count" + getPayers : Task Http.Error Payers getPayers = Http.get payersDecoder "/payments/total" diff --git a/src/client/Model/View/PaymentView.elm b/src/client/Model/View/PaymentView.elm index 19ad355..117be59 100644 --- a/src/client/Model/View/PaymentView.elm +++ b/src/client/Model/View/PaymentView.elm @@ -12,15 +12,17 @@ type alias PaymentView = { userName : String , add : AddPayment , payments : Payments + , paymentsCount : Int , payers : Payers , edition : Maybe Edition } -initPaymentView : String -> Payments -> Payers -> PaymentView -initPaymentView userName payments payers = +initPaymentView : String -> Payments -> Int -> Payers -> PaymentView +initPaymentView userName payments paymentsCount payers = { userName = userName , add = initAddPayment , payments = payments + , paymentsCount = paymentsCount , payers = payers , edition = Nothing } diff --git a/src/client/Update.elm b/src/client/Update.elm index df19775..374c5d0 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -22,7 +22,7 @@ type Action = | GoSignInView | SignInError String | UpdateSignIn SignInAction - | GoPaymentView String Payments Payers + | GoPaymentView String Payments Int Payers | UpdatePayment PaymentAction actions : Signal.Mailbox Action @@ -37,8 +37,8 @@ updateModel action model = { model | currentTime <- time } GoSignInView -> { model | view <- V.SignInView initSignInView } - GoPaymentView userName payments payers -> - { model | view <- V.PaymentView (initPaymentView userName payments payers) } + GoPaymentView userName payments paymentsCount payers -> + { model | view <- V.PaymentView (initPaymentView userName payments paymentsCount payers) } SignInError msg -> let signInView = { initSignInView | result <- Just (Err msg) } in { model | view <- V.SignInView signInView } diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 117310a..dc1083e 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -3,6 +3,7 @@ module Controller.Payment , createPaymentAction , deletePaymentAction , getTotalPaymentsAction + , getPaymentsCountAction ) where import Web.Scotty @@ -20,6 +21,7 @@ import qualified Secure import Model.Database import Model.Payment import Model.Json.Message +import Model.Json.Number import Model.Message import Model.Message.Key (Key(PaymentNotDeleted)) @@ -54,3 +56,9 @@ getTotalPaymentsAction = Secure.loggedAction (\_ -> do (liftIO . runDb $ getTotalPayments) >>= json ) + +getPaymentsCountAction :: ActionM () +getPaymentsCountAction = + Secure.loggedAction (\_ -> do + Number <$> (liftIO . runDb $ getPaymentsCount) >>= json + ) diff --git a/src/server/Main.hs b/src/server/Main.hs index 61613e6..ce652d0 100644 --- a/src/server/Main.hs +++ b/src/server/Main.hs @@ -57,6 +57,9 @@ main = do get "/payments/total" $ do getTotalPaymentsAction + get "/payments/count" $ do + getPaymentsCountAction + post "/signOut" $ signOutAction diff --git a/src/server/Model/Json/Number.hs b/src/server/Model/Json/Number.hs new file mode 100644 index 0000000..52c9da8 --- /dev/null +++ b/src/server/Model/Json/Number.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Model.Json.Number + ( Number(..) + ) where + +import Data.Aeson +import GHC.Generics + +data Number = Number + { number :: Int + } deriving (Show, Generic) + +instance FromJSON Number +instance ToJSON Number diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs index 9b9aafd..6c569fd 100644 --- a/src/server/Model/Message/Translations.hs +++ b/src/server/Model/Message/Translations.hs @@ -72,7 +72,7 @@ m l SignInMailTitle = m l HiMail = case l of English -> "Hi {1}," - French -> "Bonjour {1}," + French -> "Salut {1}," m l SignInLinkMail = case l of diff --git a/src/server/Model/Payment.hs b/src/server/Model/Payment.hs index 300f6b8..db1f36f 100644 --- a/src/server/Model/Payment.hs +++ b/src/server/Model/Payment.hs @@ -4,6 +4,7 @@ module Model.Payment , paymentKeyToText , deleteOwnPayment , getTotalPayments + , getPaymentsCount ) where import Data.Text (Text) @@ -82,3 +83,11 @@ getTotalPayment (_, Nothing) = Nothing unValueTuple :: (Value a, Value b) -> (a, b) unValueTuple (Value a, Value b) = (a, b) + +getPaymentsCount :: Persist Int +getPaymentsCount = + unValue . head <$> + (select $ + from $ \payment -> do + where_ (isNothing (payment ^. PaymentDeletedAt)) + return countRows) :: Persist Int |