From dcd0a7a9b2612f383c1f627c72c27868c367058d Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Fri, 21 Jul 2023 00:01:02 +0200 Subject: [haskell] abstracted away common database access patterns --- haskell/src/SpaceTraders/Database/Agents.hs | 14 +++----------- haskell/src/SpaceTraders/Database/Contracts.hs | 23 +++++++---------------- haskell/src/SpaceTraders/Database/Ships.hs | 24 +++++++----------------- haskell/src/SpaceTraders/Database/Systems.hs | 6 +----- 4 files changed, 18 insertions(+), 49 deletions(-) (limited to 'haskell/src/SpaceTraders/Database') diff --git a/haskell/src/SpaceTraders/Database/Agents.hs b/haskell/src/SpaceTraders/Database/Agents.hs index 0557b1d..49ae11f 100644 --- a/haskell/src/SpaceTraders/Database/Agents.hs +++ b/haskell/src/SpaceTraders/Database/Agents.hs @@ -8,7 +8,6 @@ module SpaceTraders.Database.Agents import Control.Monad.Reader import Data.Aeson -import Data.Maybe import qualified Database.SQLite.Simple as S import SpaceTraders @@ -16,17 +15,10 @@ 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)) +addAgent agent = execute "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 +getAgent = one_ "SELECT data FROM agents"; 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)) +setAgent agent = execute "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 1084447..20170ba 100644 --- a/haskell/src/SpaceTraders/Database/Contracts.hs +++ b/haskell/src/SpaceTraders/Database/Contracts.hs @@ -9,7 +9,6 @@ module SpaceTraders.Database.Contracts import Control.Monad.Reader import Data.Aeson -import Data.Maybe import qualified Database.SQLite.Simple as S import SpaceTraders @@ -17,24 +16,16 @@ 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)) +addContract contract = execute "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 +getContracts = query_ "SELECT data FROM contracts;" -setContract :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Contract -> m () +setContract :: (HasDatabaseConn env, MonadFail m, 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 + c <- count "SELECT count(id) FROM contracts WHERE data->>'contractId' = ?;" (S.Only $ contractId contract) + if c == 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) +updateContract contract = execute "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 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) diff --git a/haskell/src/SpaceTraders/Database/Systems.hs b/haskell/src/SpaceTraders/Database/Systems.hs index d3d19c7..07749be 100644 --- a/haskell/src/SpaceTraders/Database/Systems.hs +++ b/haskell/src/SpaceTraders/Database/Systems.hs @@ -7,7 +7,6 @@ module SpaceTraders.Database.Systems import Control.Monad.Reader import Data.Aeson -import Data.Maybe import qualified Database.SQLite.Simple as S import SpaceTraders @@ -21,7 +20,4 @@ addSystems systems = do liftIO $ S.withTransaction conn $ S.executeMany conn "INSERT INTO systems(data) VALUES (json(?));" $ S.Only <$> map encode systems getSystems :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [System] -getSystems = do - env <- ask - ret <- liftIO $ S.query_ (getConn env) "SELECT data FROM systems;" - return . catMaybes $ map (decodeText . head) ret +getSystems = query_ "SELECT data FROM systems;" -- cgit v1.2.3