Introduce panicTrace and errorTrace

gargantext-prelude.cabal

@@ -36,6 +36,7 @@ library
       Gargantext.Prelude.Crypto.Share
       Gargantext.Prelude.Crypto.Symmetric
       Gargantext.Prelude.Database
+      Gargantext.Prelude.Error
       Gargantext.Prelude.Fibonacci
       Gargantext.Prelude.Mail
       Gargantext.Prelude.Mail.Types

src/Gargantext/Prelude.hs

@@ -18,6 +18,7 @@ module Gargantext.Prelude
   , module Protolude
   , module Data.String.Conversions
   , MonadBase(..)
+  , module Gargantext.Prelude.Error
   )
   where
 
@@ -34,14 +35,27 @@ import Data.Semigroup (Semigroup, (<>))
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Data.String.Conversions (ConvertibleStrings, cs)
+import Data.Text (Text)
 import Data.Typeable (Typeable)
 import Data.Vector qualified as V
 import GHC.Exts (sortWith)
 import GHC.Real (round)
-import Protolude
+import Protolude hiding (panic)
+import Protolude qualified as Proto
+import Prelude   qualified as GHCPrelude
+import Gargantext.Prelude.Error
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath.Posix (takeDirectory)
 
+-- Version of panic and error with an explicit warning.
+
+panic :: Text -> a
+panic = Proto.panic
+{-# DEPRECATED panic "'panic' doesn't attach a stacktrace to the error. Please use 'panicTrace'" #-}
+
+error :: GHCPrelude.String -> a
+error = GHCPrelude.error
+{-# DEPRECATED error "'error' doesn't attach a stacktrace to the error. Please use 'errorTrace'" #-}
 
 printDebug :: (Show a, MonadBase IO m) => Text -> a -> m ()
 printDebug msg x = liftBase . putStrLn $ msg <> " " <> show x

src/Gargantext/Prelude/Error.hs

+module Gargantext.Prelude.Error (
+  -- * Attaching callstacks to exceptions
+    WithStacktrace(..)
+  , UnexpectedPanic(..)
+  , withStacktrace
+
+  -- * Drop-in replacement for panic/error
+  , panicTrace
+  , errorTrace
+  ) where
+
+import Control.Exception
+import Data.Text qualified as T
+import GHC.Stack
+import Prelude
+
+-- | A 'WithStacktrace' carries an error alongside its
+-- 'CallStack', to be able to print the correct source location
+-- of where the error originated.
+data WithStacktrace e =
+  WithStacktrace {
+    ct_callStack :: !CallStack
+  , ct_error     :: !e
+  } deriving Show
+
+instance Exception e => Exception (WithStacktrace e) where
+  displayException WithStacktrace{..}
+    = displayException ct_error <> "\n" <> prettyCallStack ct_callStack
+
+withStacktrace :: HasCallStack => e -> WithStacktrace e
+withStacktrace = withFrozenCallStack . WithStacktrace callStack
+
+newtype UnexpectedPanic = UnexpectedPanic T.Text
+  deriving Show
+
+instance Exception UnexpectedPanic
+
+panicTrace :: HasCallStack => T.Text -> x
+panicTrace = throw . withFrozenCallStack . WithStacktrace callStack . UnexpectedPanic
+
+-- | Drop-in replacement for Prelude's 'error'.
+errorTrace :: HasCallStack => String -> x
+errorTrace = panicTrace . T.pack