summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/Database
diff options
context:
space:
mode:
Diffstat (limited to 'haskell/src/SpaceTraders/Database')
-rw-r--r--haskell/src/SpaceTraders/Database/Agents.hs15
-rw-r--r--haskell/src/SpaceTraders/Database/Contracts.hs23
-rw-r--r--haskell/src/SpaceTraders/Database/Ships.hs26
3 files changed, 63 insertions, 1 deletions
diff --git a/haskell/src/SpaceTraders/Database/Agents.hs b/haskell/src/SpaceTraders/Database/Agents.hs
index b34ca04..0557b1d 100644
--- a/haskell/src/SpaceTraders/Database/Agents.hs
+++ b/haskell/src/SpaceTraders/Database/Agents.hs
@@ -2,16 +2,31 @@
module SpaceTraders.Database.Agents
( addAgent
+ , getAgent
+ , setAgent
) where
import Control.Monad.Reader
import Data.Aeson
+import Data.Maybe
import qualified Database.SQLite.Simple as S
import SpaceTraders
import SpaceTraders.Model.Agent
+import SpaceTraders.Utils
addAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Agent -> m ()
addAgent agent = do
env <- ask
liftIO $ S.execute (getConn env) "INSERT INTO agents(data) VALUES (json(?));" (S.Only (encode agent))
+
+getAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m Agent
+getAgent = do
+ env <- ask
+ ret <- liftIO $ S.query_ (getConn env) "SELECT data FROM agents;"
+ return . head . catMaybes $ map (decodeText . head) ret
+
+setAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Agent -> m ()
+setAgent agent = do
+ env <- ask
+ liftIO $ S.execute (getConn env) "UPDATE agents SET data = json(?);" (S.Only (encode agent))
diff --git a/haskell/src/SpaceTraders/Database/Contracts.hs b/haskell/src/SpaceTraders/Database/Contracts.hs
index 26c4a1f..1084447 100644
--- a/haskell/src/SpaceTraders/Database/Contracts.hs
+++ b/haskell/src/SpaceTraders/Database/Contracts.hs
@@ -2,16 +2,39 @@
module SpaceTraders.Database.Contracts
( addContract
+ , getContracts
+ , setContract
+ , updateContract
) where
import Control.Monad.Reader
import Data.Aeson
+import Data.Maybe
import qualified Database.SQLite.Simple as S
import SpaceTraders
import SpaceTraders.Model.Contract
+import SpaceTraders.Utils
addContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m ()
addContract contract = do
env <- ask
liftIO $ S.execute (getConn env) "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract))
+
+getContracts :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Contract]
+getContracts = do
+ env <- ask
+ ret <- liftIO $ S.query_ (getConn env) "SELECT data FROM contracts;"
+ return . catMaybes $ map (decodeText . head) ret
+
+setContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m ()
+setContract contract = do
+ env <- ask
+ count <- liftIO (S.query (getConn env) "SELECT count(id) FROM contracts WHERE data->>'contractId' = ?;" (S.Only $ contractId contract) :: IO [[Int]])
+ if count == [[0]] then addContract contract
+ else updateContract contract
+
+updateContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m ()
+updateContract contract = do
+ env <- ask
+ liftIO $ S.execute (getConn env) "UPDATE contracts SET data = json(?) WHERE data->>'contractId' = ?;" (encode contract, contractId contract)
diff --git a/haskell/src/SpaceTraders/Database/Ships.hs b/haskell/src/SpaceTraders/Database/Ships.hs
index 95b0b5d..5dd6be0 100644
--- a/haskell/src/SpaceTraders/Database/Ships.hs
+++ b/haskell/src/SpaceTraders/Database/Ships.hs
@@ -2,16 +2,40 @@
module SpaceTraders.Database.Ships
( addShip
+ , getShips
+ , setShip
+ , updateShip
) where
+import Control.Monad.Except
import Control.Monad.Reader
import Data.Aeson
+import Data.Maybe
import qualified Database.SQLite.Simple as S
import SpaceTraders
import SpaceTraders.Model.Ship
+import SpaceTraders.Utils
addShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
addShip ship = do
env <- ask
- liftIO $ S.execute (getConn env) "INSERT INTO ships(data) VALUES (json(?));" (S.Only (encode ship))
+ liftIO $ S.execute (getConn env) "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship)
+
+getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship]
+getShips = do
+ env <- ask
+ ret <- liftIO $ S.query_ (getConn env) "SELECT data FROM ships;"
+ return . catMaybes $ map (decodeText . head) ret
+
+setShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
+setShip ship = do
+ env <- ask
+ count <- liftIO (S.query (getConn env) "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship) :: IO [[Int]])
+ if count == [[0]] then addShip ship
+ else updateShip ship
+
+updateShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m ()
+updateShip ship = do
+ env <- ask
+ liftIO $ S.execute (getConn env) "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship)