From 8249bf432abcf4aad261a79ac2d802c0ac3a0391 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 10 Jul 2023 00:31:13 +0200
Subject: [haskell] Refactored JSON parsing code

---
 haskell/src/SpaceTraders/APIClient/Client.hs |  4 +---
 haskell/src/SpaceTraders/APIClient/Errors.hs |  7 ++-----
 haskell/src/SpaceTraders/Model/Contract.hs   | 19 +++++++++----------
 haskell/src/SpaceTraders/Model/Route.hs      | 21 ++++++++++-----------
 4 files changed, 22 insertions(+), 29 deletions(-)

(limited to 'haskell')

diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs
index 0bf92a8..cbbe422 100644
--- a/haskell/src/SpaceTraders/APIClient/Client.hs
+++ b/haskell/src/SpaceTraders/APIClient/Client.hs
@@ -11,7 +11,6 @@ module SpaceTraders.APIClient.Client
   ) where
 
 import Control.Concurrent
-import Control.Monad
 import Data.Aeson
 import Data.Aeson.Types
 import qualified Data.Text as T
@@ -23,8 +22,7 @@ import SpaceTraders.APIClient.Errors
 
 data FromJSON a => APIMessage a = APIMessage { data_ :: a } deriving (Show)
 instance FromJSON a => FromJSON (APIMessage a) where
-  parseJSON (Object o) = APIMessage <$> o .: "data"
-  parseJSON _ = mzero
+  parseJSON = withObject "APIMessage" $ \o -> APIMessage <$> o .: "data"
 
 defaultReq :: Request
 defaultReq = setRequestHost "api.spacetraders.io"
diff --git a/haskell/src/SpaceTraders/APIClient/Errors.hs b/haskell/src/SpaceTraders/APIClient/Errors.hs
index e4e5513..a7f5d21 100644
--- a/haskell/src/SpaceTraders/APIClient/Errors.hs
+++ b/haskell/src/SpaceTraders/APIClient/Errors.hs
@@ -6,7 +6,6 @@ module SpaceTraders.APIClient.Errors
   ) where
 
 import Control.Exception
-import Control.Monad
 import Data.Aeson
 import Data.Time
 import qualified Data.Text as T
@@ -16,7 +15,7 @@ data APIError = APIError Int T.Text Value
               deriving Show
 instance Exception APIError
 instance FromJSON APIError where
-  parseJSON (Object o) = do
+  parseJSON = withObject "APIError" $ \o -> do
     e <- o .: "error"
     code <- e .: "code"
     d <- e .: "data"
@@ -25,7 +24,6 @@ instance FromJSON APIError where
       _ -> APIError <$> pure code
                     <*> e .: "message"
                     <*> pure d
-  parseJSON _ = mzero
 
 data RateLimit = RateLimit { limitBurst :: Int
                            , limitPerSecond :: Int
@@ -35,11 +33,10 @@ data RateLimit = RateLimit { limitBurst :: Int
                            , retryAfter :: Double
                            } deriving Show
 instance FromJSON RateLimit where
-  parseJSON (Object o) = do
+  parseJSON = withObject "RateLimit" $ \o ->
     RateLimit <$> o .: "limitBurst"
               <*> o .: "limitPerSecond"
               <*> o .: "type"
               <*> o .: "remaining"
               <*> o .: "reset"
               <*> o .: "retryAfter"
-  parseJSON _ = mzero
diff --git a/haskell/src/SpaceTraders/Model/Contract.hs b/haskell/src/SpaceTraders/Model/Contract.hs
index fd7a70b..742062e 100644
--- a/haskell/src/SpaceTraders/Model/Contract.hs
+++ b/haskell/src/SpaceTraders/Model/Contract.hs
@@ -9,7 +9,6 @@ module SpaceTraders.Model.Contract
   , Terms(..)
   ) where
 
-import Control.Monad
 import Data.Aeson
 import Data.Time
 import GHC.Generics
@@ -25,15 +24,15 @@ data Contract = Contract { accepted :: Bool
                          , terms :: Terms
                          } deriving (Generic, Show)
 instance FromJSON Contract where
-  parseJSON (Object o) = Contract <$> o .: "accepted"
-                                  <*> o .: "id"
-                                  <*> o .: "type"
-                                  <*> o .: "expiration"
-                                  <*> o .: "deadlineToAccept"
-                                  <*> o .: "factionSymbol"
-                                  <*> o .: "fulfilled"
-                                  <*> o .: "terms"
-  parseJSON _ = mzero
+  parseJSON = withObject "Contract" $ \o ->
+    Contract <$> o .: "accepted"
+             <*> o .: "id"
+             <*> o .: "type"
+             <*> o .: "expiration"
+             <*> o .: "deadlineToAccept"
+             <*> o .: "factionSymbol"
+             <*> o .: "fulfilled"
+             <*> o .: "terms"
 instance ToJSON Contract where
   toEncoding (Contract a i ty e d fa fu te) = pairs ( "accepted" .= a
                                                    <> "id" .= i
diff --git a/haskell/src/SpaceTraders/Model/Route.hs b/haskell/src/SpaceTraders/Model/Route.hs
index 959edff..9681214 100644
--- a/haskell/src/SpaceTraders/Model/Route.hs
+++ b/haskell/src/SpaceTraders/Model/Route.hs
@@ -7,7 +7,6 @@ module SpaceTraders.Model.Route
   , RouteEndpoint(..)
   ) where
 
-import Control.Monad
 import Data.Aeson
 import Data.Time
 import GHC.Generics
@@ -26,15 +25,15 @@ data RouteEndpoint = RouteEndpoint { routeEndpointType :: T.Text
                                    , y :: Int
                                    } deriving (Generic, Show)
 instance FromJSON RouteEndpoint where
-  parseJSON (Object o) = RouteEndpoint <$> o .: "type"
-                                       <*> o .: "symbol"
-                                       <*> o .: "systemSymbol"
-                                       <*> o .: "x"
-                                       <*> o .: "y"
-  parseJSON _ = mzero
+  parseJSON = withObject "RouteEndpoint" $ \o ->
+    RouteEndpoint <$> o .: "type"
+                  <*> o .: "symbol"
+                  <*> o .: "systemSymbol"
+                  <*> o .: "x"
+                  <*> o .: "y"
 instance ToJSON RouteEndpoint where
   toEncoding (RouteEndpoint t s ss xx yy) = pairs ( "type" .= t
-                                          <> "symbol" .= s
-                                          <> "systemSymbol" .= ss
-                                          <> "x" .= xx
-                                          <> "y" .= yy )
+                                                 <> "symbol" .= s
+                                                 <> "systemSymbol" .= ss
+                                                 <> "x" .= xx
+                                                 <> "y" .= yy )
-- 
cgit v1.2.3