From ad00327f2f1c604548d25f49fe795fb1ba61ce97 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 13 Jan 2026 09:13:33 -0500 Subject: [PATCH 1/3] fix: annotated SomeException with Graphula seed The seed is useful to re-run in a deterministic way, which is why we prepend it to any `HUnitFailure` exception messages. This commit adds the same treatment to all other exceptions by catching `SomeException` and using `checkpoint` to add it as an annotation. Here is an example: ``` Before: uncaught exception: GenerationFailureMaxAttemptsToInsert GenerationFailureMaxAttemptsToInsert (Just "entity already exists by this key") School} After: uncaught exception: AnnotatedException AnnotatedException {annotations = [Annotation @GraphulaSeed (GraphulaSeed (-8068470525722554834)),Annotation @CallStack [("checkpoint",SrcLoc {srcLocPackage = "graphula-2.0.0.0-ArtCvOVJMvo1gDWVYi6qKp", srcLocModule = "Graphula", srcLocFile = "src/Graphula.hs", srcLocStartLine = 272, srcLocStartCol = 8, srcLocEndLine = 272, srcLocEndCol = 18})]], exception = GenerationFailureMaxAttemptsToInsert (Just "entity already exists by this key") School} ``` Changing the thrown exception type is a risk, since any outer `catch`es our users (or other libraries) have in place may no longer catch it. But using `checkpoint` and changing `e` to `AnnotatedException e` should be tolerable, due to the fact that `AnnotatedException.catch` exists, which catches both types at once. That is why the output is relatively ugly, because we want to rely on `checkpoint` and `AnnotatedException`, so this is what you get. I also noticed that the existing code changes the `HUnitFailure` constructor used (both `Reason` and `ExpectedBotGot` are turned into `Reason` by way of `formatFailureReason`). Ideally, we would not do that (and there's no real need), but I'm leaving it alone for now, erring on the side of a smaller diff for this change. Closes #44. --- graphula.cabal | 1 + package.yaml | 1 + src/Graphula.hs | 12 +++++++++--- 3 files changed, 11 insertions(+), 3 deletions(-) diff --git a/graphula.cabal b/graphula.cabal index c609d1a..cc01a0f 100644 --- a/graphula.cabal +++ b/graphula.cabal @@ -48,6 +48,7 @@ library build-depends: HUnit , QuickCheck + , annotated-exception , base <5 , containers , directory diff --git a/package.yaml b/package.yaml index 50ce2c2..62878e1 100644 --- a/package.yaml +++ b/package.yaml @@ -43,6 +43,7 @@ library: dependencies: - HUnit - QuickCheck + - annotated-exception - containers - directory - generics-eot diff --git a/src/Graphula.hs b/src/Graphula.hs index 3b60d3c..af1cd00 100755 --- a/src/Graphula.hs +++ b/src/Graphula.hs @@ -137,6 +137,7 @@ module Graphula import Prelude hiding (readFile) +import Control.Exception.Annotated.UnliftIO (Annotation (..), checkpoint) import Control.Monad.IO.Unlift import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT) import Control.Monad.Trans (MonadTrans, lift) @@ -168,7 +169,7 @@ import Test.HUnit.Lang ) import Test.QuickCheck (Arbitrary (..)) import Test.QuickCheck.Random (QCGen, mkQCGen) -import UnliftIO.Exception (catch, throwIO) +import UnliftIO.Exception (SomeException, catch, fromException, throwIO) -- | A constraint over lists of nodes for 'MonadGraphula', and 'GraphulaNode'. -- @@ -262,8 +263,13 @@ runGraphulaT mSeed runDB action = do runReaderT (runGraphulaT' action) (Args (RunDB runDB) qcGen) `catch` logFailingSeed seed -logFailingSeed :: MonadIO m => Int -> HUnitFailure -> m a -logFailingSeed seed = rethrowHUnitWith ("Graphula with seed: " ++ show seed) +newtype GraphulaSeed = GraphulaSeed Int + deriving stock (Show) + +logFailingSeed :: MonadUnliftIO m => Int -> SomeException -> m a +logFailingSeed seed ex = case fromException ex of + Just hf -> rethrowHUnitWith ("Graphula with seed: " <> show seed) hf + _ -> checkpoint (Annotation $ GraphulaSeed seed) $ throwIO ex rethrowHUnitWith :: MonadIO m => String -> HUnitFailure -> m a rethrowHUnitWith message (HUnitFailure l r) = From ad5f5b7f8e4d1893aed4a18d465344f9cf751302 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 16 Jun 2026 09:58:00 -0400 Subject: [PATCH 2/3] chore: update README to use annotated-exception's try This is necessary because we now the example throws an `AnnotatedException GenerationFailure` and not a bare `GenerationFailure` exception. This is an example of the sort of change our users might have to make because of the seed annotation feature. --- graphula.cabal | 3 ++- package.yaml | 1 + test/README.lhs | 2 +- 3 files changed, 4 insertions(+), 2 deletions(-) diff --git a/graphula.cabal b/graphula.cabal index cc01a0f..d1a626b 100644 --- a/graphula.cabal +++ b/graphula.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.1. +-- This file has been generated from package.yaml by hpack version 0.39.1. -- -- see: https://github.com/sol/hpack @@ -83,6 +83,7 @@ test-suite readme markdown-unlit:markdown-unlit build-depends: QuickCheck + , annotated-exception , base <5 , generic-arbitrary , graphula diff --git a/package.yaml b/package.yaml index 62878e1..26da2df 100644 --- a/package.yaml +++ b/package.yaml @@ -65,6 +65,7 @@ tests: dependencies: - QuickCheck + - annotated-exception - generic-arbitrary - graphula - hspec diff --git a/test/README.lhs b/test/README.lhs index 343be64..b2541e4 100644 --- a/test/README.lhs +++ b/test/README.lhs @@ -32,7 +32,7 @@ dependencies. We use this interface to generate fixtures for automated testing. module Main (module Main) where -import Control.Exception (try, Exception(..)) +import Control.Exception.Annotated.UnliftIO (try, Exception(..)) import Control.Monad.IO.Class import Control.Monad.IO.Unlift import Control.Monad.Logger (NoLoggingT) From 354a6c3c69fe3ecfe941e28bbd2c219cd57def75 Mon Sep 17 00:00:00 2001 From: patrick brisbin Date: Tue, 16 Jun 2026 10:24:01 -0400 Subject: [PATCH 3/3] chore: add extra-dep --- stack-lts-12.26.yaml | 2 ++ stack-lts-12.26.yaml.lock | 13 ++++++++++--- stack-lts-14.27.yaml | 2 ++ stack-lts-14.27.yaml.lock | 13 ++++++++++--- stack-lts-16.31.yaml | 1 + stack-lts-16.31.yaml.lock | 13 ++++++++++--- stack-lts-18.28.yaml | 2 ++ stack-lts-18.28.yaml.lock | 13 ++++++++++--- stack-lts-19.33.yaml | 2 ++ stack-lts-19.33.yaml.lock | 11 +++++++++-- 10 files changed, 58 insertions(+), 14 deletions(-) diff --git a/stack-lts-12.26.yaml b/stack-lts-12.26.yaml index 5deda7b..1a2de7e 100644 --- a/stack-lts-12.26.yaml +++ b/stack-lts-12.26.yaml @@ -1,4 +1,6 @@ resolver: lts-12.26 +extra-deps: + - annotated-exception-0.3.0.4 flags: graphula: diff --git a/stack-lts-12.26.yaml.lock b/stack-lts-12.26.yaml.lock index 6bee1e8..e76d0f3 100644 --- a/stack-lts-12.26.yaml.lock +++ b/stack-lts-12.26.yaml.lock @@ -1,12 +1,19 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files -packages: [] +packages: +- completed: + hackage: annotated-exception-0.3.0.4@sha256:16aebcbf355df14ce39b676c54fb2bf415e94a24a785a7f557d753f158c09e4d,1785 + pantry-tree: + sha256: f311d8e1a2f68bd4a9be458e8059da06381ea5080bf9b112e334c8bd5a22e991 + size: 776 + original: + hackage: annotated-exception-0.3.0.4 snapshots: - completed: + sha256: 95f014df58d0679b1c4a2b7bf2b652b61da8d30de5f571abb0d59015ef678646 size: 509471 url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/12/26.yaml - sha256: 95f014df58d0679b1c4a2b7bf2b652b61da8d30de5f571abb0d59015ef678646 original: lts-12.26 diff --git a/stack-lts-14.27.yaml b/stack-lts-14.27.yaml index f476404..1173f6a 100644 --- a/stack-lts-14.27.yaml +++ b/stack-lts-14.27.yaml @@ -1,4 +1,6 @@ resolver: lts-14.27 +extra-deps: + - annotated-exception-0.3.0.4 flags: graphula: diff --git a/stack-lts-14.27.yaml.lock b/stack-lts-14.27.yaml.lock index e24dcac..995eab9 100644 --- a/stack-lts-14.27.yaml.lock +++ b/stack-lts-14.27.yaml.lock @@ -1,12 +1,19 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files -packages: [] +packages: +- completed: + hackage: annotated-exception-0.3.0.4@sha256:16aebcbf355df14ce39b676c54fb2bf415e94a24a785a7f557d753f158c09e4d,1785 + pantry-tree: + sha256: f311d8e1a2f68bd4a9be458e8059da06381ea5080bf9b112e334c8bd5a22e991 + size: 776 + original: + hackage: annotated-exception-0.3.0.4 snapshots: - completed: + sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0 size: 524996 url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/27.yaml - sha256: 7ea31a280c56bf36ff591a7397cc384d0dff622e7f9e4225b47d8980f019a0f0 original: lts-14.27 diff --git a/stack-lts-16.31.yaml b/stack-lts-16.31.yaml index bbad91c..950c013 100644 --- a/stack-lts-16.31.yaml +++ b/stack-lts-16.31.yaml @@ -1,5 +1,6 @@ resolver: lts-16.31 extra-deps: + - annotated-exception-0.3.0.4 - generics-eot-0.4.0.1 flags: diff --git a/stack-lts-16.31.yaml.lock b/stack-lts-16.31.yaml.lock index 9e65068..2b07141 100644 --- a/stack-lts-16.31.yaml.lock +++ b/stack-lts-16.31.yaml.lock @@ -1,19 +1,26 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files packages: +- completed: + hackage: annotated-exception-0.3.0.4@sha256:16aebcbf355df14ce39b676c54fb2bf415e94a24a785a7f557d753f158c09e4d,1785 + pantry-tree: + sha256: f311d8e1a2f68bd4a9be458e8059da06381ea5080bf9b112e334c8bd5a22e991 + size: 776 + original: + hackage: annotated-exception-0.3.0.4 - completed: hackage: generics-eot-0.4.0.1@sha256:3d8df1d8ca010238ec5f20ba30282daa0fac99c7de495fae64e26a7ea1dadb08,2312 pantry-tree: - size: 1384 sha256: 0895826ac5485a85e6fa37ae2b76195872fa2d92e901478c42d0690fc206a5ab + size: 1384 original: hackage: generics-eot-0.4.0.1 snapshots: - completed: + sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6 size: 534126 url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/31.yaml - sha256: 637fb77049b25560622a224845b7acfe81a09fdb6a96a3c75997a10b651667f6 original: lts-16.31 diff --git a/stack-lts-18.28.yaml b/stack-lts-18.28.yaml index 773d5c9..5288240 100644 --- a/stack-lts-18.28.yaml +++ b/stack-lts-18.28.yaml @@ -1 +1,3 @@ resolver: lts-18.28 +extra-deps: + - annotated-exception-0.3.0.4 diff --git a/stack-lts-18.28.yaml.lock b/stack-lts-18.28.yaml.lock index 7af0442..9547825 100644 --- a/stack-lts-18.28.yaml.lock +++ b/stack-lts-18.28.yaml.lock @@ -1,12 +1,19 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files -packages: [] +packages: +- completed: + hackage: annotated-exception-0.3.0.4@sha256:16aebcbf355df14ce39b676c54fb2bf415e94a24a785a7f557d753f158c09e4d,1785 + pantry-tree: + sha256: f311d8e1a2f68bd4a9be458e8059da06381ea5080bf9b112e334c8bd5a22e991 + size: 776 + original: + hackage: annotated-exception-0.3.0.4 snapshots: - completed: + sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 size: 590100 url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/28.yaml - sha256: 428ec8d5ce932190d3cbe266b9eb3c175cd81e984babf876b64019e2cbe4ea68 original: lts-18.28 diff --git a/stack-lts-19.33.yaml b/stack-lts-19.33.yaml index f9994e6..858f263 100644 --- a/stack-lts-19.33.yaml +++ b/stack-lts-19.33.yaml @@ -1 +1,3 @@ resolver: lts-19.33 +extra-deps: + - annotated-exception-0.3.0.4 diff --git a/stack-lts-19.33.yaml.lock b/stack-lts-19.33.yaml.lock index d79c369..7f31821 100644 --- a/stack-lts-19.33.yaml.lock +++ b/stack-lts-19.33.yaml.lock @@ -1,9 +1,16 @@ # This file was autogenerated by Stack. # You should not edit this file by hand. # For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files +# https://docs.haskellstack.org/en/stable/topics/lock_files -packages: [] +packages: +- completed: + hackage: annotated-exception-0.3.0.4@sha256:16aebcbf355df14ce39b676c54fb2bf415e94a24a785a7f557d753f158c09e4d,1785 + pantry-tree: + sha256: f311d8e1a2f68bd4a9be458e8059da06381ea5080bf9b112e334c8bd5a22e991 + size: 776 + original: + hackage: annotated-exception-0.3.0.4 snapshots: - completed: sha256: 6d1532d40621957a25bad5195bfca7938e8a06d923c91bc52aa0f3c41181f2d4