Add top-level re-exports module and passing acceptance tests

orville-sqlite.cabal

@@ -15,6 +15,7 @@ build-type: Simple
 
 library
   exposed-modules:
+      Orville.SQLite
       Orville.SQLite.AutoMigration
       Orville.SQLite.Execution
       Orville.SQLite.FieldDefinition
@@ -39,6 +40,8 @@ test-suite spec
   hs-source-dirs: test
   build-depends:
       base >=4.17 && <5
+    , mtl
     , orville-sqlite
     , hspec
+    , text
   default-language: Haskell2010

src/Orville/SQLite.hs

@@ -0,0 +1,24 @@
+module Orville.SQLite
+  ( -- * Monad
+    module Orville.SQLite.Monad
+    -- * SqlType
+  , module Orville.SQLite.SqlType
+    -- * FieldDefinition
+  , module Orville.SQLite.FieldDefinition
+    -- * SqlMarshaller
+  , module Orville.SQLite.SqlMarshaller
+    -- * TableDefinition
+  , module Orville.SQLite.TableDefinition
+    -- * AutoMigration
+  , module Orville.SQLite.AutoMigration
+    -- * Execution
+  , module Orville.SQLite.Execution
+  ) where
+
+import Orville.SQLite.AutoMigration
+import Orville.SQLite.Execution
+import Orville.SQLite.FieldDefinition
+import Orville.SQLite.Monad
+import Orville.SQLite.SqlMarshaller
+import Orville.SQLite.SqlType
+import Orville.SQLite.TableDefinition

src/Orville/SQLite/AutoMigration.hs

@@ -18,7 +18,7 @@ module Orville.SQLite.AutoMigration
 import Control.Monad (when)
 import Control.Monad.IO.Class (liftIO)
 import Control.Monad.Reader (ask)
-import Data.List (find, intercalate)
+import Data.List (intercalate)
 import qualified Data.Text as T
 import qualified Database.SQLite3 as SQLite3
 import Orville.SQLite.FieldDefinition (fieldColumnName)
@@ -87,7 +87,7 @@ planItem :: SchemaItem -> OrvilleM [MigrationStep]
 planItem (SchemaItem (SchemaTableItem tableName' marshaller pkName dropColsList)) = do
   existingCols <- getExistingColumns tableName'
   let expectedCols = marshallerExpectedColumns marshaller pkName
-  pure $ planTableChanges tableName' expectedCols existingCols dropColsList
+  pure $ planTableChanges tableName' expectedCols existingCols pkName dropColsList
 
 getExistingColumns :: String -> OrvilleM [ExistingColumn]
 getExistingColumns tableName' = do
@@ -140,10 +140,11 @@ planTableChanges ::
   String ->
   [(String, String, Bool)] ->
   [ExistingColumn] ->
+  String ->
   [String] ->
   [MigrationStep]
-planTableChanges tableName' expected existing dropColsList
-  | null existing = [CreateTable tableName' expected (findPk expected)]
+planTableChanges tableName' expected existing pkName dropColsList
+  | null existing = [CreateTable tableName' expected pkName]
   | otherwise = addColSteps ++ dropColSteps
   where
     existingNames = map existingName existing
@@ -160,13 +161,6 @@ planTableChanges tableName' expected existing dropColsList
       , name `elem` existingNames
       ]
 
-    findPk cols =
-      case find (\(_, _, isNull) -> not isNull) cols of
-        Just (name, _, _) -> name
-        Nothing -> case cols of
-          ((name, _, _) : _) -> name
-          [] -> ""
-
 autoMigrateSchema :: MigrationOptions -> [SchemaItem] -> OrvilleM ()
 autoMigrateSchema opts items = do
   plan <- generateMigrationPlan items
@@ -179,10 +173,10 @@ executeMigrationPlan = mapM_ executeStep
     executeStep step = do
       db <- ask
       case step of
-        CreateTable name cols _pkName ->
+        CreateTable name cols pkName ->
           liftIO $
             SQLite3.exec db $
-              mkCreateTable name cols
+              mkCreateTable name cols pkName
         AddColumn name colName colType ->
           liftIO $
             SQLite3.exec db $
@@ -202,8 +196,8 @@ executeMigrationPlan = mapM_ executeStep
                   <> " DROP COLUMN "
                   <> colName
 
-mkCreateTable :: String -> [(String, String, Bool)] -> T.Text
-mkCreateTable name cols =
+mkCreateTable :: String -> [(String, String, Bool)] -> String -> T.Text
+mkCreateTable name cols pkName =
   T.pack $
     "CREATE TABLE IF NOT EXISTS "
       <> name
@@ -211,8 +205,10 @@ mkCreateTable name cols =
       <> intercalate ",\n  " (map mkColumnDef cols)
       <> "\n)"
   where
-    mkColumnDef (colName, colType, notNullFlag) =
-      colName
-        <> " "
-        <> colType
-        <> if notNullFlag then " NOT NULL" else ""
+    mkColumnDef (colName, colType, notNullFlag)
+      | colName == pkName =
+          colName <> " " <> colType <> " PRIMARY KEY"
+      | notNullFlag =
+          colName <> " " <> colType <> " NOT NULL"
+      | otherwise =
+          colName <> " " <> colType

test/Main.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Monad.IO.Class (liftIO)
+import Data.Int (Int64)
+import Data.Text (Text)
+import Test.Hspec
+import Orville.SQLite
+
+data Person = Person
+  { personId :: Int64
+  , firstName :: Text
+  , lastName :: Text
+  , age :: Int64
+  }
+  deriving (Show, Eq)
+
+personIdField :: FieldDefinition 'NotNull Int64
+personIdField = integerField "id"
+
+firstNameField :: FieldDefinition 'NotNull Text
+firstNameField = textField "first_name"
+
+lastNameField :: FieldDefinition 'NotNull Text
+lastNameField = textField "last_name"
+
+ageField :: FieldDefinition 'NotNull Int64
+ageField = integerField "age"
+
+personMarshaller :: SqlMarshaller Person Person
+personMarshaller =
+  Person
+    <$> marshallReadOnlyField personIdField
+    <*> marshallField firstName firstNameField
+    <*> marshallField lastName lastNameField
+    <*> marshallField age ageField
+
+personTable :: TableDefinition Int64 Person Person
+personTable =
+  mkTableDefinition "person" (primaryKey personId personIdField) personMarshaller
+
+main :: IO ()
+main = hspec $ do
+  describe "Orville.SQLite" $ do
+    it "creates a table and inserts a row" $ do
+      db <- openConnection ":memory:"
+      withConnection db $ do
+        autoMigrateSchema defaultOptions [schemaTable personTable []]
+        insertEntity personTable (Person 0 "Alice" "Smith" 30)
+        mAlice <- findEntity personTable 1
+        liftIO $ mAlice `shouldBe` Just (Person 1 "Alice" "Smith" 30)
+      closeConnection db
+
+    it "finds all rows" $ do
+      db <- openConnection ":memory:"
+      withConnection db $ do
+        autoMigrateSchema defaultOptions [schemaTable personTable []]
+        insertEntity personTable (Person 0 "Alice" "Smith" 30)
+        insertEntity personTable (Person 0 "Bob" "Jones" 25)
+        results <- findAll personTable
+        liftIO $ length results `shouldBe` 2
+      closeConnection db
+
+    it "updates a row" $ do
+      db <- openConnection ":memory:"
+      withConnection db $ do
+        autoMigrateSchema defaultOptions [schemaTable personTable []]
+        insertEntity personTable (Person 0 "Alice" "Smith" 30)
+        updateEntity personTable (Person 1 "Alice" "Jones" 31)
+        mAlice <- findEntity personTable 1
+        liftIO $ mAlice `shouldBe` Just (Person 1 "Alice" "Jones" 31)
+      closeConnection db
+
+    it "deletes a row" $ do
+      db <- openConnection ":memory:"
+      withConnection db $ do
+        autoMigrateSchema defaultOptions [schemaTable personTable []]
+        insertEntity personTable (Person 0 "Alice" "Smith" 30)
+        deleteEntity personTable 1
+        mAlice <- findEntity personTable 1
+        liftIO $ mAlice `shouldBe` Nothing
+      closeConnection db
+
+    it "returns Nothing for missing row" $ do
+      db <- openConnection ":memory:"
+      withConnection db $ do
+        autoMigrateSchema defaultOptions [schemaTable personTable []]
+        mAlice <- findEntity personTable 999
+        liftIO $ mAlice `shouldBe` Nothing
+      closeConnection db