[haskell] only dock or orbit when needed

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
+dock ship = if isDocked ship then pure (Right ship) else dock'
-  resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/dock"])
+  where
-               . setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
+    dock' = do
-  case resp of
+      resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/dock"])
-    Left e -> return $ Left e
+                   . setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
-    Right (NavMessage n) -> do
+      case resp of
-      let s = ship{SpaceTraders.Model.Ship.nav=n}
+        Left e -> return $ Left e
-      setShip s
+        Right (NavMessage n) -> do
-      return $ Right s
+          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
+orbit ship = if isInOrbit ship then pure (Right ship) else orbit'
-  resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/orbit"])
+  where
-               . setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
+    orbit' = do
-  case resp of
+      resp <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/orbit"])
-    Left e -> return $ Left e
+                   . setRequestMethod "POST" :: SpaceTradersT (APIResponse NavMessage)
-    Right (NavMessage n) -> do
+      case resp of
-      let s = ship{SpaceTraders.Model.Ship.nav=n}
+        Left e -> return $ Left e
-      setShip s
+        Right (NavMessage n) -> do
-      return $ Right s
+          let s = ship{SpaceTraders.Model.Ship.nav=n}
+          setShip s
+          return $ Right s

haskell/src/SpaceTraders/Model/Ship.hs

@@ -1,8 +1,11 @@
-{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveAnyClass    #-}
-{-# LANGUAGE DeriveGeneric  #-}
+{-# 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