Move D.L.Normal.* test modules to D.L.*

lsm-tree.cabal

@@ -382,10 +382,10 @@ test-suite lsm-tree-test
     Test.Database.LSMTree.Internal.Vector.Growing
     Test.Database.LSMTree.Model.Table
     Test.Database.LSMTree.Monoidal
-    Test.Database.LSMTree.Normal.StateMachine
-    Test.Database.LSMTree.Normal.StateMachine.DL
-    Test.Database.LSMTree.Normal.StateMachine.Op
-    Test.Database.LSMTree.Normal.UnitTests
+    Test.Database.LSMTree.StateMachine
+    Test.Database.LSMTree.StateMachine.DL
+    Test.Database.LSMTree.StateMachine.Op
+    Test.Database.LSMTree.UnitTests
     Test.System.Posix.Fcntl.NoCache
     Test.Util.FS
     Test.Util.Orphans

test/Main.hs

@@ -32,9 +32,9 @@ import qualified Test.Database.LSMTree.Internal.Vector
 import qualified Test.Database.LSMTree.Internal.Vector.Growing
 import qualified Test.Database.LSMTree.Model.Table
 import qualified Test.Database.LSMTree.Monoidal
-import qualified Test.Database.LSMTree.Normal.StateMachine
-import qualified Test.Database.LSMTree.Normal.StateMachine.DL
-import qualified Test.Database.LSMTree.Normal.UnitTests
+import qualified Test.Database.LSMTree.StateMachine
+import qualified Test.Database.LSMTree.StateMachine.DL
+import qualified Test.Database.LSMTree.UnitTests
 import qualified Test.System.Posix.Fcntl.NoCache
 import           Test.Tasty
 
@@ -69,9 +69,9 @@ main = defaultMain $ testGroup "lsm-tree"
     , Test.Database.LSMTree.Internal.Vector.Growing.tests
     , Test.Database.LSMTree.Model.Table.tests
     , Test.Database.LSMTree.Monoidal.tests
-    , Test.Database.LSMTree.Normal.UnitTests.tests
-    , Test.Database.LSMTree.Normal.StateMachine.tests
-    , Test.Database.LSMTree.Normal.StateMachine.DL.tests
+    , Test.Database.LSMTree.UnitTests.tests
+    , Test.Database.LSMTree.StateMachine.tests
+    , Test.Database.LSMTree.StateMachine.DL.tests
     , Test.System.Posix.Fcntl.NoCache.tests
     , Test.Data.Arena.tests
     ]

test/Test/Database/LSMTree/Normal/StateMachine.hs → test/Test/Database/LSMTree/StateMachine.hs

@@ -47,7 +47,7 @@
   TODO: it is currently not correctly modelled what happens if blob references
   are retrieved from an incorrect table.
 -}
-module Test.Database.LSMTree.Normal.StateMachine (
+module Test.Database.LSMTree.StateMachine (
     tests
   , labelledExamples
     -- * Properties
@@ -108,8 +108,8 @@ import qualified System.FS.Sim.MockFS as MockFS
 import           System.FS.Sim.MockFS (MockFS)
 import           System.IO.Temp (createTempDirectory,
                      getCanonicalTemporaryDirectory)
-import           Test.Database.LSMTree.Normal.StateMachine.Op
-                     (HasBlobRef (getBlobRef), Op (..))
+import           Test.Database.LSMTree.StateMachine.Op (HasBlobRef (getBlobRef),
+                     Op (..))
 import qualified Test.QuickCheck as QC
 import           Test.QuickCheck (Arbitrary, Gen, Property)
 import qualified Test.QuickCheck.Extras as QD
@@ -132,7 +132,7 @@ import           Test.Util.TypeFamilyWrappers (WrapBlob (..), WrapBlobRef (..),
 -------------------------------------------------------------------------------}
 
 tests :: TestTree
-tests = testGroup "Normal.StateMachine" [
+tests = testGroup "Test.Database.LSMTree.StateMachine" [
       testProperty "propLockstep_ModelIOImpl"
         propLockstep_ModelIOImpl
 
@@ -498,7 +498,7 @@ instance ( Show (Class.TableConfig h)
 
 -- TODO: show instance does not show key-value-blob types. Example:
 --
--- Normal.StateMachine
+-- StateMachine
 --   prop_lockstepIO_ModelIOImpl: FAIL
 --     *** Failed! Exception: 'open: inappropriate type (table type mismatch)' (after 25 tests and 2 shrinks):
 --     do action $ New TableConfig

test/Test/Database/LSMTree/Normal/StateMachine/DL.hs → test/Test/Database/LSMTree/StateMachine/DL.hs

@@ -1,7 +1,7 @@
 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Database.LSMTree.Normal.StateMachine.DL (
+module Test.Database.LSMTree.StateMachine.DL (
     tests
   ) where
 
@@ -12,8 +12,8 @@ import           Database.LSMTree as R
 import qualified Database.LSMTree.Model.Session as Model (fromSomeTable, tables)
 import qualified Database.LSMTree.Model.Table as Model (values)
 import           Prelude
-import           Test.Database.LSMTree.Normal.StateMachine hiding (tests)
-import           Test.Database.LSMTree.Normal.StateMachine.Op
+import           Test.Database.LSMTree.StateMachine hiding (tests)
+import           Test.Database.LSMTree.StateMachine.Op
 import           Test.QuickCheck as QC
 import           Test.QuickCheck.DynamicLogic
 import qualified Test.QuickCheck.Gen as QC
@@ -23,7 +23,7 @@ import           Test.Tasty (TestTree, testGroup)
 import           Test.Util.PrettyProxy
 
 tests :: TestTree
-tests = testGroup "Test.Database.LSMTree.Normal.StateMachine.DL" [
+tests = testGroup "Test.Database.LSMTree.StateMachine.DL" [
    -- This one is not actually enabled, because it runs for rather a long time
    -- and it's not in itself a very import property.
    -- QC.testProperty "prop_example" prop_example

test/Test/Database/LSMTree/Normal/StateMachine/Op.hs → test/Test/Database/LSMTree/StateMachine/Op.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 
 -- | SumProd Op extended with BlobRef extraction
-module Test.Database.LSMTree.Normal.StateMachine.Op (
+module Test.Database.LSMTree.StateMachine.Op (
     -- * 'Op'
     Op (..)
   , intOpId

test/Test/Database/LSMTree/Normal/UnitTests.hs → test/Test/Database/LSMTree/UnitTests.hs

@@ -3,7 +3,7 @@
 
 {- HLINT ignore "Use void" -}
 
-module Test.Database.LSMTree.Normal.UnitTests (tests) where
+module Test.Database.LSMTree.UnitTests (tests) where
 
 import           Control.Tracer (nullTracer)
 import           Data.ByteString (ByteString)
@@ -13,8 +13,8 @@ import qualified Data.Vector as V
 import           Data.Word
 import qualified System.FS.API as FS
 
+import           Database.LSMTree as R
 import           Database.LSMTree.Internal.Snapshot (SnapshotLabel (..))
-import           Database.LSMTree.Normal as R
 
 import           Control.Exception (Exception, try)
 import           Database.LSMTree.Extras.Generators (KeyForIndexCompact)
@@ -26,7 +26,7 @@ import           Test.Util.FS (withTempIOHasBlockIO)
 
 tests :: TestTree
 tests =
-    testGroup "Normal.UnitTests"
+    testGroup "Test.Database.LSMTree.UnitTests"
       [ testCaseSteps "unit_blobs"         unit_blobs
       , testCase      "unit_closed_table"  unit_closed_table
       , testCase      "unit_closed_cursor" unit_closed_cursor
@@ -38,15 +38,15 @@ unit_blobs :: (String -> IO ()) -> Assertion
 unit_blobs info =
     withTempIOHasBlockIO "test" $ \hfs hbio ->
     withSession nullTracer hfs hbio (FS.mkFsPath []) $ \sess -> do
-      table <- new @_ @ByteString @ByteString @ByteString sess defaultTableConfig
-      inserts table [("key1", "value1", Just "blob1")]
+      table <- new @_ @ByteString @(ResolveAsFirst ByteString) @ByteString sess defaultTableConfig
+      inserts table [("key1", ResolveAsFirst "value1", Just "blob1")]
 
       res <- lookups table ["key1"]
       info (show res)
 
       case res of
         [FoundWithBlob val bref] -> do
-          val @?= "value1"
+          val @?= ResolveAsFirst "value1"
           blob <- retrieveBlobs sess [bref]
           info (show blob)
           blob @?= ["blob1"]
@@ -167,6 +167,8 @@ newtype Value1 = Value1 Word64
   deriving stock (Show, Eq, Ord)
   deriving newtype (SerialiseValue)
 
+deriving via ResolveAsFirst Word64 instance ResolveValue Value1
+
 newtype Blob1  = Blob1 Word64
   deriving stock (Show, Eq, Ord)
   deriving newtype (SerialiseValue)
@@ -182,6 +184,8 @@ newtype Value2 = Value2 BS.ByteString
   deriving stock (Show, Eq, Ord)
   deriving newtype (QC.Arbitrary, SerialiseValue)
 
+deriving via ResolveAsFirst BS.ByteString instance ResolveValue Value2
+
 newtype Blob2  = Blob2 BS.ByteString
   deriving stock (Show, Eq, Ord)
   deriving newtype (SerialiseValue)