adyxax/spacetraders
1
0
Fork 0
Code Issues Activity

[haskell] Removed available timestamp from ship's database schema

Browse source
This commit is contained in:
Julien Dessaux 2023-10-14 23:59:32 +02:00
parent a6c8173d88
commit 0ecb8e87c0
Signed by: adyxax
GPG key ID: F92E51B86E07177E
4 changed files with 11 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
haskell/src/SpaceTraders/APIClient/Ships.hs
View file

@ -29,7 +29,7 @@ dock ship = do
Left e -> return $ Left e Left e -> return $ Left e
Right (NavMessage n) -> do Right (NavMessage n) -> do
let s = ship{SpaceTraders.Model.Ship.nav=n} let s = ship{SpaceTraders.Model.Ship.nav=n}
updateShip s Nothing updateShip s
return $ Right s return $ Right s
myShips :: SpaceTradersT (APIResponse [Ship]) myShips :: SpaceTradersT (APIResponse [Ship])
@ -55,5 +55,5 @@ orbit ship = do
Left e -> return $ Left e Left e -> return $ Left e
Right (NavMessage n) -> do Right (NavMessage n) -> do
let s = ship{SpaceTraders.Model.Ship.nav=n} let s = ship{SpaceTraders.Model.Ship.nav=n}
updateShip s Nothing updateShip s
return $ Right s return $ Right s

3
haskell/src/SpaceTraders/Database/000_init.sql
View file

@ -15,8 +15,7 @@ CREATE TABLE contracts (
); );
CREATE TABLE ships ( CREATE TABLE ships (
id INTEGER PRIMARY KEY, id INTEGER PRIMARY KEY,
data TEXT NOT NULL, data TEXT NOT NULL
available DATE NOT NULL
); );
CREATE UNIQUE INDEX ships_data_symbol ON ships (json_extract(data, '$.symbol')); CREATE UNIQUE INDEX ships_data_symbol ON ships (json_extract(data, '$.symbol'));
CREATE TABLE systems ( CREATE TABLE systems (

13
haskell/src/SpaceTraders/Database/Ships.hs
View file

@ -9,8 +9,6 @@ module SpaceTraders.Database.Ships
import Control.Monad.Reader import Control.Monad.Reader
import Data.Aeson import Data.Aeson
import Data.Time
import Data.Time.Format.ISO8601
import qualified Database.SQLite.Simple as S import qualified Database.SQLite.Simple as S
import SpaceTraders import SpaceTraders
@ -18,9 +16,7 @@ import SpaceTraders.Model.Ship
import SpaceTraders.Utils import SpaceTraders.Utils
addShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m () addShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
addShip ship = do addShip ship = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship)
t <- liftIO getCurrentTime
execute "INSERT INTO ships(data, available) VALUES (json(?), ?);" (encode ship, iso8601Show t)
getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship] getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship]
getShips = query_ "SELECT data FROM ships;" getShips = query_ "SELECT data FROM ships;"
@ -29,8 +25,7 @@ setShip :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => S
setShip ship = do setShip ship = do
c <- count "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship) c <- count "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship)
if c == 0 then addShip 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 :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
updateShip ship (Just time) = execute "UPDATE ships SET data = json(?), available = ? WHERE data->>'symbol' = ?;" (encode ship, iso8601Show time, symbol ship) updateShip ship = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship)
updateShip ship Nothing = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship)

2
haskell/src/SpaceTraders/Model/Waypoint.hs
View file

@ -22,7 +22,7 @@ instance FromJSON Waypoint where
<*> o .: "x" <*> o .: "x"
<*> o .: "y" <*> o .: "y"
instance ToJSON Waypoint where instance ToJSON Waypoint where
toJSON (Waypoint s t xx yy) = object [ "symbol" .= s toJSON (Waypoint o s t xx yy) = object [ "symbol" .= s
, "type" .= t , "type" .= t
, "x" .= xx , "x" .= xx
, "y" .= yy ] , "y" .= yy ]