diff options
author | Julien Dessaux | 2023-10-14 23:59:32 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-10-16 23:33:36 +0200 |
commit | 0ecb8e87c0ab3448accbbdf58551f51969999bdb (patch) | |
tree | aa3e54a01483e4265424cd454b37fa0742bb424f /haskell/src/SpaceTraders | |
parent | [javascript] Upgraded dependencies (diff) | |
download | spacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.tar.gz spacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.tar.bz2 spacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.zip |
[haskell] Removed available timestamp from ship's database schema
Diffstat (limited to 'haskell/src/SpaceTraders')
-rw-r--r-- | haskell/src/SpaceTraders/APIClient/Ships.hs | 4 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Database/000_init.sql | 3 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Database/Ships.hs | 13 | ||||
-rw-r--r-- | haskell/src/SpaceTraders/Model/Waypoint.hs | 8 |
4 files changed, 11 insertions, 17 deletions
diff --git a/haskell/src/SpaceTraders/APIClient/Ships.hs b/haskell/src/SpaceTraders/APIClient/Ships.hs index f4b7290..87c5ecb 100644 --- a/haskell/src/SpaceTraders/APIClient/Ships.hs +++ b/haskell/src/SpaceTraders/APIClient/Ships.hs @@ -29,7 +29,7 @@ dock ship = do Left e -> return $ Left e Right (NavMessage n) -> do let s = ship{SpaceTraders.Model.Ship.nav=n} - updateShip s Nothing + updateShip s return $ Right s myShips :: SpaceTradersT (APIResponse [Ship]) @@ -55,5 +55,5 @@ orbit ship = do Left e -> return $ Left e Right (NavMessage n) -> do let s = ship{SpaceTraders.Model.Ship.nav=n} - updateShip s Nothing + updateShip s return $ Right s diff --git a/haskell/src/SpaceTraders/Database/000_init.sql b/haskell/src/SpaceTraders/Database/000_init.sql index cbe6029..78a62cd 100644 --- a/haskell/src/SpaceTraders/Database/000_init.sql +++ b/haskell/src/SpaceTraders/Database/000_init.sql @@ -15,8 +15,7 @@ CREATE TABLE contracts ( ); CREATE TABLE ships ( id INTEGER PRIMARY KEY, - data TEXT NOT NULL, - available DATE NOT NULL + data TEXT NOT NULL ); CREATE UNIQUE INDEX ships_data_symbol ON ships (json_extract(data, '$.symbol')); CREATE TABLE systems ( diff --git a/haskell/src/SpaceTraders/Database/Ships.hs b/haskell/src/SpaceTraders/Database/Ships.hs index 8c47059..5a2ab7c 100644 --- a/haskell/src/SpaceTraders/Database/Ships.hs +++ b/haskell/src/SpaceTraders/Database/Ships.hs @@ -9,8 +9,6 @@ module SpaceTraders.Database.Ships import Control.Monad.Reader import Data.Aeson -import Data.Time -import Data.Time.Format.ISO8601 import qualified Database.SQLite.Simple as S import SpaceTraders @@ -18,9 +16,7 @@ import SpaceTraders.Model.Ship import SpaceTraders.Utils addShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m () -addShip ship = do - t <- liftIO getCurrentTime - execute "INSERT INTO ships(data, available) VALUES (json(?), ?);" (encode ship, iso8601Show t) +addShip ship = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship) getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship] getShips = query_ "SELECT data FROM ships;" @@ -29,8 +25,7 @@ setShip :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => S setShip ship = do c <- count "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship) if c == 0 then addShip ship - else updateShip ship Nothing + else updateShip ship -updateShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> Maybe UTCTime -> m () -updateShip ship (Just time) = execute "UPDATE ships SET data = json(?), available = ? WHERE data->>'symbol' = ?;" (encode ship, iso8601Show time, symbol ship) -updateShip ship Nothing = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship) +updateShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m () +updateShip ship = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship) diff --git a/haskell/src/SpaceTraders/Model/Waypoint.hs b/haskell/src/SpaceTraders/Model/Waypoint.hs index 458df21..b32af75 100644 --- a/haskell/src/SpaceTraders/Model/Waypoint.hs +++ b/haskell/src/SpaceTraders/Model/Waypoint.hs @@ -22,7 +22,7 @@ instance FromJSON Waypoint where <*> o .: "x" <*> o .: "y" instance ToJSON Waypoint where - toJSON (Waypoint s t xx yy) = object [ "symbol" .= s - , "type" .= t - , "x" .= xx - , "y" .= yy ] + toJSON (Waypoint o s t xx yy) = object [ "symbol" .= s + , "type" .= t + , "x" .= xx + , "y" .= yy ] |