1
0
Fork 0

Bootstrapped my haskell client

This commit is contained in:
Julien Dessaux 2023-07-02 22:58:30 +02:00
parent 36cc33f9e9
commit a775330b4f
Signed by: adyxax
GPG key ID: F92E51B86E07177E
12 changed files with 389 additions and 2 deletions

View file

@ -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