From d87dbd1360c14df83552fd757438c23e5d7b9f9c Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 11 Sep 2015 10:36:27 +0200 Subject: Using jsonObject to create on the fly json object responses --- sharedCost.cabal | 1 + src/client/Main.elm | 1 - src/client/Model/Message.elm | 8 -------- src/client/ServerCommunication.elm | 19 +++++++++---------- src/server/Controller/Payment.hs | 9 +++++++-- src/server/Controller/SignIn.hs | 6 ++++-- src/server/Json.hs | 12 ++++++++++++ src/server/Model/Json/Message.hs | 16 ---------------- 8 files changed, 33 insertions(+), 39 deletions(-) delete mode 100644 src/client/Model/Message.elm create mode 100644 src/server/Json.hs delete mode 100644 src/server/Model/Json/Message.hs diff --git a/sharedCost.cabal b/sharedCost.cabal index 1855421..7358612 100644 --- a/sharedCost.cabal +++ b/sharedCost.cabal @@ -36,3 +36,4 @@ executable sharedCost , mtl == 2.2.1 , lens == 4.12.3 , parsec == 3.1.9 + , unordered-containers == 0.2.5.1 diff --git a/src/client/Main.elm b/src/client/Main.elm index e59692a..0b579d7 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -15,7 +15,6 @@ import Model exposing (Model, initialModel) import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) import Model.Payment exposing (Payments, paymentsDecoder, perPage) import Model.Payers exposing (Payers, payersDecoder) -import Model.Message exposing (messageDecoder) import Model.Translations exposing (..) import Update exposing (Action(..), actions, updateModel) diff --git a/src/client/Model/Message.elm b/src/client/Model/Message.elm deleted file mode 100644 index 9f21fd3..0000000 --- a/src/client/Model/Message.elm +++ /dev/null @@ -1,8 +0,0 @@ -module Model.Message - ( messageDecoder - ) where - -import Json.Decode exposing (..) - -messageDecoder : Decoder String -messageDecoder = ("message" := string) diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm index fefbbff..5736f77 100644 --- a/src/client/ServerCommunication.elm +++ b/src/client/ServerCommunication.elm @@ -10,7 +10,6 @@ import Http import Json.Decode exposing (..) import Date -import Model.Message exposing (messageDecoder) import Model.User exposing (UserId) import Model.Payment exposing (..) import Model.View.LoggedIn.Add exposing (Frequency(..)) @@ -108,16 +107,16 @@ serverResult communication response = SignOut -> Task.succeed (U.GoSignInView) errorStatus -> - decodeResponse - messageDecoder - (\error -> - case communication of - SignIn _ -> + case communication of + SignIn _ -> + decodeResponse + ("error" := string) + (\error -> Task.succeed <| U.UpdateSignIn (ErrorLogin error) - _ -> - Task.succeed <| U.NoOp - ) - response + ) + response + _ -> + Task.succeed <| U.NoOp decodeOkResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action decodeOkResponse decoder responseToAction response = diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs index 7cbfb37..85e2a87 100644 --- a/src/server/Controller/Payment.hs +++ b/src/server/Controller/Payment.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE OverloadedStrings #-} + module Controller.Payment ( getPaymentsAction , getMonthlyPaymentsAction @@ -16,18 +18,21 @@ import Database.Persist import Control.Monad.IO.Class (liftIO) import Data.Text (Text) +import qualified Data.Aeson.Types as Json import qualified Secure import Model.Database import Model.Payment import Model.Frequency -import Model.Json.Message import Model.Json.Number import qualified Model.Json.PaymentId as JP import Model.Message import Model.Message.Key (Key(PaymentNotDeleted)) + +import Json (jsonObject) + getPaymentsAction :: Int -> Int -> ActionM () getPaymentsAction page perPage = Secure.loggedAction (\_ -> do @@ -56,7 +61,7 @@ deletePaymentAction paymentId = status ok200 else do status badRequest400 - json . Message . getMessage $ PaymentNotDeleted + jsonObject [("error", Json.String $ getMessage PaymentNotDeleted)] ) getTotalPaymentsAction :: ActionM () diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs index 40cf474..4f41c6e 100644 --- a/src/server/Controller/SignIn.hs +++ b/src/server/Controller/SignIn.hs @@ -18,6 +18,7 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import Data.Time.Clock (getCurrentTime, diffUTCTime) +import qualified Data.Aeson.Types as Json import qualified LoginSession @@ -30,10 +31,11 @@ import Text.Email.Validate (isValid) import Model.Database import Model.User import Model.SignIn -import Model.Json.Message import Model.Message.Key import Model.Message (getMessage) +import Json (jsonObject) + import qualified View.Mail.SignIn as SignIn signInAction :: Config -> Text -> ActionM () @@ -59,7 +61,7 @@ signInAction config login = errorResponse :: Text -> ActionM () errorResponse msg = do status badRequest400 - json (Message msg) + jsonObject [("error", Json.String msg)] validateSignInAction :: Config -> Text -> ActionM () validateSignInAction config token = do diff --git a/src/server/Json.hs b/src/server/Json.hs new file mode 100644 index 0000000..51287ed --- /dev/null +++ b/src/server/Json.hs @@ -0,0 +1,12 @@ +module Json + ( jsonObject + ) where + +import Web.Scotty (json, ActionM) + +import qualified Data.Aeson.Types as Json +import qualified Data.HashMap.Strict as M +import Data.Text (Text) + +jsonObject :: [(Text, Json.Value)] -> ActionM () +jsonObject = json . Json.Object . M.fromList diff --git a/src/server/Model/Json/Message.hs b/src/server/Model/Json/Message.hs deleted file mode 100644 index 354dd8f..0000000 --- a/src/server/Model/Json/Message.hs +++ /dev/null @@ -1,16 +0,0 @@ -{-# LANGUAGE DeriveGeneric #-} - -module Model.Json.Message - ( Message(..) - ) where - -import Data.Aeson -import Data.Text (Text) -import GHC.Generics - -data Message = Message - { message :: Text - } deriving (Show, Generic) - -instance FromJSON Message -instance ToJSON Message -- cgit v1.2.3