Using jsonObject to create on the fly json object responses

7 files changed, 32 insertions, 39 deletions

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