summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/Database/Contracts.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haskell/src/SpaceTraders/Database/Contracts.hs33
1 files changed, 13 insertions, 20 deletions
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)