From 51705b930f8408c1a3f4706d0b172eb7970f20ba Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Sat, 23 Mar 2024 15:28:28 +0100 Subject: [haskell] implemented ship refueling --- haskell/app/Main.hs | 15 ++++++++++----- haskell/src/SpaceTraders/APIClient/Ships.hs | 28 ++++++++++++++++++++++++++++ haskell/src/SpaceTraders/Model/Ship.hs | 8 ++++++++ 3 files changed, 46 insertions(+), 5 deletions(-) (limited to 'haskell') 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 -- cgit v1.2.3