Merge pull request #544 from IntersectMBO/wenkokke/move-fileformaterror

fix: move FileFormatError to Paths

Author: jorisdral

src/Database/LSMTree/Internal/CRC32C.hs

@@ -47,6 +47,10 @@ module Database.LSMTree.Internal.CRC32C (
   ChecksumError (..),
   checkCRC,
   expectChecksum,
+
+  -- * File format errors
+  FileFormatError (..),
+  expectValidFile,
   ) where
 
 import           Control.Monad
@@ -354,6 +358,12 @@ formatChecksumsFile checksums =
           <> BS.char8 '\n'
         | (ChecksumsFileName name, CRC32C crc) <- Map.toList checksums ]
 
+
+
+{-------------------------------------------------------------------------------
+  Checksum errors
+-------------------------------------------------------------------------------}
+
 data ChecksumError = ChecksumError FsPath CRC32C CRC32C
   deriving stock Show
   deriving anyclass Exception
@@ -403,3 +413,20 @@ expectChecksum ::
 expectChecksum fp expected checksum =
     when (expected /= checksum) $
       throwIO $ ChecksumError fp expected checksum
+
+
+{-------------------------------------------------------------------------------
+  File format errors
+-------------------------------------------------------------------------------}
+
+data FileFormatError = FileFormatError FsPath String
+  deriving stock Show
+  deriving anyclass Exception
+
+expectValidFile ::
+     MonadThrow f
+  => FsPath
+  -> Either String a
+  -> f a
+expectValidFile _  (Right x)  = pure x
+expectValidFile fp (Left err) = throwIO $ FileFormatError fp err

src/Database/LSMTree/Internal/Run.hs

@@ -22,7 +22,6 @@ module Database.LSMTree.Internal.Run (
   , fromWriteBuffer
   , RunDataCaching (..)
     -- * Snapshot
-  , FileFormatError (..)
   , openFromDisk
   ) where
 
@@ -234,10 +233,6 @@ fromWriteBuffer fs hbio caching alloc fsPaths buffer blobs = do
   Snapshot
 -------------------------------------------------------------------------------}
 
-data FileFormatError = FileFormatError FS.FsPath String
-  deriving stock Show
-  deriving anyclass Exception
-
 {-# SPECIALISE openFromDisk ::
      HasFS IO h
   -> HasBlockIO IO h
@@ -262,7 +257,7 @@ openFromDisk ::
 -- TODO: make exception safe
 openFromDisk fs hbio runRunDataCaching runRunFsPaths = do
     expectedChecksums <-
-       expectValidFile (runChecksumsPath runRunFsPaths) . fromChecksumsFile
+       CRC.expectValidFile (runChecksumsPath runRunFsPaths) . fromChecksumsFile
          =<< CRC.readChecksumsFile fs (runChecksumsPath runRunFsPaths)
 
     -- verify checksums of files we don't read yet
@@ -272,10 +267,10 @@ openFromDisk fs hbio runRunDataCaching runRunFsPaths = do
 
     -- read and try parsing files
     runFilter <-
-      expectValidFile (forRunFilterRaw paths) . bloomFilterFromSBS
+      CRC.expectValidFile (forRunFilterRaw paths) . bloomFilterFromSBS
         =<< readCRC (forRunFilterRaw expectedChecksums) (forRunFilterRaw paths)
     (runNumEntries, runIndex) <-
-      expectValidFile (forRunIndexRaw paths) . Index.fromSBS
+      CRC.expectValidFile (forRunIndexRaw paths) . Index.fromSBS
         =<< readCRC (forRunIndexRaw expectedChecksums) (forRunIndexRaw paths)
 
     runKOpsFile <- FS.hOpen fs (runKOpsPath runRunFsPaths) FS.ReadMode
@@ -306,6 +301,3 @@ openFromDisk fs hbio runRunDataCaching runRunFsPaths = do
         FS.hAdviseAll hbio h FS.AdviceDontNeed
         CRC.expectChecksum fp expected checksum
         return sbs
-
-    expectValidFile _  (Right x)  = pure x
-    expectValidFile fp (Left err) = throwIO $ FileFormatError fp err

src/Database/LSMTree/Internal/Snapshot/Codec.hs

@@ -34,7 +34,6 @@ import           Database.LSMTree.Internal.Entry
 import           Database.LSMTree.Internal.Merge (MergeType (..))
 import           Database.LSMTree.Internal.MergeSchedule
 import           Database.LSMTree.Internal.MergingRun (NumRuns (..))
-import           Database.LSMTree.Internal.Run (FileFormatError (..))
 import           Database.LSMTree.Internal.RunNumber
 import           Database.LSMTree.Internal.Snapshot
 import qualified System.FS.API as FS

test/Test/Database/LSMTree/Internal/Snapshot/FS.hs

@@ -4,7 +4,6 @@ module Test.Database.LSMTree.Internal.Snapshot.FS (tests) where
 import           Codec.CBOR.Read (DeserialiseFailure)
 import           Control.Exception
 import           Database.LSMTree.Internal.CRC32C
-import           Database.LSMTree.Internal.Run
 import           Database.LSMTree.Internal.Snapshot
 import           Database.LSMTree.Internal.Snapshot.Codec
 import           System.FS.API