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(-) 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