summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/Database/Ships.hs
blob: 5a2ab7c5e40728b2edeb8206a0a93d6c3bec66a9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
{-# LANGUAGE OverloadedStrings #-}

module SpaceTraders.Database.Ships
  ( addShip
  , getShips
  , setShip
  , updateShip
  ) where

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)

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)