[haskell] implemented ship refueling

3 files changed, 46 insertions, 5 deletions

diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs
index 839e6cf..a8c1d29 100644
--- a/haskell/app/Main.hs
+++ b/haskell/app/Main.hs
@@ -5,6 +5,7 @@ import           SpaceTraders.APIClient.Agent
 import           SpaceTraders.APIClient.Contracts
 import           SpaceTraders.APIClient.Ships
 import           SpaceTraders.Automation.Init
+import           SpaceTraders.Database.Ships
 
 main :: IO ()
 main = do
@@ -15,10 +16,14 @@ main = do
     main' :: SpaceTradersT ()
     main' = do
       -- refresh our core objects
-      _ <- myAgent
-      _ <- myContracts
-      (Right ships) <- myShips -- work around to fetch the initial probe
+      (Right _) <- myAgent
+      (Right _) <- myContracts
+      (Right _) <- myShips
+      -- Testing
+      ships <- getShips
       let cmdShip = head ships
-      (Right t) <- orbit cmdShip
-      liftIO $ print t
+      t <- refuel cmdShip
+      liftIO . print $ case t of
+        (Right r) -> "response: " ++ show r
+        (Left e)  -> "error: " ++ show e
       return ()
diff --git a/haskell/src/SpaceTraders/APIClient/Ships.hs b/haskell/src/SpaceTraders/APIClient/Ships.hs
index d396911..912f6e8 100644
--- a/haskell/src/SpaceTraders/APIClient/Ships.hs
+++ b/haskell/src/SpaceTraders/APIClient/Ships.hs
@@ -6,6 +6,7 @@ module SpaceTraders.APIClient.Ships
   ( dock
   , myShips
   , orbit
+  , refuel
   ) where
 
 import           Data.Aeson.Types
@@ -16,7 +17,10 @@ import           Network.HTTP.Simple
 import           SpaceTraders
 import           SpaceTraders.APIClient.Client
 import           SpaceTraders.APIClient.Pagination
+import           SpaceTraders.Database.Agents
 import           SpaceTraders.Database.Ships
+import qualified SpaceTraders.Model.Agent
+import           SpaceTraders.Model.Fuel
 import           SpaceTraders.Model.Nav
 import           SpaceTraders.Model.Ship
 
@@ -62,3 +66,27 @@ orbit ship = if isInOrbit ship then pure (Right ship) else orbit'
           let s = ship{SpaceTraders.Model.Ship.nav=n}
           setShip s
           return $ Right s
+
+data RefuelMessage = RefuelMessage { agent :: SpaceTraders.Model.Agent.Agent
+                                   , fuel  :: Fuel
+                                   } deriving (FromJSON, Generic, Show)
+
+refuel :: Ship -> SpaceTradersT (APIResponse Ship)
+refuel ship = if overNinetyPercentFuel ship then pure (Right ship) else refuel'
+  where
+    refuel' = do
+      resp <- dock ship
+      case resp of
+        (Left e)      -> return $ Left e
+        (Right ship') -> refuel'' ship'
+    refuel'' ship' = do
+      -- TODO check if we are at a marketplace, that sells fuel
+      resp' <- send $ setRequestPath (T.encodeUtf8 $ mconcat ["/v2/my/ships/", symbol ship, "/refuel"])
+                    . setRequestMethod "POST" :: SpaceTradersT (APIResponse RefuelMessage)
+      case resp' of
+        Left e -> return $ Left e
+        Right (RefuelMessage a f) -> do
+          setAgent a
+          let s = ship'{SpaceTraders.Model.Ship.fuel=f}
+          setShip s
+          return $ Right s
diff --git a/haskell/src/SpaceTraders/Model/Ship.hs b/haskell/src/SpaceTraders/Model/Ship.hs
index f42d558..f30679c 100644
--- a/haskell/src/SpaceTraders/Model/Ship.hs
+++ b/haskell/src/SpaceTraders/Model/Ship.hs
@@ -6,6 +6,7 @@ module SpaceTraders.Model.Ship
   ( Ship(..)
   , isDocked
   , isInOrbit
+  , overNinetyPercentFuel
   ) where
 
 import           Data.Aeson
@@ -40,3 +41,10 @@ isDocked ship = status (nav ship) == "DOCKED"
 
 isInOrbit :: Ship -> Bool
 isInOrbit = not . isDocked
+
+overNinetyPercentFuel :: Ship -> Bool
+overNinetyPercentFuel ship = curr * 10 > capa * 9
+  where
+    curr = current f
+    capa = SpaceTraders.Model.Fuel.capacity f
+    f = fuel ship