From 7e27a0a7eada373780a9757fd89f70d4d911d69a Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Fri, 22 Mar 2024 01:13:34 +0100 Subject: [haskell] refactoring --- haskell/src/SpaceTraders/Database/Agents.hs | 28 +++++++++++----------- haskell/src/SpaceTraders/Database/Contracts.hs | 33 ++++++++++---------------- haskell/src/SpaceTraders/Database/Ships.hs | 33 ++++++++++---------------- haskell/src/SpaceTraders/Database/Systems.hs | 12 +++++----- haskell/src/SpaceTraders/Database/Tokens.hs | 12 ++++------ 5 files changed, 51 insertions(+), 67 deletions(-) (limited to 'haskell/src/SpaceTraders/Database') diff --git a/haskell/src/SpaceTraders/Database/Agents.hs b/haskell/src/SpaceTraders/Database/Agents.hs index 49ae11f..d596d79 100644 --- a/haskell/src/SpaceTraders/Database/Agents.hs +++ b/haskell/src/SpaceTraders/Database/Agents.hs @@ -1,24 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.Database.Agents - ( addAgent - , getAgent + ( getAgent , setAgent ) where -import Control.Monad.Reader -import Data.Aeson -import qualified Database.SQLite.Simple as S +import Control.Monad.Error.Class +import Control.Monad.Reader +import Data.Aeson +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 = execute "INSERT INTO agents(data) VALUES (json(?));" (S.Only (encode agent)) +import SpaceTraders +import SpaceTraders.Model.Agent +import SpaceTraders.Utils getAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m Agent -getAgent = one_ "SELECT data FROM agents"; +getAgent = one_ "SELECT data FROM agents"; -- we only support one agent at a time -setAgent :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => Agent -> m () -setAgent agent = execute "UPDATE agents SET data = json(?);" (S.Only (encode agent)) +setAgent :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Agent -> m () +setAgent agent = updateAgent `catchError` addAgent + where + addAgent _ = execute "INSERT INTO agents(data) VALUES (json(?));" (S.Only $ encode agent) + updateAgent = 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 20170ba..7cebc37 100644 --- a/haskell/src/SpaceTraders/Database/Contracts.hs +++ b/haskell/src/SpaceTraders/Database/Contracts.hs @@ -1,31 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.Database.Contracts - ( addContract - , getContracts + ( getContracts , setContract - , updateContract ) where -import Control.Monad.Reader -import Data.Aeson -import qualified Database.SQLite.Simple as S +import Control.Monad.Error.Class +import Control.Monad.Reader +import Data.Aeson +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 = execute "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract)) +import SpaceTraders +import SpaceTraders.Model.Contract +import SpaceTraders.Utils getContracts :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Contract] getContracts = query_ "SELECT data FROM contracts;" -setContract :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => Contract -> m () -setContract contract = do - 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 = execute "UPDATE contracts SET data = json(?) WHERE data->>'contractId' = ?;" (encode contract, contractId contract) +setContract :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Contract -> m () +setContract contract = updateContract `catchError` addContract + where + addContract _ = execute "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract)) + updateContract = 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 5a2ab7c..eabf429 100644 --- a/haskell/src/SpaceTraders/Database/Ships.hs +++ b/haskell/src/SpaceTraders/Database/Ships.hs @@ -1,31 +1,24 @@ {-# LANGUAGE OverloadedStrings #-} module SpaceTraders.Database.Ships - ( addShip - , getShips + ( getShips , setShip - , updateShip ) where -import Control.Monad.Reader -import Data.Aeson -import qualified Database.SQLite.Simple as S +import Control.Monad.Error.Class +import Control.Monad.Reader +import Data.Aeson +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 = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship) +import SpaceTraders +import SpaceTraders.Model.Ship +import SpaceTraders.Utils getShips :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => m [Ship] getShips = query_ "SELECT data FROM ships;" -setShip :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => Ship -> m () -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 - -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) +setShip :: (HasDatabaseConn env, MonadError e m, MonadIO m, MonadReader env m) => Ship -> m () +setShip ship = updateShip `catchError` addShip + where + addShip _ = execute "INSERT INTO ships(data) VALUES (json(?));" (S.Only $ encode ship) + updateShip = 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 07749be..7c43caf 100644 --- a/haskell/src/SpaceTraders/Database/Systems.hs +++ b/haskell/src/SpaceTraders/Database/Systems.hs @@ -5,13 +5,13 @@ module SpaceTraders.Database.Systems , getSystems ) where -import Control.Monad.Reader -import Data.Aeson -import qualified Database.SQLite.Simple as S +import Control.Monad.Reader +import Data.Aeson +import qualified Database.SQLite.Simple as S -import SpaceTraders -import SpaceTraders.Model.System -import SpaceTraders.Utils +import SpaceTraders +import SpaceTraders.Model.System +import SpaceTraders.Utils addSystems :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => [System] -> m () addSystems systems = do diff --git a/haskell/src/SpaceTraders/Database/Tokens.hs b/haskell/src/SpaceTraders/Database/Tokens.hs index e99e49e..0a29a55 100644 --- a/haskell/src/SpaceTraders/Database/Tokens.hs +++ b/haskell/src/SpaceTraders/Database/Tokens.hs @@ -1,21 +1,19 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} module SpaceTraders.Database.Tokens ( addToken , getToken ) where -import Control.Monad.Reader +import Control.Monad.Reader +import qualified Data.Text as T import qualified Database.SQLite.Simple as S -import qualified Data.Text as T -import SpaceTraders +import SpaceTraders +import SpaceTraders.Utils addToken :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => T.Text -> m () -addToken value = do - env <- ask - liftIO $ S.execute (getConn env) "INSERT INTO tokens(data) VALUES (?);" (S.Only value) +addToken value = execute "INSERT INTO tokens(data) VALUES (?);" (S.Only value) getToken :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => m T.Text getToken = do -- cgit v1.2.3