From 4af96da5670566c111fa5c7dac9572eaac021a4b Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Tue, 18 Jul 2023 00:02:33 +0200 Subject: [haskell] Refactored everything with a ReaderT pattern --- haskell/src/SpaceTraders/Database/Agents.hs | 10 +++++++--- haskell/src/SpaceTraders/Database/Contracts.hs | 8 ++++++-- haskell/src/SpaceTraders/Database/Ships.hs | 8 ++++++-- haskell/src/SpaceTraders/Database/Systems.hs | 22 +++++++++++++--------- haskell/src/SpaceTraders/Database/Tokens.hs | 22 ++++++++++++++-------- haskell/src/SpaceTraders/Database/Utils.hs | 11 +++++++++++ 6 files changed, 57 insertions(+), 24 deletions(-) create mode 100644 haskell/src/SpaceTraders/Database/Utils.hs (limited to 'haskell/src/SpaceTraders/Database') 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 -- cgit v1.2.3