adyxax/spacetraders
1
0
Fork 0
Code Issues Activity

[haskell] only dock or orbit when needed

Browse source
This commit is contained in:
Julien Dessaux 2024-03-22 16:29:09 +01:00
parent 7e27a0a7ea
commit dde6abef39
Signed by: adyxax
GPG key ID: F92E51B86E07177E
2 changed files with 33 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

40
haskell/src/SpaceTraders/APIClient/Ships.hs
View file

@ -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

13
haskell/src/SpaceTraders/Model/Ship.hs
View file

@ -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