[haskell] implemented dock and orbit api calls
This commit is contained in:
parent
20d4381c9c
commit
961625c363
2 changed files with 35 additions and 3 deletions
|
@ -9,6 +9,7 @@ import System.Posix.Process
|
||||||
import SpaceTraders
|
import SpaceTraders
|
||||||
import SpaceTraders.Automation.Init
|
import SpaceTraders.Automation.Init
|
||||||
import SpaceTraders.APIClient.Errors
|
import SpaceTraders.APIClient.Errors
|
||||||
|
import SpaceTraders.APIClient.Ships
|
||||||
import SpaceTraders.APIClient.Systems
|
import SpaceTraders.APIClient.Systems
|
||||||
import SpaceTraders.Database.Agents
|
import SpaceTraders.Database.Agents
|
||||||
import SpaceTraders.Database.Contracts
|
import SpaceTraders.Database.Contracts
|
||||||
|
@ -28,5 +29,7 @@ main = do
|
||||||
Left e -> throwIO e
|
Left e -> throwIO e
|
||||||
Right s' -> print $ length s'
|
Right s' -> print $ length s'
|
||||||
runSpaceTradersT getContracts env >>= print
|
runSpaceTradersT getContracts env >>= print
|
||||||
runSpaceTradersT getShips env >>= print
|
ss <- runSpaceTradersT getShips env
|
||||||
|
runSpaceTradersT (dock $ head ss) env >>= print
|
||||||
|
runSpaceTradersT (orbit $ head ss) env >>= print
|
||||||
deinitST env
|
deinitST env
|
||||||
|
|
|
@ -3,16 +3,34 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
module SpaceTraders.APIClient.Ships
|
module SpaceTraders.APIClient.Ships
|
||||||
( myShips
|
( dock
|
||||||
|
, myShips
|
||||||
|
, orbit
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.Aeson.Types
|
||||||
|
import qualified Data.Text.Encoding as T
|
||||||
|
import GHC.Generics
|
||||||
import Network.HTTP.Simple
|
import Network.HTTP.Simple
|
||||||
|
|
||||||
import SpaceTraders
|
import SpaceTraders
|
||||||
import SpaceTraders.APIClient.Client
|
import SpaceTraders.APIClient.Client
|
||||||
import SpaceTraders.APIClient.Pagination
|
import SpaceTraders.APIClient.Pagination
|
||||||
import SpaceTraders.Database.Ships
|
import SpaceTraders.Database.Ships
|
||||||
import SpaceTraders.Model.Ship(Ship)
|
import SpaceTraders.Model.Nav
|
||||||
|
import SpaceTraders.Model.Ship
|
||||||
|
|
||||||
|
data NavMessage = NavMessage { nav :: Nav } deriving (FromJSON, Generic, Show)
|
||||||
|
dock :: Ship -> SpaceTradersT (APIResponse Ship)
|
||||||
|
dock ship = do
|
||||||
|
resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/dock"])
|
||||||
|
. setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
|
||||||
|
case resp of
|
||||||
|
Left e -> return $ Left e
|
||||||
|
Right (NavMessage n) -> do
|
||||||
|
let s = ship{SpaceTraders.Model.Ship.nav=n}
|
||||||
|
updateShip s Nothing
|
||||||
|
return $ Right s
|
||||||
|
|
||||||
myShips :: SpaceTradersT (APIResponse [Ship])
|
myShips :: SpaceTradersT (APIResponse [Ship])
|
||||||
myShips = do
|
myShips = do
|
||||||
|
@ -28,3 +46,14 @@ myShips = do
|
||||||
if (limit p' * page p' < total p') then listShips' (nextPage p')
|
if (limit p' * page p' < total p') then listShips' (nextPage p')
|
||||||
else Right <$> getShips
|
else Right <$> getShips
|
||||||
_ -> undefined
|
_ -> undefined
|
||||||
|
|
||||||
|
orbit :: Ship -> SpaceTradersT (APIResponse Ship)
|
||||||
|
orbit ship = do
|
||||||
|
resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/orbit"])
|
||||||
|
. setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
|
||||||
|
case resp of
|
||||||
|
Left e -> return $ Left e
|
||||||
|
Right (NavMessage n) -> do
|
||||||
|
let s = ship{SpaceTraders.Model.Ship.nav=n}
|
||||||
|
updateShip s Nothing
|
||||||
|
return $ Right s
|
||||||
|
|
Loading…
Add table
Reference in a new issue