back/src/Guide/Database/Schema.hs
-- | Schemas to create table for guide database
module Guide.Database.Schema
(
setupDatabase,
)
where
import Imports
import Hasql.Session (Session)
import Hasql.Statement (Statement (..))
import Data.Profunctor (lmap)
import qualified Hasql.Session as HS
import Guide.Database.Utils
import Guide.Database.Connection (connect, runSession)
-- | List of all migrations.
migrations :: [(Int32, Session ())]
migrations =
[ (0, v0)
]
-- | Prepare the database for use by Guide.
--
-- Determines which migrations have to be run, and runs them. Errors out if
-- any migrations fail.
--
-- Note: 'setupDatabase' uses @"guide"@ as the database name, but it does
-- not create a database if it does not exist yet. You should create the
-- database manually by doing @CREATE DATABASE guide;@ or run Postgres with
-- @POSTGRES_DB=guide@ when running when running the app for the first time.
setupDatabase :: IO ()
setupDatabase = do
conn <- connect
mbSchemaVersion <- runSession conn getSchemaVersion
case mbSchemaVersion of
Nothing -> formatLn "No schema found. Creating tables and running all migrations."
Just v -> formatLn "Schema version is {}." v
let schemaVersion = fromMaybe (-1) mbSchemaVersion
let neededMigrations =
filter
(\(migrationVersion, _) -> migrationVersion > schemaVersion)
migrations
if null neededMigrations then
putStrLn "Schema is up to date."
else do
putStrLn "Schema is not up to date, running migrations."
for_ neededMigrations $ \(migrationVersion, migration) -> do
format "Migration {}: " migrationVersion
runSession conn (migration >> setSchemaVersion migrationVersion)
formatLn "done."
----------------------------------------------------------------------------
-- Schema version table
----------------------------------------------------------------------------
-- | Get schema version (i.e. the version of the last migration that was
-- run).
--
-- If the @schema_version@ table doesn't exist, creates it.
getSchemaVersion :: Session (Maybe Int32)
getSchemaVersion = do
HS.statement () $
[execute|
CREATE TABLE IF NOT EXISTS schema_version (
name text PRIMARY KEY,
version integer)
|]
HS.statement () $
[execute|
INSERT INTO schema_version (name, version)
VALUES ('main', null)
ON CONFLICT DO NOTHING
|]
let selectVersion :: Statement () (Maybe (SingleColumn (Maybe Int32)))
selectVersion =
[queryRowMaybe|
SELECT version FROM schema_version WHERE name = 'main'
|]
HS.statement () selectVersion >>= \case
Just (SingleColumn (Just v)) -> pure (Just v)
_ -> pure Nothing
-- | Set schema version.
--
-- Assumes the @schema_version@ table exists.
setSchemaVersion :: Int32 -> Session ()
setSchemaVersion version = do
let statement :: Statement Int32 ()
statement = lmap SingleParam $
[execute|
UPDATE schema_version SET version = $1 WHERE name = 'main'
|]
HS.statement version statement
----------------------------------------------------------------------------
-- Version 0
----------------------------------------------------------------------------
-- | Schema version 0: initial schema.
v0 :: Session ()
v0 = do
v0_createTypeProCon
v0_createTableCategories
v0_createTableItems
v0_createTableTraits
v0_createTableUsers
v0_createTablePendingEdits
-- | Create an enum type for trait type ("pro" or "con").
v0_createTypeProCon :: Session ()
v0_createTypeProCon = HS.statement () $
[execute|
CREATE TYPE trait_type AS ENUM ('pro', 'con');
|]
-- | Create table @traits@, corresponding to 'Guide.Types.Core.Trait'.
v0_createTableTraits :: Session ()
v0_createTableTraits = HS.statement () $
[execute|
CREATE TABLE traits (
uid text PRIMARY KEY, -- Unique trait ID
content text NOT NULL, -- Trait content as Markdown
deleted boolean -- Whether the trait is deleted
NOT NULL,
type_ trait_type NOT NULL, -- Trait type (pro or con)
item_uid text -- Item that the trait belongs to
REFERENCES items (uid)
ON DELETE CASCADE
);
|]
-- | Create table @items@, corresponding to 'Guide.Types.Core.Item'.
v0_createTableItems :: Session ()
v0_createTableItems = HS.statement () $
[execute|
CREATE TABLE items (
uid text PRIMARY KEY, -- Unique item ID
name text NOT NULL, -- Item title
created timestamptz NOT NULL, -- When the item was created
link text, -- Optional URL
hackage text, -- Package name on Hackage
summary text NOT NULL, -- Item summary as Markdown
ecosystem text NOT NULL, -- The ecosystem section
notes text NOT NULL, -- The notes section
deleted boolean -- Whether the item is deleted
NOT NULL,
category_uid text -- Category that the item belongs to
REFERENCES categories (uid)
ON DELETE CASCADE,
pros_order text[] -- Uids of item's pro traits; this list specifies
NOT NULL, -- in what order they should be displayed, and
-- is necessary to allow moving traits up and
-- down
cons_order text[] -- Uids of item's con traits
NOT NULL
);
|]
-- | Create table @categories@, corresponding to 'Guide.Types.Core.Category'.
v0_createTableCategories :: Session ()
v0_createTableCategories = HS.statement () $
[execute|
CREATE TABLE categories (
uid text PRIMARY KEY, -- Unique category ID
title text NOT NULL, -- Category title
created timestamptz NOT NULL, -- When the category was created
group_ text NOT NULL, -- "Grandcategory"
status text NOT NULL, -- Category status ("in progress", etc); the list
-- of possible statuses is defined by backend
notes text NOT NULL, -- Category notes as Markdown
enabled_sections text[] -- Item sections to show to users; the list of
NOT NULL, -- possible section names is defined by backend
items_order text[] -- Uids of items in the category; this list
NOT NULL, -- specifies in what order they should be
-- displayed, and is necessary to allow moving
-- items up and down
deleted boolean -- Whether the category is deleted
NOT NULL
);
|]
-- | Create table @users@, storing user data.
v0_createTableUsers :: Session ()
v0_createTableUsers = HS.statement () $
[execute|
CREATE TABLE users (
uid text PRIMARY KEY, -- Unique user ID
name text NOT NULL, -- User name
email text NOT NULL, -- User email
password_scrypt text, -- User password (scrypt-ed)
is_admin boolean -- Whether the user is admin
DEFAULT false
NOT NULL
);
|]
-- | Create table @pending_edits@, storing users' edits and metadata about
-- them (who made the edit, when, etc).
v0_createTablePendingEdits :: Session ()
v0_createTablePendingEdits = HS.statement () $
[execute|
CREATE TABLE pending_edits (
uid bigserial PRIMARY KEY, -- Unique id
edit json NOT NULL, -- Edit in JSON format
ip inet, -- IP address of edit maker
time_ timestamptz NOT NULL -- When the edit was created
);
|]