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