summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders
diff options
context:
space:
mode:
Diffstat (limited to 'haskell/src/SpaceTraders')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Ships.hs40
-rw-r--r--haskell/src/SpaceTraders/Model/Ship.hs13
2 files changed, 33 insertions, 20 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
diff --git a/haskell/src/SpaceTraders/Model/Ship.hs b/haskell/src/SpaceTraders/Model/Ship.hs
index 522276c..f42d558 100644
--- a/haskell/src/SpaceTraders/Model/Ship.hs
+++ b/haskell/src/SpaceTraders/Model/Ship.hs
@@ -1,8 +1,11 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.Model.Ship
( Ship(..)
+ , isDocked
+ , isInOrbit
) where
import Data.Aeson
@@ -31,3 +34,9 @@ data Cooldown = Cooldown { shipSymbol :: T.Text
, totalSeconds :: Int
, remainingSeconds :: Int
} deriving (FromJSON, Generic, Show, ToJSON)
+
+isDocked :: Ship -> Bool
+isDocked ship = status (nav ship) == "DOCKED"
+
+isInOrbit :: Ship -> Bool
+isInOrbit = not . isDocked