Add some missing NFData instances

We'll use these instances in the new tests that are added by the next commit

Author: jorisdral

src/Database/LSMTree/Internal/Merge.hs

@@ -15,6 +15,7 @@ module Database.LSMTree.Internal.Merge (
   , steps
   ) where
 
+import           Control.DeepSeq (NFData (..))
 import           Control.Exception (assert)
 import           Control.Monad (when)
 import           Control.Monad.Class.MonadST (MonadST)
@@ -74,6 +75,10 @@ data MergeState =
 data Level = MidLevel | LastLevel
   deriving stock (Eq, Show)
 
+instance NFData Level where
+  rnf MidLevel  = ()
+  rnf LastLevel = ()
+
 type Mappend = SerialisedValue -> SerialisedValue -> SerialisedValue
 
 {-# SPECIALISE new ::

src/Database/LSMTree/Internal/MergeSchedule.hs

@@ -45,6 +45,7 @@ module Database.LSMTree.Internal.MergeSchedule (
   ) where
 
 import           Control.Concurrent.Class.MonadMVar.Strict
+import           Control.DeepSeq (NFData (..))
 import           Control.Monad (void, when, (<$!>))
 import           Control.Monad.Class.MonadST (MonadST)
 import           Control.Monad.Class.MonadSTM (MonadSTM (..))
@@ -399,6 +400,10 @@ duplicateMergingRunRuns reg (DeRef mr) =
 data MergePolicyForLevel = LevelTiering | LevelLevelling
   deriving stock (Show, Eq)
 
+instance NFData MergePolicyForLevel where
+  rnf LevelTiering   = ()
+  rnf LevelLevelling = ()
+
 mergePolicyForLevel :: MergePolicy -> LevelNo -> Levels m h -> MergePolicyForLevel
 mergePolicyForLevel MergePolicyLazyLevelling (LevelNo n) nextLevels
   | n == 1
@@ -409,6 +414,7 @@ mergePolicyForLevel MergePolicyLazyLevelling (LevelNo n) nextLevels
 
 newtype NumRuns = NumRuns { unNumRuns :: Int }
   deriving stock (Show, Eq)
+  deriving newtype NFData
 
 newtype UnspentCreditsVar s = UnspentCreditsVar { getUnspentCreditsVar :: PrimVar s Int }
 
@@ -430,6 +436,10 @@ newtype SpentCreditsVar s = SpentCreditsVar { getSpentCreditsVar :: PrimVar s In
 data MergeKnownCompleted = MergeKnownCompleted | MergeMaybeCompleted
   deriving stock (Show, Eq, Read)
 
+instance NFData MergeKnownCompleted where
+  rnf MergeKnownCompleted = ()
+  rnf MergeMaybeCompleted = ()
+
 {-# SPECIALISE duplicateLevels :: TempRegistry IO -> Levels IO h -> IO (Levels IO h) #-}
 duplicateLevels ::
      (PrimMonad m, MonadMVar m, MonadMask m)

src/Database/LSMTree/Internal/Snapshot.hs

@@ -24,6 +24,7 @@ module Database.LSMTree.Internal.Snapshot (
 
 import           Control.Concurrent.Class.MonadMVar.Strict
 import           Control.Concurrent.Class.MonadSTM (MonadSTM)
+import           Control.DeepSeq (NFData (..))
 import           Control.Monad (when)
 import           Control.Monad.Class.MonadST (MonadST)
 import           Control.Monad.Class.MonadThrow (MonadMask)
@@ -66,11 +67,17 @@ import           System.FS.BlockIO.API (HasBlockIO)
 -- is opened at the correct key\/value\/blob type.
 newtype SnapshotLabel = SnapshotLabel Text
   deriving stock (Show, Eq)
+  deriving newtype NFData
 
 -- TODO: revisit if we need three table types.
 data SnapshotTableType = SnapNormalTable | SnapMonoidalTable | SnapFullTable
   deriving stock (Show, Eq)
 
+instance NFData SnapshotTableType where
+  rnf SnapNormalTable   = ()
+  rnf SnapMonoidalTable = ()
+  rnf SnapFullTable     = ()
+
 data SnapshotMetaData = SnapshotMetaData {
     -- | See 'SnapshotLabel'.
     --
@@ -94,40 +101,58 @@ data SnapshotMetaData = SnapshotMetaData {
   }
   deriving stock (Show, Eq)
 
+instance NFData SnapshotMetaData where
+  rnf (SnapshotMetaData a b c d) = rnf a `seq` rnf b `seq` rnf c `seq` rnf d
+
 {-------------------------------------------------------------------------------
   Levels snapshot format
 -------------------------------------------------------------------------------}
 
 newtype SnapLevels r = SnapLevels { getSnapLevels :: V.Vector (SnapLevel r) }
   deriving stock (Show, Eq, Functor, Foldable, Traversable)
+  deriving newtype NFData
 
 data SnapLevel r = SnapLevel {
     snapIncoming     :: !(SnapIncomingRun r)
   , snapResidentRuns :: !(V.Vector r)
   }
   deriving stock (Show, Eq, Functor, Foldable, Traversable)
 
+instance NFData r => NFData (SnapLevel r) where
+  rnf (SnapLevel a b) = rnf a `seq` rnf b
+
 data SnapIncomingRun r =
     SnapMergingRun !MergePolicyForLevel !NumRuns !NumEntries !UnspentCredits !MergeKnownCompleted !(SnapMergingRunState r)
   | SnapSingleRun !r
   deriving stock (Show, Eq, Functor, Foldable, Traversable)
 
+instance NFData r => NFData (SnapIncomingRun r) where
+  rnf (SnapMergingRun a b c d e f) =
+      rnf a `seq` rnf b `seq` rnf c `seq` rnf d `seq` rnf e `seq` rnf f
+  rnf (SnapSingleRun a) = rnf a
+
 -- | The total number of unspent credits. This total is used in combination with
 -- 'SpentCredits' on snapshot load to restore merging work that was lost when
 -- the snapshot was created.
 newtype UnspentCredits = UnspentCredits { getUnspentCredits :: Int }
   deriving stock (Show, Eq, Read)
+  deriving newtype NFData
 
 data SnapMergingRunState r =
     SnapCompletedMerge !r
   | SnapOngoingMerge !(V.Vector r) !SpentCredits !Merge.Level
   deriving stock (Show, Eq, Functor, Foldable, Traversable)
 
+instance NFData r => NFData (SnapMergingRunState r) where
+  rnf (SnapCompletedMerge a)   = rnf a
+  rnf (SnapOngoingMerge a b c) = rnf a `seq` rnf b `seq` rnf c
+
 -- | The total number of spent credits. This total is used in combination with
 -- 'UnspentCedits' on snapshot load to restore merging work that was lost when
 -- the snapshot was created.
 newtype SpentCredits = SpentCredits { getSpentCredits :: Int }
   deriving stock (Show, Eq, Read)
+  deriving newtype NFData
 
 {-------------------------------------------------------------------------------
   Conversion to levels snapshot format