diff options
author | Julien Dessaux | 2023-10-16 23:18:38 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-10-16 23:33:40 +0200 |
commit | 8c5ad1533d8278d736fed7d6cf61a7fbe0d84282 (patch) | |
tree | b0d4228a347ac0b4fae87c2174d241a0a50100a4 /haskell | |
parent | [haskell] Update models for september 14th changelog (diff) | |
download | spacetraders-8c5ad1533d8278d736fed7d6cf61a7fbe0d84282.tar.gz spacetraders-8c5ad1533d8278d736fed7d6cf61a7fbe0d84282.tar.bz2 spacetraders-8c5ad1533d8278d736fed7d6cf61a7fbe0d84282.zip |
[haskell] updated main, init and server reset handling
Diffstat (limited to '')
-rw-r--r-- | haskell/app/Main.hs | 30 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/APIClient/Client.hs | 9 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Automation/Init.hs | 1 |
3 files changed, 17 insertions, 23 deletions
diff --git a/haskell/app/Main.hs b/haskell/app/Main.hs index a7774e5..edd84cc 100644 --- a/haskell/app/Main.hs +++ b/haskell/app/Main.hs @@ -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 () diff --git a/haskell/src/SpaceTraders/APIClient/Client.hs b/haskell/src/SpaceTraders/APIClient/Client.hs index 5c2aa66..9229813 100644 --- a/haskell/src/SpaceTraders/APIClient/Client.hs +++ b/haskell/src/SpaceTraders/APIClient/Client.hs @@ -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 diff --git a/haskell/src/SpaceTraders/Automation/Init.hs b/haskell/src/SpaceTraders/Automation/Init.hs index 42c19e1..6a368ca 100644 --- a/haskell/src/SpaceTraders/Automation/Init.hs +++ b/haskell/src/SpaceTraders/Automation/Init.hs @@ -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 |