[haskell] Refactored JSON parsing code
This commit is contained in:
parent
0f279a06d8
commit
8249bf432a
4 changed files with 22 additions and 29 deletions
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 )
|
||||
|
|
Loading…
Add table
Reference in a new issue