[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
|
||||
|
||||
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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue