diff options
author | Julien Dessaux | 2023-07-21 00:01:02 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-07-21 00:01:02 +0200 |
commit | dcd0a7a9b2612f383c1f627c72c27868c367058d (patch) | |
tree | 773b322f5b353cd39fbaf4161deba93968d20b56 /haskell/src/SpaceTraders/Database/Ships.hs | |
parent | [haskell] Finalized the agent initialization, refresh and reset (diff) | |
download | spacetraders-dcd0a7a9b2612f383c1f627c72c27868c367058d.tar.gz spacetraders-dcd0a7a9b2612f383c1f627c72c27868c367058d.tar.bz2 spacetraders-dcd0a7a9b2612f383c1f627c72c27868c367058d.zip |
[haskell] abstracted away common database access patterns
Diffstat (limited to 'haskell/src/SpaceTraders/Database/Ships.hs')
-rw-r--r-- | haskell/src/SpaceTraders/Database/Ships.hs | 24 |
1 files changed, 7 insertions, 17 deletions
diff --git a/haskell/src/SpaceTraders/Database/Ships.hs b/haskell/src/SpaceTraders/Database/Ships.hs index 5dd6be0..5a2ab7c 100644 --- a/haskell/src/SpaceTraders/Database/Ships.hs +++ b/haskell/src/SpaceTraders/Database/Ships.hs @@ -7,10 +7,8 @@ module SpaceTraders.Database.Ships , 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 @@ -18,24 +16,16 @@ 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) +addShip ship = execute "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 +getShips = query_ "SELECT data FROM ships;" -setShip :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Ship -> m () +setShip :: (HasDatabaseConn env, MonadFail m, 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 + c <- count "SELECT count(id) FROM ships WHERE data->>'symbol' = ?;" (S.Only $ symbol ship) + if c == 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) +updateShip ship = execute "UPDATE ships SET data = json(?) WHERE data->>'symbol' = ?;" (encode ship, symbol ship) |