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 | 
