From c2cd26694b319eba36ffe5df93f6c3e8bd6e9ab9 Mon Sep 17 00:00:00 2001 From: James Brechtel Date: Fri, 29 May 2026 23:23:15 -0400 Subject: [PATCH] Add top-level re-exports module and passing acceptance tests --- orville-sqlite.cabal | 3 + src/Orville/SQLite.hs | 24 ++++++++ src/Orville/SQLite/AutoMigration.hs | 36 +++++------ test/Main.hs | 92 +++++++++++++++++++++++++++++ 4 files changed, 135 insertions(+), 20 deletions(-) create mode 100644 src/Orville/SQLite.hs create mode 100644 test/Main.hs diff --git a/orville-sqlite.cabal b/orville-sqlite.cabal index b20ecd9..f396140 100644 --- a/orville-sqlite.cabal +++ b/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 diff --git a/src/Orville/SQLite.hs b/src/Orville/SQLite.hs new file mode 100644 index 0000000..bbf7826 --- /dev/null +++ b/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 diff --git a/src/Orville/SQLite/AutoMigration.hs b/src/Orville/SQLite/AutoMigration.hs index 5d49bfe..e646df4 100644 --- a/src/Orville/SQLite/AutoMigration.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..759a598 --- /dev/null +++ b/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