1
0
Fork 0

[haskell] updated main, init and server reset handling

This commit is contained in:
Julien Dessaux 2023-10-16 23:18:38 +02:00
parent 414aebd697
commit 8c5ad1533d
Signed by: adyxax
GPG key ID: F92E51B86E07177E
3 changed files with 17 additions and 23 deletions

View file

@ -2,34 +2,20 @@
module Main (main) where module Main (main) where
import Control.Exception
import System.Environment
import System.Posix.Process
import SpaceTraders import SpaceTraders
import SpaceTraders.Automation.Init import SpaceTraders.Automation.Init
import SpaceTraders.APIClient.Errors
import SpaceTraders.APIClient.Ships import SpaceTraders.APIClient.Ships
import SpaceTraders.APIClient.Systems import SpaceTraders.APIClient.Systems
import SpaceTraders.Database.Agents
import SpaceTraders.Database.Contracts
import SpaceTraders.Database.Ships
main :: IO () main :: IO ()
main = do main = do
env <- initST env <- initST
runSpaceTradersT getAgent env >>= print runSpaceTradersT main' env
s <- runSpaceTradersT initSystems env
case s of
Left (APIResetHappened _) -> do
p <- getExecutablePath
a <- getArgs
e <- getEnvironment
executeFile p False a (Just e)
Left e -> throwIO e
Right s' -> print $ length s'
runSpaceTradersT getContracts env >>= print
ss <- runSpaceTradersT getShips env
runSpaceTradersT (dock $ head ss) env >>= print
runSpaceTradersT (orbit $ head ss) env >>= print
deinitST env deinitST env
where
main' :: SpaceTradersT ()
main' = do
_ <- initSystems
(Right ships) <- myShips -- work around to fetch the initial probe
_ <- orbit (head ships)
return ()

View file

@ -20,6 +20,9 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding as T
import Network.HTTP.Simple import Network.HTTP.Simple
import Network.HTTP.Types.Status import Network.HTTP.Types.Status
import System.Directory
import System.Environment
import System.Posix.Process
import SpaceTraders import SpaceTraders
import SpaceTraders.APIClient.Errors import SpaceTraders.APIClient.Errors
@ -86,4 +89,10 @@ sendPaginated pagination requestBuilder = do
Right (APIRateLimit r) -> do Right (APIRateLimit r) -> do
liftIO $ delay (1_000_000 * (round $ retryAfter r)) liftIO $ delay (1_000_000 * (round $ retryAfter r))
sendPaginated' request sendPaginated' request
Right (APIResetHappened _) -> liftIO $ do
removeFile "spacetraders.db"
p <- getExecutablePath
a <- getArgs
e <- getEnvironment
executeFile p False a (Just e) -- we exec on ourselves
Right e -> return $ Left e Right e -> return $ Left e

View file

@ -55,7 +55,6 @@ registerST = do
addAgent $ agent r' addAgent $ agent r'
addContract $ contract r' addContract $ contract r'
addShip $ ship r' addShip $ ship r'
_ <- myShips -- in order to fetch the starting probe that is not advertised in the register message
let t = token r' let t = token r'
addToken t addToken t
return t return t