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
import Control.Exception
import System.Environment
import System.Posix.Process
import SpaceTraders
import SpaceTraders.Automation.Init
import SpaceTraders.APIClient.Errors
import SpaceTraders.APIClient.Ships
import SpaceTraders.APIClient.Systems
import SpaceTraders.Database.Agents
import SpaceTraders.Database.Contracts
import SpaceTraders.Database.Ships
main :: IO ()
main = do
env <- initST
runSpaceTradersT getAgent env >>= print
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
runSpaceTradersT main' 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 Network.HTTP.Simple
import Network.HTTP.Types.Status
import System.Directory
import System.Environment
import System.Posix.Process
import SpaceTraders
import SpaceTraders.APIClient.Errors
@ -86,4 +89,10 @@ sendPaginated pagination requestBuilder = do
Right (APIRateLimit r) -> do
liftIO $ delay (1_000_000 * (round $ retryAfter r))
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

View file

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