Annotate SomeException with Graphula seed

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
 
@@ -48,6 +48,7 @@ library
   build-depends:
       HUnit
     , QuickCheck
+    , annotated-exception
     , base <5
     , containers
     , directory
@@ -82,6 +83,7 @@ test-suite readme
       markdown-unlit:markdown-unlit
   build-depends:
       QuickCheck
+    , annotated-exception
     , base <5
     , generic-arbitrary
     , graphula

package.yaml

@@ -43,6 +43,7 @@ library:
   dependencies:
     - HUnit
     - QuickCheck
+    - annotated-exception
     - containers
     - directory
     - generics-eot
@@ -64,6 +65,7 @@ tests:
 
     dependencies:
       - QuickCheck
+      - annotated-exception
       - generic-arbitrary
       - graphula
       - hspec

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) =

stack-lts-12.26.yaml

@@ -1,4 +1,6 @@
 resolver: lts-12.26
+extra-deps:
+  - annotated-exception-0.3.0.4
 
 flags:
   graphula:

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

stack-lts-14.27.yaml

@@ -1,4 +1,6 @@
 resolver: lts-14.27
+extra-deps:
+  - annotated-exception-0.3.0.4
 
 flags:
   graphula:

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

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:

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

stack-lts-18.28.yaml

@@ -1 +1,3 @@
 resolver: lts-18.28
+extra-deps:
+  - annotated-exception-0.3.0.4

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

stack-lts-19.33.yaml

@@ -1 +1,3 @@
 resolver: lts-19.33
+extra-deps:
+  - annotated-exception-0.3.0.4

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

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)