Implement SQL statements without WHERE clause

lib/delta-table/delta-table.cabal

@@ -58,11 +58,14 @@ library
   exposed-modules:
       Data.Table
       Database.Table
+      Database.Table.SQLite.Simple
       Demo.Database
   other-modules:
       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/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/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

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

@@ -0,0 +1,99 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
+
+{- |
+Copyright: © 2024 Cardano Foundation
+License: Apache-2.0
+
+Execute SQL statements for typed database tables.
+-}
+module Database.Table.SQLite.Simple.Exec
+    (
+    -- * SQL monad
+    SqlM
+    , runSqlM
+
+    -- * SQL statements
+    , createTable
+    , selectAll
+    , insertOne
+    , insertMany
+    , deleteAll
+    ) where
+
+import Prelude
+
+import Control.Monad.Trans.Reader
+    ( ReaderT (..)
+    )
+import Data.Foldable
+    ( for_
+    )
+import Database.Table
+    ( Row
+    )
+import Database.Table.SQL.Table
+    ( IsTableSql
+    )
+
+import qualified Database.SQLite.Simple as Sqlite
+import qualified Database.Table.SQL.Stmt as Stmt
+
+{-------------------------------------------------------------------------------
+    SQL monad
+-------------------------------------------------------------------------------}
+-- | Monad to run SQL queries in.
+--
+-- This monad includes effects such as
+--
+-- * mutable state
+-- * exceptions
+-- * concurrency
+--
+-- This type makes no attempt at handling these, you have to do that yourself.
+-- For example, in order to handle exception, consider using
+-- 'Sqlite.withTransaction'.
+--
+-- FIXME: No, we do have handle these types of things.
+type SqlM = ReaderT Sqlite.Connection IO
+
+-- | Run a computation from the 'SqlM' monad.
+runSqlM :: SqlM a -> Sqlite.Connection -> IO a
+runSqlM = runReaderT
+
+{-------------------------------------------------------------------------------
+    Helpers
+-------------------------------------------------------------------------------}
+mkQuery :: Stmt.Stmt -> Sqlite.Query
+mkQuery = Sqlite.Query . Stmt.renderStmt
+
+query_ :: Sqlite.FromRow row => Stmt.Stmt -> SqlM [row]
+query_ stmt =
+    ReaderT $ \conn -> Sqlite.query_ conn (mkQuery stmt)
+
+executeOne :: Sqlite.ToRow row => Stmt.Stmt -> row -> SqlM ()
+executeOne stmt row =
+    ReaderT $ \conn -> Sqlite.execute conn (mkQuery stmt) row
+
+execute_ :: Stmt.Stmt -> SqlM ()
+execute_ stmt =
+    ReaderT $ \conn -> Sqlite.execute_ conn (mkQuery stmt)
+
+{-------------------------------------------------------------------------------
+    SQL statements
+-------------------------------------------------------------------------------}
+createTable :: IsTableSql t => proxy t -> SqlM ()
+createTable = execute_ . Stmt.createTable
+
+selectAll :: IsTableSql t => proxy t -> SqlM [Row t]
+selectAll = query_ . Stmt.selectAll
+
+insertOne :: IsTableSql t => Row t -> proxy t -> SqlM ()
+insertOne row proxy = executeOne (Stmt.insertOne proxy) row
+
+insertMany :: IsTableSql t => [Row t] -> proxy t -> SqlM ()
+insertMany rows proxy = for_ rows (`insertOne` proxy)
+
+deleteAll :: IsTableSql t => proxy t -> SqlM ()
+deleteAll = execute_ . Stmt.deleteAll

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

@@ -12,6 +12,9 @@ module Demo.Database where
 
 import Prelude
 
+import Data.Foldable
+    ( for_
+    )
 import Data.Proxy
     ( Proxy (..)
     )
@@ -25,6 +28,9 @@ import Database.Table
     , (:.)
     )
 
+import qualified Database.SQLite.Simple as Sqlite
+import qualified Database.Table.SQLite.Simple as Sql
+
 {-----------------------------------------------------------------------------
     Test
 ------------------------------------------------------------------------------}
@@ -35,3 +41,17 @@ type TablePerson =
 
 tablePerson :: Proxy TablePerson
 tablePerson = Proxy
+
+action :: Sql.SqlM [Row TablePerson]
+action = do
+    Sql.createTable tablePerson
+    Sql.insertOne ("Neko", 1603) tablePerson
+    Sql.deleteAll tablePerson
+    Sql.insertOne ("William", 1805) tablePerson
+    Sql.insertOne ("Ada", 1815) tablePerson
+    Sql.selectAll tablePerson
+
+main :: IO ()
+main = do
+    rows <- Sqlite.withConnection ":memory:" $ Sql.runSqlM action
+    for_ rows print