From dde6abef3926021d09b46732c924af94771ae5a9 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Fri, 22 Mar 2024 16:29:09 +0100
Subject: [haskell] only dock or orbit when needed

---
 haskell/src/SpaceTraders/APIClient/Ships.hs | 40 ++++++++++++++++-------------
 haskell/src/SpaceTraders/Model/Ship.hs      | 13 ++++++++--
 2 files changed, 33 insertions(+), 20 deletions(-)

(limited to 'haskell')

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
-- 
cgit v1.2.3