summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/APIClient
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Ships.hs40
1 files changed, 22 insertions, 18 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Ships.hs b/haskell/src/SpaceTraders/APIClient/Ships.hs
index 4ce9371..d396911 100644
--- a/haskell/src/SpaceTraders/APIClient/Ships.hs
+++ b/haskell/src/SpaceTraders/APIClient/Ships.hs
@@ -23,15 +23,17 @@ import SpaceTraders.Model.Ship
newtype 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}
- setShip s
- return $ Right s
+dock ship = if isDocked ship then pure (Right ship) else dock'
+ where
+ dock' = 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}
+ setShip s
+ return $ Right s
myShips :: SpaceTradersT (APIResponse [Ship])
myShips = do
@@ -49,12 +51,14 @@ myShips = do
_ -> 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}
- setShip s
- return $ Right s
+orbit ship = if isInOrbit ship then pure (Right ship) else orbit'
+ where
+ orbit' = 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}
+ setShip s
+ return $ Right s