[haskell] updated main, init and server reset handling
This commit is contained in:
parent
414aebd697
commit
8c5ad1533d
3 changed files with 17 additions and 23 deletions
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue