diff options
author | Julien Dessaux | 2023-07-02 22:58:30 +0200 |
---|---|---|
committer | Julien Dessaux | 2023-07-02 23:01:01 +0200 |
commit | a775330b4fa17fb367e55343e6fda6c7ae9e34b4 (patch) | |
tree | 8c572f799dbf434459d4659e32559c121421f120 /haskell/src/SpaceTraders/Database.hs | |
parent | Moved the nodejs agent to its own subfolder to make room for my haskell agent (diff) | |
download | spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.tar.gz spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.tar.bz2 spacetraders-a775330b4fa17fb367e55343e6fda6c7ae9e34b4.zip |
Bootstrapped my haskell client
Diffstat (limited to '')
-rw-r--r-- | haskell/src/SpaceTraders/Database.hs | 56 |
1 files changed, 56 insertions, 0 deletions
diff --git a/haskell/src/SpaceTraders/Database.hs b/haskell/src/SpaceTraders/Database.hs new file mode 100644 index 0000000..fdc32d3 --- /dev/null +++ b/haskell/src/SpaceTraders/Database.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module SpaceTraders.Database + ( close + , open + ) where + +import Control.Exception +import qualified Database.SQLite.Simple as S +import Text.RawString.QQ + +migrations :: [S.Query] +migrations = [ + [r|CREATE TABLE schema_version ( + version INTEGER NOT NULL + ); + |], + [r|CREATE TABLE tokens ( + id INTEGER PRIMARY KEY, + data TEXT NOT NULL + ); + |], + [r|CREATE TABLE agents ( + id INTEGER PRIMARY KEY, + data TEXT NOT NULL + ); + |], + [r|CREATE TABLE contracts ( + id INTEGER PRIMARY KEY, + data TEXT NOT NULL + ); + |]] + +close :: S.Connection -> IO () +close conn = S.close conn + +open :: IO S.Connection +open = do + conn <- S.open "spacetraders.db" + S.execute_ conn "PRAGMA foreign_keys = ON;" + S.execute_ conn "PRAGMA journal_mode = WAL;" + S.withTransaction conn $ do + version <- getSchemaVersion conn `catch` defaultVersion + mapM_ (S.execute_ conn) $ drop version migrations + S.execute_ conn "DELETE FROM schema_version;" + S.execute conn "INSERT INTO schema_version (version) VALUES (?);" (S.Only $ length migrations) + return conn + +getSchemaVersion :: S.Connection -> IO Int +getSchemaVersion conn = do + [[v]] <- S.query_ conn "SELECT version FROM schema_version;" + return v + +defaultVersion :: SomeException -> IO Int +defaultVersion _ = return 0 |