summaryrefslogtreecommitdiff
path: root/haskell/src/SpaceTraders/Database
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--haskell/src/SpaceTraders/Database/Agents.hs10
-rw-r--r--haskell/src/SpaceTraders/Database/Contracts.hs8
-rw-r--r--haskell/src/SpaceTraders/Database/Ships.hs8
-rw-r--r--haskell/src/SpaceTraders/Database/Systems.hs22
-rw-r--r--haskell/src/SpaceTraders/Database/Tokens.hs22
-rw-r--r--haskell/src/SpaceTraders/Database/Utils.hs11
6 files changed, 57 insertions, 24 deletions
diff --git a/haskell/src/SpaceTraders/Database/Agents.hs b/haskell/src/SpaceTraders/Database/Agents.hs
index 48cd65b..b34ca04 100644
--- a/haskell/src/SpaceTraders/Database/Agents.hs
+++ b/haskell/src/SpaceTraders/Database/Agents.hs
@@ -1,13 +1,17 @@
{-# LANGUAGE OverloadedStrings #-}
module SpaceTraders.Database.Agents
- ( setAgent
+ ( addAgent
) where
+import Control.Monad.Reader
import Data.Aeson
import qualified Database.SQLite.Simple as S
+import SpaceTraders
import SpaceTraders.Model.Agent
-setAgent :: S.Connection -> Agent -> IO ()
-setAgent conn agent = S.execute conn "INSERT INTO agents(data) VALUES (json(?));" (S.Only (encode agent))
+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))
diff --git a/haskell/src/SpaceTraders/Database/Contracts.hs b/haskell/src/SpaceTraders/Database/Contracts.hs
index 1ef5d6d..26c4a1f 100644
--- a/haskell/src/SpaceTraders/Database/Contracts.hs
+++ b/haskell/src/SpaceTraders/Database/Contracts.hs
@@ -4,10 +4,14 @@ module SpaceTraders.Database.Contracts
( addContract
) where
+import Control.Monad.Reader
import Data.Aeson
import qualified Database.SQLite.Simple as S
+import SpaceTraders
import SpaceTraders.Model.Contract
-addContract :: S.Connection -> Contract -> IO ()
-addContract conn contract = S.execute conn "INSERT INTO contracts(data) VALUES (json(?));" (S.Only (encode contract))
+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))
diff --git a/haskell/src/SpaceTraders/Database/Ships.hs b/haskell/src/SpaceTraders/Database/Ships.hs
index 81c422d..95b0b5d 100644
--- a/haskell/src/SpaceTraders/Database/Ships.hs
+++ b/haskell/src/SpaceTraders/Database/Ships.hs
@@ -4,10 +4,14 @@ module SpaceTraders.Database.Ships
( addShip
) where
+import Control.Monad.Reader
import Data.Aeson
import qualified Database.SQLite.Simple as S
+import SpaceTraders
import SpaceTraders.Model.Ship
-addShip :: S.Connection -> Ship -> IO ()
-addShip conn ship = S.execute conn "INSERT INTO ships(data) VALUES (json(?));" (S.Only (encode ship))
+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))
diff --git a/haskell/src/SpaceTraders/Database/Systems.hs b/haskell/src/SpaceTraders/Database/Systems.hs
index 5312fd0..f71508e 100644
--- a/haskell/src/SpaceTraders/Database/Systems.hs
+++ b/haskell/src/SpaceTraders/Database/Systems.hs
@@ -5,19 +5,23 @@ module SpaceTraders.Database.Systems
, getSystems
) where
+import Control.Monad.Reader
import Data.Aeson
import Data.Maybe
import qualified Database.SQLite.Simple as S
-import Data.Text.Encoding (encodeUtf8Builder)
-import Data.ByteString.Builder(toLazyByteString)
-
+import SpaceTraders
+import SpaceTraders.Database.Utils
import SpaceTraders.Model.System
-addSystems :: S.Connection -> [System] -> IO ()
-addSystems conn systems = S.withTransaction conn $ S.executeMany conn "INSERT INTO systems(data) VALUES (json(?));" $ S.Only <$> map encode systems
+addSystems :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => [System] -> m ()
+addSystems systems = do
+ env <- ask
+ let conn = getConn env
+ liftIO $ S.withTransaction conn $ S.executeMany conn "INSERT INTO systems(data) VALUES (json(?));" $ S.Only <$> map encode systems
-getSystems :: S.Connection -> IO [System]
-getSystems conn = do
- ret <- S.query_ conn "SELECT data from systems;"
- return . catMaybes $ map (decode . toLazyByteString . encodeUtf8Builder . head) ret
+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
diff --git a/haskell/src/SpaceTraders/Database/Tokens.hs b/haskell/src/SpaceTraders/Database/Tokens.hs
index b907609..e99e49e 100644
--- a/haskell/src/SpaceTraders/Database/Tokens.hs
+++ b/haskell/src/SpaceTraders/Database/Tokens.hs
@@ -2,17 +2,23 @@
{-# LANGUAGE QuasiQuotes #-}
module SpaceTraders.Database.Tokens
- ( getToken
- , setToken
+ ( addToken
+ , getToken
) where
+import Control.Monad.Reader
import qualified Database.SQLite.Simple as S
import qualified Data.Text as T
-getToken :: S.Connection -> IO (T.Text)
-getToken conn = do
- [[token]] <- S.query_ conn "SELECT data FROM tokens;"
- return token
+import SpaceTraders
+
+addToken :: (HasDatabaseConn env, MonadIO m, MonadReader env m) => T.Text -> m ()
+addToken value = do
+ env <- ask
+ liftIO $ S.execute (getConn env) "INSERT INTO tokens(data) VALUES (?);" (S.Only value)
-setToken :: S.Connection -> T.Text -> IO ()
-setToken conn value = S.execute conn "INSERT INTO tokens(data) VALUES (?);" (S.Only value)
+getToken :: (HasDatabaseConn env, MonadFail m, MonadIO m, MonadReader env m) => m T.Text
+getToken = do
+ env <- ask
+ [[token]] <- liftIO $ S.query_ (getConn env) "SELECT data FROM tokens;"
+ return token
diff --git a/haskell/src/SpaceTraders/Database/Utils.hs b/haskell/src/SpaceTraders/Database/Utils.hs
new file mode 100644
index 0000000..4d933bd
--- /dev/null
+++ b/haskell/src/SpaceTraders/Database/Utils.hs
@@ -0,0 +1,11 @@
+module SpaceTraders.Database.Utils
+ ( decodeText
+ ) where
+
+import Data.Aeson
+import Data.ByteString.Builder(toLazyByteString)
+import qualified Data.Text as T
+import Data.Text.Encoding (encodeUtf8Builder)
+
+decodeText :: FromJSON a => T.Text -> Maybe a
+decodeText = decode . toLazyByteString . encodeUtf8Builder