src/MyWebLog.Data/Postgres/PostgresCategoryData.fs

@@ -18,7 +18,11 @@ type PostgresCategoryData(log: ILogger) =
     /// Count all top-level categories for the given web log
     let countTopLevel webLogId =
         log.LogTrace "Category.countTopLevel"
-        Count.byContains Table.Category {| webLogDoc webLogId with ParentId = None |}
+        Custom.scalar
+            $"""{Query.Count.byContains Table.Category}
+                  AND {Query.whereByField (Field.NEX (nameof Category.Empty.ParentId)) ""}"""
+            [ webLogContains webLogId ]
+            toCount
     
     /// Retrieve all categories for the given web log in a DotLiquid-friendly format
     let findAllForView webLogId = backgroundTask {
@@ -81,26 +85,21 @@ type PostgresCategoryData(log: ILogger) =
             let! children = Find.byContains<Category> Table.Category {| ParentId = catId |}
             let hasChildren = not (List.isEmpty children)
             if hasChildren then
-                if cat.ParentId.IsSome then
-                    let! _ =
-                        Configuration.dataSource ()
-                        |> Sql.fromDataSource
-                        |> Sql.executeTransactionAsync
-                            [ Query.Patch.byId Table.Category,
-                              children
-                              |> List.map (fun child ->
-                                  [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ]) ]
-                    ()
-                else
-                    let! _ =
-                        Configuration.dataSource ()
-                        |> Sql.fromDataSource
-                        |> Sql.executeTransactionAsync
-                            [ Query.RemoveFields.byId Table.Category,
-                              children
-                              |> List.map (fun child ->
-                                  [ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ]) ]
-                    ()
+                let childQuery, childParams =
+                    if cat.ParentId.IsSome then
+                        Query.Patch.byId Table.Category,
+                        children
+                        |> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ])
+                    else
+                        Query.RemoveFields.byId Table.Category,
+                        children
+                        |> List.map (fun child ->
+                            [ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ])
+                let! _ =
+                    Configuration.dataSource ()
+                    |> Sql.fromDataSource
+                    |> Sql.executeTransactionAsync [ childQuery, childParams ]
+                ()
             // Delete the category off all posts where it is assigned
             let! posts =
                 Custom.list

src/MyWebLog.Tests/Data/PostgresDataTests.fs

@@ -0,0 +1,114 @@
+module PostgresDataTests
+
+open BitBadger.Documents
+open Expecto
+open Microsoft.Extensions.Logging.Abstractions
+open MyWebLog
+open MyWebLog.Converters
+open MyWebLog.Data
+open Newtonsoft.Json
+open Npgsql
+open ThrowawayDb.Postgres
+
+/// JSON serializer 
+let ser = Json.configure (JsonSerializer.CreateDefault())
+
+/// The throwaway database (deleted when disposed)
+let mutable db: ThrowawayDatabase option = None
+
+/// Create a PostgresData instance for testing
+let mkData () =
+    PostgresData(NullLogger<PostgresData>(), ser) :> IData
+
+/// Create a fresh environment from the root backup
+let freshEnvironment () = task {
+    if Option.isSome db then db.Value.Dispose()
+    db <- Some (ThrowawayDatabase.Create "Host=localhost;Database=postgres;User ID=postgres;Password=postgres")
+    let source = NpgsqlDataSourceBuilder db.Value.ConnectionString
+    let _ = source.UseNodaTime()
+    Postgres.Configuration.useDataSource (source.Build())
+    let env = mkData ()
+    do! env.StartUp()
+    // This exercises Restore for all implementations; all tests are dependent on it working as expected
+    do! Maintenance.Backup.restoreBackup "root-weblog.json" None false false env
+}
+
+/// Set up the environment for the PostgreSQL tests
+let environmentSetUp = testTask "creating database" {
+    do! freshEnvironment ()
+}
+
+/// Integration tests for the Category implementation in SQLite
+let categoryTests = testList "Category" [
+    testTask "Add succeeds" {
+        do! CategoryDataTests.``Add succeeds`` (mkData ())
+    }
+    testList "CountAll" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories exist`` (mkData ())
+        }
+        testTask "succeeds when categories do not exist" {
+            do! CategoryDataTests.``CountAll succeeds when categories do not exist`` (mkData ())
+        }
+    ]
+    testList "CountTopLevel" [
+        testTask "succeeds when top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when top-level categories exist`` (mkData ())
+        }
+        testTask "succeeds when no top-level categories exist" {
+            do! CategoryDataTests.``CountTopLevel succeeds when no top-level categories exist`` (mkData ())
+        }
+    ]
+    testTask "FindAllForView succeeds" {
+        do! CategoryDataTests.``FindAllForView succeeds`` (mkData ())
+    }
+    testList "FindById" [
+        testTask "succeeds when a category is found" {
+            do! CategoryDataTests.``FindById succeeds when a category is found`` (mkData ())
+        }
+        testTask "succeeds when a category is not found" {
+            do! CategoryDataTests.``FindById succeeds when a category is not found`` (mkData ())
+        }
+    ]
+    testList "FindByWebLog" [
+        testTask "succeeds when categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when categories exist`` (mkData ())
+        }
+        testTask "succeeds when no categories exist" {
+            do! CategoryDataTests.``FindByWebLog succeeds when no categories exist`` (mkData ())
+        }
+    ]
+    testTask "Update succeeds" {
+        do! CategoryDataTests.``Update succeeds`` (mkData ())
+    }
+    testList "Delete" [
+        testTask "succeeds when the category is deleted (no posts)" {
+            do! CategoryDataTests.``Delete succeeds when the category is deleted (no posts)`` (mkData ())
+        }
+        testTask "succeeds when the category does not exist" {
+            do! CategoryDataTests.``Delete succeeds when the category does not exist`` (mkData ())
+        }
+        testTask "succeeds when reassigning parent category to None" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to None`` (mkData ())
+        }
+        testTask "succeeds when reassigning parent category to Some" {
+            do! CategoryDataTests.``Delete succeeds when reassigning parent category to Some`` (mkData ())
+        }
+        testTask "succeeds and removes category from posts" {
+            do! CategoryDataTests.``Delete succeeds and removes category from posts`` (mkData ())
+        }
+    ]
+]
+
+/// Drop the throwaway PostgreSQL database
+let environmentCleanUp = test "Clean Up" {
+    if db.IsSome then db.Value.Dispose()
+} 
+
+/// All PostgreSQL data tests
+let all =
+    testList "PostgresData"
+        [ environmentSetUp
+          categoryTests
+          environmentCleanUp ]
+    |> testSequenced

src/MyWebLog.Tests/MyWebLog.Tests.fsproj

@@ -12,12 +12,14 @@
     <Compile Include="Data\UtilsTests.fs" />
     <Compile Include="Data\CategoryDataTests.fs" />
     <Compile Include="Data\SQLiteDataTests.fs" />
+    <Compile Include="Data\PostgresDataTests.fs" />
     <Compile Include="Program.fs" />
     <None Include="root-weblog.json" />
   </ItemGroup>
 
   <ItemGroup>
     <PackageReference Include="Expecto" Version="10.1.0" />
+    <PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
   </ItemGroup>
 
   <ItemGroup>

src/MyWebLog.Tests/Program.fs

@@ -2,7 +2,7 @@
 
 let allTests = testList "MyWebLog" [
     testList "Domain" [ SupportTypesTests.all; DataTypesTests.all; ViewModelsTests.all ]
-    testList "Data" [ ConvertersTests.all; UtilsTests.all; SQLiteDataTests.all ]
+    testList "Data" [ ConvertersTests.all; UtilsTests.all; SQLiteDataTests.all; PostgresDataTests.all ]
 ]
 
 [<EntryPoint>]