[haskell] abstracted away common database access patterns

4 files changed, 18 insertions, 49 deletions

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;"