summaryrefslogtreecommitdiff
path: root/haskell
diff options
context:
space:
mode:
authorJulien Dessaux2023-10-14 23:59:32 +0200
committerJulien Dessaux2023-10-16 23:33:36 +0200
commit0ecb8e87c0ab3448accbbdf58551f51969999bdb (patch)
treeaa3e54a01483e4265424cd454b37fa0742bb424f /haskell
parent[javascript] Upgraded dependencies (diff)
downloadspacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.tar.gz
spacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.tar.bz2
spacetraders-0ecb8e87c0ab3448accbbdf58551f51969999bdb.zip
[haskell] Removed available timestamp from ship's database schema
Diffstat (limited to 'haskell')
-rw-r--r--haskell/src/SpaceTraders/APIClient/Ships.hs4
-rw-r--r--haskell/src/SpaceTraders/Database/000_init.sql3
-rw-r--r--haskell/src/SpaceTraders/Database/Ships.hs13
-rw-r--r--haskell/src/SpaceTraders/Model/Waypoint.hs8
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 ]