Merge pull request #448 from symbiont-io/journal-assert

feat(journal): Add Assert module that can be controlled by cabal flag…

src/journal/extra/assert/dorun/Assert.hs

@@ -0,0 +1,36 @@
+module Assert (assert, assertM, assertIO) where
+
+import Control.Exception (throw, AssertionFailed(AssertionFailed))
+import GHC.Stack (HasCallStack, callStack, prettyCallStack)
+
+assert :: HasCallStack => Bool -> a -> a
+assert True x = x
+assert False _ = throw (AssertionFailed errMsg)
+  where
+    errMsg = concat
+      [ "Assertion failed\n"
+      , prettyCallStack callStack
+      ]
+
+assertM :: (HasCallStack, Monad m) => Bool -> m ()
+assertM b = do
+  if b
+    then pure ()
+    else throw (AssertionFailed errMsg)
+  where
+    errMsg = concat
+      [ "Assertion failed\n"
+      , prettyCallStack callStack
+      ]
+
+assertIO :: HasCallStack => IO Bool -> IO ()
+assertIO mb = do
+  b <- mb
+  if b
+    then pure ()
+    else throw (AssertionFailed errMsg)
+  where
+    errMsg = concat
+      [ "Assertion failed\n"
+      , prettyCallStack callStack
+      ]

src/journal/extra/assert/skiprun/Assert.hs

@@ -0,0 +1,15 @@
+module Assert (assert, assertM, assertIO) where
+
+import GHC.Stack (HasCallStack)
+
+{-# INLINE assert #-}
+assert :: Bool -> a -> a
+assert _ = id
+
+{-# INLINE assertM #-}
+assertM :: (Monad m) => Bool -> m ()
+assertM _ = pure ()
+
+{-# INLINE assertIO #-}
+assertIO :: IO Bool -> IO ()
+assertIO _ = pure ()

src/journal/journal.cabal

@@ -25,12 +25,21 @@ extra-source-files:
   cbits/atomic.c
   cbits/mac_falloc.c
 
+flag SkipAssert
+  description: Disable running asserts
+  default: False
+  manual: True
+
 library
   hs-source-dirs:   src
   if os(darwin)
     hs-source-dirs: osx
   if os(linux)
     hs-source-dirs: linux
+  if flag(SkipAssert)
+    hs-source-dirs: extra/assert/skiprun
+  else
+    hs-source-dirs: extra/assert/dorun
 
   -- GHC boot library dependencies:
   -- (https://gitlab.haskell.org/ghc/ghc/-/blob/master/packages)
@@ -64,6 +73,7 @@ library
     Journal.Internal.Utils
     Journal.Types
     Journal.Types.AtomicCounter
+    Assert
 
   ghc-options:      -O2
   if os(linux)

src/journal/src/Journal/Internal/Utils.hs

@@ -1,8 +1,11 @@
 {-# LANGUAGE MagicHash #-}
 
-module Journal.Internal.Utils where
+module Journal.Internal.Utils
+  ( module Journal.Internal.Utils
+  , module Assert)
+  where
 
-import Control.Exception (assert, bracket)
+import Control.Exception (bracket)
 import Data.Bits ((.|.))
 import Data.Int (Int32, Int64)
 import Foreign.Marshal.Alloc (callocBytes, free)
@@ -21,13 +24,11 @@ import System.Posix.IO
        )
 import System.Posix.Types (Fd)
 
+import Assert
 import Journal.Internal.FileAllocate
 
 ------------------------------------------------------------------------
 
-assertM :: (HasCallStack, Monad m) => Bool -> m ()
-assertM b = assert b (return ())
-
 withRWFd :: FilePath -> (Fd -> IO a) -> IO a
 withRWFd fp k =
   bracket