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