blob: 66ff8931896a3e6e292a66e08225ea11f4e21975 (
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
32
33
34
35
36
37
38
39
40
41
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module SpaceTraders.Database
( close
, open
) where
import Control.Exception
import qualified Data.ByteString as B
import Data.FileEmbed
import qualified Database.SQLite.Simple as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
migrations :: [B.ByteString]
migrations = [ $(embedFile "src/SpaceTraders/Database/000_init.sql") ]
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) $ S.Query <$> (filter (/= "\n") . concat . map ((T.splitOn ";") . T.decodeUtf8) $ 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
|
