[ADP-2565] Implement Table database schema type and basic SQL opera…

…tions (#4689)

This pull request

* Implements a type `Table` that represents the schema of a table in a
database.
* Implements a basic set of database operations on top `sqlite-simple`
that work with this `Table` schema type. A demonstration can be found in
`Demo.Database`.

### Comments

* The `SqlM` monad, more precisely the `runSqlM` function, currently
makes no attempt at handling exceptions or concurrency correctly. It
doesn't look like this will turn out to be a good idea, I will fix this
in a future pull request.
* I have skipped extensive property testing for now, as I want to
stabilize the API first. The module `Demo.Database` provides a basic
functionality check.

### Issue Number

ADP-2565

lib/delta-table/delta-table.cabal

@@ -44,23 +44,28 @@ library
   hs-source-dirs:  src
   build-depends:
       base
+    , bytestring
     , containers
     , delta-store
     , delta-types
     , exceptions
-    , generic-lens
-    , io-classes
-    , monad-logger
-    , persistent
-    , stm
+    , Only == 0.1
+    , sqlite-simple
     , text
     , transformers
   hs-source-dirs:
       src
   exposed-modules:
       Data.Table
+      Database.Table
+      Database.Table.SQLite.Simple
+      Demo.Database
   other-modules:
-      Demo.TableOld
+      Database.Table.Schema
+      Database.Table.SQL.Column
+      Database.Table.SQL.Stmt
+      Database.Table.SQL.Table
+      Database.Table.SQLite.Simple.Exec
 
 test-suite unit
   import:             language, opts-exe

lib/delta-table/src/Database/Table.hs

@@ -0,0 +1,19 @@
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+The 'Table' data type represents a database table
+in a relational database.
+This type
+
+* tracks table and column names on the type level, and
+* tracks Haskell types for table columns.
+
+However, this type is /not/ yet specific to
+SQL or a particular database backend.
+-}
+module Database.Table
+    ( module Database.Table.Schema
+    ) where
+
+import Database.Table.Schema

lib/delta-table/src/Database/Table/SQL/Column.hs

@@ -0,0 +1,72 @@
+{-# LANGUAGE FlexibleInstances #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+SQL column types.
+-}
+module Database.Table.SQL.Column
+    (
+    -- * SQL column types
+      SqlType
+    , escapeSqlType
+
+    -- * Haskell types to SQL column types
+    , IsColumn (..)
+    ) where
+
+import Prelude
+
+import Data.ByteString
+    ( ByteString
+    )
+import Data.Text
+    ( Text
+    )
+
+import qualified Database.SQLite.Simple.FromField as Sqlite
+import qualified Database.SQLite.Simple.ToField as Sqlite
+
+{-------------------------------------------------------------------------------
+    Types for database columns
+-------------------------------------------------------------------------------}
+-- | SQL column types, including constraints.
+-- Example values:
+--
+-- > INTEGER  PRIMARY KEY NOT NULL
+-- > TEXT  NOT NULL
+newtype SqlType = SqlType Text
+    deriving (Eq,Ord,Show)
+
+escapeSqlType :: SqlType -> Text
+escapeSqlType (SqlType x) = x
+
+-- | Class that maps a Haskell type to a column type of an SQL database.
+-- Includes marshalling (via the `sqlite-simple` package).
+class (Sqlite.ToField a, Sqlite.FromField a) => IsColumn a where
+    getSqlType :: proxy a -> SqlType
+
+instance IsColumn Int where
+    getSqlType _ = SqlType "INTEGER NOT NULL"
+
+instance IsColumn (Maybe Int) where
+    getSqlType _ = SqlType "INTEGER"
+
+instance IsColumn Text where
+    getSqlType _ = SqlType "TEXT NOT NULL"
+
+instance IsColumn (Maybe Text) where
+    getSqlType _ = SqlType "TEXT"
+
+instance IsColumn String where
+    getSqlType _ = SqlType "TEXT NOT NULL"
+
+instance IsColumn (Maybe String) where
+    getSqlType _ = SqlType "TEXT"
+
+instance IsColumn ByteString where
+    getSqlType _ = SqlType "BLOB NOT NULL"
+
+instance IsColumn (Maybe ByteString) where
+    getSqlType _ = SqlType "BLOB"

lib/delta-table/src/Database/Table/SQL/Stmt.hs

@@ -0,0 +1,119 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+SQL statements for typed database tables.
+-}
+module Database.Table.SQL.Stmt
+    (
+    -- * SQL statements
+    Stmt
+    , renderStmt
+
+    -- * Specific statements
+    , createTable
+    , selectAll
+    , insertOne
+    , deleteAll
+    ) where
+
+import Prelude
+
+import Data.Text
+    ( Text
+    )
+import Database.Table
+    ( IsTable (getTableName)
+    , getColNames
+    , getTableName
+    )
+import Database.Table.SQL.Column
+    ( SqlType
+    , escapeSqlType
+    )
+import Database.Table.SQL.Table
+    ( IsTableSql
+    , getColumnTypes
+    )
+
+import qualified Data.Text as T
+
+{-------------------------------------------------------------------------------
+    SQL Statements
+-------------------------------------------------------------------------------}
+type TableName = Text
+type ColumnName = Text
+
+-- | A subset of SQL statements.
+data Stmt where
+    CreateTable :: TableName -> [(ColumnName, SqlType)] -> Stmt
+    Select :: [ColumnName] -> TableName -> Where -> Stmt
+    Insert :: TableName -> [ColumnName] -> Stmt
+    Delete :: TableName -> Where -> Stmt
+
+-- | An SQL @WHERE@ clause.
+data Where where
+    All :: Where
+
+{-------------------------------------------------------------------------------
+    Rendering
+-------------------------------------------------------------------------------}
+-- | Render an statement as SQL source code.
+renderStmt :: Stmt -> Text
+renderStmt (CreateTable table cols) =
+    "CREATE TABLE IF NOT EXISTS "
+        <> renderName table
+        <> " " <> renderTuple (map renderCol cols)
+        <> ";"
+  where
+    renderCol (col, typ)= renderName col <> " " <> escapeSqlType typ
+renderStmt (Insert table cols) =
+    "INSERT INTO "
+        <> renderName table
+        <> " " <> renderTuple (map renderName cols)
+        <> " VALUES " <> renderTuple ("?" <$ cols)
+        <> ";"
+renderStmt (Select cols table All) =
+    "SELECT " <> T.intercalate "," (map renderName cols)
+        <> " FROM " <> renderName table
+        <> ";"
+renderStmt (Delete table All) =
+    "DELETE FROM " <> renderName table
+
+-- | Escape a column or table name.
+renderName :: Text -> Text
+renderName s = "\"" <> s <> "\""
+
+-- | Render a tuple
+renderTuple :: [Text] -> Text
+renderTuple xs = "(" <> T.intercalate ", " xs <> ")"
+
+{-------------------------------------------------------------------------------
+    SQL queries
+-------------------------------------------------------------------------------}
+
+-- | Create a database table.
+createTable :: IsTableSql t => proxy t -> Stmt
+createTable proxy =
+    CreateTable
+        (getTableName proxy)
+        (zip (getColNames proxy) (getColumnTypes proxy))
+
+-- | Select all rows from the table.
+selectAll :: IsTableSql t => proxy t -> Stmt
+selectAll proxy =
+    Select (getColNames proxy) (getTableName proxy) All
+
+-- | Insert one row into the corresponding table.
+insertOne :: IsTableSql t => proxy t -> Stmt
+insertOne proxy =
+    Insert (getTableName proxy) (getColNames proxy)
+
+-- | Delete all rows from a database table
+deleteAll :: IsTableSql t => proxy t -> Stmt
+deleteAll proxy =
+    Delete (getTableName proxy) All

lib/delta-table/src/Database/Table/SQL/Table.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+'Table' types that can be mapped to SQL tables.
+-}
+module Database.Table.SQL.Table
+    ( -- * SQL tables
+      IsTableSql
+    , getColumnTypes
+    , HasColumns
+    ) where
+
+import Prelude
+
+import Data.Foldable
+    ( toList
+    )
+import Data.Proxy
+    ( Proxy (..)
+    )
+import Data.Sequence
+    ( Seq
+    , empty
+    , (|>)
+    )
+import Database.Table
+    ( Col
+    , IsTable
+    , Row
+    , Table
+    , (:.)
+    )
+import Database.Table.SQL.Column
+    ( IsColumn (getSqlType)
+    , SqlType
+    )
+
+import qualified Database.SQLite.Simple as Sqlite
+
+{-------------------------------------------------------------------------------
+    Types for database tables
+-------------------------------------------------------------------------------}
+
+{- | Constaint for types that represent tables with columns that can be
+mapped to SQL tables.
+
+Note: Usage sites of this constraint synonym must
+use the @FlexibleContexts@ extension.
+
+Typical instances of this constraint constructed from "Database.Table",
+where the column types can be mapped from Haskell to SQL and vice-versa.
+Example:
+
+@
+type ExampleTable =
+    Table "person"
+        :. Col "name" Text
+        :. Col "birthyear" Int
+@
+-}
+type IsTableSql t =
+    ( IsTable t
+    , HasColumns t
+    , Sqlite.ToRow (Row t)
+    , Sqlite.FromRow (Row t)
+    )
+
+getColumnTypes :: IsTableSql t => proxy t -> [SqlType]
+getColumnTypes = toList . getColumnTypesD
+
+-- | Class for types that correspond to a list of SQL types.
+class HasColumns t where
+    getColumnTypesD :: proxy t -> Seq SqlType
+
+instance HasColumns (Table name) where
+    getColumnTypesD _ = empty
+
+instance (HasColumns t, IsColumn a) => HasColumns (t :. Col name a) where
+    getColumnTypesD _ =
+        getColumnTypesD (Proxy :: Proxy t)
+            |> getSqlType (Proxy :: Proxy a)

lib/delta-table/src/Database/Table/SQLite/Simple.hs

@@ -0,0 +1,22 @@
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+Storing 'Table' in SQLite databases.
+
+This module is meant to be imported qualified, e.g.
+
+@
+import qualified Database.Table.SQLite.Simple as Sqlite
+@
+-}
+module Database.Table.SQLite.Simple
+    (
+      module Database.Table.SQL.Table
+    , module Database.Table.SQLite.Simple.Exec
+    , module Database.Table.SQL.Column
+    ) where
+
+import Database.Table.SQL.Column
+import Database.Table.SQL.Table
+import Database.Table.SQLite.Simple.Exec