diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,6 +1,20 @@
 <!-- Unreleased: append new entries here -->
 
 
+0.3.2
+=====
+* [!1323](https://gitlab.com/morley-framework/morley/-/merge_requests/1323)
+  Trace called contracts on error
+  + Display sequence of contracts calls and other operations on error
+* [!1310](https://gitlab.com/morley-framework/morley/-/merge_requests/1310)
+  Various parser fixes
+  + Add Hedgehog generator for Michelson macros `genMacro`
+* [!1341](https://gitlab.com/morley-framework/morley/-/merge_requests/1341)
+  Refactor scope constraints
+  + Avoid redundant `check*Presence` uses
+* [!1333](https://gitlab.com/morley-framework/morley/-/merge_requests/1333)
+  Improve typechecker error rendering
+
 0.3.1
 =====
 * [!1339](https://gitlab.com/morley-framework/morley/-/merge_requests/1339)
diff --git a/cleveland.cabal b/cleveland.cabal
--- a/cleveland.cabal
+++ b/cleveland.cabal
@@ -5,7 +5,7 @@
 -- see: https://github.com/sol/hpack
 
 name:           cleveland
-version:        0.3.1
+version:        0.3.2
 synopsis:       Testing framework for Morley.
 description:    This package provides an eDSL for testing contracts written in Michelson, Morley or Lorentz. These tests can be run on an emulated environment or on a real network.
 category:       Blockchain
@@ -169,7 +169,6 @@
     , directory
     , exceptions
     , file-embed
-    , fmt
     , hedgehog >=1.0.3
     , hex-text
     , lens
@@ -222,6 +221,7 @@
       TestSuite.Cleveland.ErrorMessages
       TestSuite.Cleveland.ExpectFailure
       TestSuite.Cleveland.FailureLogs
+      TestSuite.Cleveland.FailureSequence
       TestSuite.Cleveland.ImplicitTickets
       TestSuite.Cleveland.Import
       TestSuite.Cleveland.InitialState
@@ -316,7 +316,6 @@
       base-noprelude >=4.7 && <5
     , cleveland
     , filepath
-    , fmt
     , hedgehog >=1.0.3
     , hspec-expectations
     , lens
diff --git a/src/Hedgehog/Gen/Michelson/Typed.hs b/src/Hedgehog/Gen/Michelson/Typed.hs
--- a/src/Hedgehog/Gen/Michelson/Typed.hs
+++ b/src/Hedgehog/Gen/Michelson/Typed.hs
@@ -27,6 +27,7 @@
   ) where
 
 import Control.Exception qualified as Ex
+import Data.Constraint ((\\))
 import Data.Singletons (Sing)
 import Hedgehog (GenBase, MonadGen)
 import Hedgehog.Gen qualified as Gen
@@ -70,7 +71,7 @@
 
 genValueBigMap
   :: forall (k :: T) (v :: T) m instr.
-     (MonadGen m, WellTyped k, WellTyped v, HasNoBigMap v, Comparable k)
+     (MonadGen m, WellTyped k, WellTyped v, ForbidBigMap v, Comparable k)
   => Range Length -> m (Value' instr k) -> m (Value' instr v) -> m (Value' instr ('TBigMap k v))
 genValueBigMap len genKey genVal =
   VBigMap
@@ -135,7 +136,7 @@
 
 genValue
   :: forall t m.
-      (MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t)
+      (MonadGen m, GenBase m ~ Identity, ForbidOp t, WellTyped t)
   => m (Value' Instr t)
 genValue = genValue' (sing @t)
 
@@ -157,7 +158,7 @@
 genBigMapId = Gen.integral (Range.constant 0 100000000)
 
 genValue'
-  :: (MonadGen m, GenBase m ~ Identity, HasNoOp t, WellTyped t)
+  :: (MonadGen m, GenBase m ~ Identity, ForbidOp t, WellTyped t)
   => Sing t -> m (Value' Instr t)
 genValue' = \case
   STKey -> VKey <$> genPublicKey
@@ -175,16 +176,17 @@
   STContract _ -> VContract <$> (MkAddress <$> genContractAddress) <*> pure unsafeSepcCallRoot
   STTicket s -> genValueTicket def $ genValue' s
   STPair STChestKey STChest -> VPair . bimap VChestKey VChest . swap <$> genChestAndKey
-  STPair l r -> VPair <$> ((,) <$> genNoOpValue l <*> genNoOpValue r)
-  STOr l r -> VOr <$> Gen.choice
-    [ Left <$> genNoOpValue l
-    , Right <$> genNoOpValue r
+  STPair l r -> deMorganForbidT SPSOp l r $
+    VPair <$> ((,) <$> genValue' l <*> genValue' r)
+  STOr l r -> deMorganForbidT SPSOp l r $ VOr <$> Gen.choice
+    [ Left <$> genValue' l
+    , Right <$> genValue' r
     ]
   -- It's quite hard to generate proper lambda of given type, so it always returns FAILWITH.
   -- Such implementation is sufficient for now.
   STLambda{} -> pure $ mkVLam $ RfAlwaysFails $ Seq UNIT FAILWITH
-  STMap k v -> genValueMap def (genNoOpValue k) (genNoOpValue v)
-  STBigMap k v -> genValueBigMap def (genNoOpValue k) (genNoOpValue v)
+  STMap k v -> genValueMap def (genValue' k) (genValue' v) \\ comparableImplies k
+  STBigMap k v -> genValueBigMap def (genValue' k) (genValue' v)
   STInt -> genValueInt def
   STNat -> genValueNat def
   STString -> genValueString def
@@ -204,13 +206,6 @@
   STSaplingState _ -> error "genValue': Cannot generate `sapling_state` value."
   STSaplingTransaction _ -> error "genValue': Cannot generate `sapling_transaction` value."
   where
-    genNoOpValue
-      :: (MonadGen m, GenBase m ~ Identity, WellTyped t')
-      => Sing t' -> m (Value' Instr t')
-    genNoOpValue st = case checkOpPresence st of
-      OpAbsent -> genValue' st
-      _ -> Gen.discard
-
     genBls12Pairing
       :: MonadGen m
       => m (Value' Instr ('TList $ 'TPair 'TBls12381G1 'TBls12381G2))
diff --git a/src/Hedgehog/Gen/Michelson/Untyped.hs b/src/Hedgehog/Gen/Michelson/Untyped.hs
--- a/src/Hedgehog/Gen/Michelson/Untyped.hs
+++ b/src/Hedgehog/Gen/Michelson/Untyped.hs
@@ -23,6 +23,7 @@
   , genEpName
   , genAnnotation
   , genT
+  , genMacro
   ) where
 
 import Prelude hiding (EQ, GT, LT)
@@ -33,6 +34,7 @@
 import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 
+import Morley.Michelson.Macro
 import Morley.Michelson.Untyped
 
 import Hedgehog.Gen.Michelson (genErrorSrcPos, genMText)
@@ -61,7 +63,7 @@
   , Gen.subtermM genExpandedOp $ \expandedOp -> WithSrcEx <$> genErrorSrcPos <*> pure expandedOp
   ]
 
-genExtInstrAbstract :: (MonadGen m, GenBase m ~ Identity) => m op -> m (ExtInstrAbstract op)
+genExtInstrAbstract :: (MonadGen m, GenBase m ~ Identity) => m op -> m (ExtInstrAbstract [] op)
 genExtInstrAbstract genOp = Gen.choice
   [ STACKTYPE <$> genStackTypePattern
   , UTEST_ASSERT <$> genTestAssert genOp
@@ -77,7 +79,7 @@
 genStackRef range = StackRef <$> Gen.integral (unStackRef <$> range)
   where unStackRef (StackRef x) = x
 
-genTestAssert :: MonadGen m => m op -> m (TestAssert op)
+genTestAssert :: MonadGen m => m op -> m (TestAssert [] op)
 genTestAssert genOp = TestAssert <$> genSmallText <*> genPrintComment def <*> genSmallList genOp
 
 genStackTypePattern :: (MonadGen m, GenBase m ~ Identity) => m StackTypePattern
@@ -85,11 +87,11 @@
   [ pure StkEmpty, pure StkRest ]
   [ Gen.subtermM genStackTypePattern $ \stp -> StkCons <$> genTyVar <*> pure stp ]
 
-genInstrAbstract :: (MonadGen m, GenBase m ~ Identity) => m op -> m (InstrAbstract op)
+genInstrAbstract :: (MonadGen m, GenBase m ~ Identity) => m op -> m (InstrAbstract [] op)
 genInstrAbstract genOp =
   Gen.choice $ instrAbstractWithOp genOp <> instrAbstractWithoutOp
 
-instrAbstractWithOp :: (MonadGen m, GenBase m ~ Identity) => m op -> [m (InstrAbstract op)]
+instrAbstractWithOp :: (MonadGen m, GenBase m ~ Identity) => m op -> [m (InstrAbstract [] op)]
 instrAbstractWithOp genOp =
   [ EXT <$> genExtInstrAbstract genOp
   , PUSH <$> genAnnotation <*> genType <*> genValue' genOp
@@ -107,7 +109,7 @@
   , CREATE_CONTRACT <$> genAnnotation <*> genAnnotation <*> genContract' genOp
   ]
 
-instrAbstractWithoutOp :: (MonadGen m, GenBase m ~ Identity) => [m (InstrAbstract op)]
+instrAbstractWithoutOp :: (MonadGen m, GenBase m ~ Identity) => [m (InstrAbstract [] op)]
 instrAbstractWithoutOp =
   [ DROPN <$> Gen.word Range.linearBounded
   , pure DROP
@@ -197,9 +199,9 @@
 genContract' genOp = Contract
   <$> genParameterType
   <*> genType
-  <*> genSmallList genOp
+  <*> genOp
   <*> genEntriesOrder
-  <*> fmap UnsafeViewsSet (Gen.map (Range.exponential 0 2) genSomeViewWithName)
+  <*> fmap ViewsSet (Gen.map (Range.exponential 0 2) genSomeViewWithName)
   where
     genSomeViewWithName = do
       v <- genSomeView genOp
@@ -219,21 +221,21 @@
   <$> genViewName
   <*> genType
   <*> genType
-  <*> genSmallList genOp
+  <*> genOp
 
 genValue :: (MonadGen m, GenBase m ~ Identity) => m Value
 genValue = genValue' genExpandedOp
 
-genValueInt :: MonadGen m => Range ValueInt -> m (Value' op)
+genValueInt :: MonadGen m => Range ValueInt -> m (Value' [] op)
 genValueInt range = ValueInt <$> Gen.integral (unValueInt <$> range)
 
-genValueString :: MonadGen m => Range Length -> m (Value' op)
+genValueString :: MonadGen m => Range Length -> m (Value' [] op)
 genValueString = fmap ValueString . genMText
 
-genValueBytes :: MonadGen m => Range Length -> m (Value' op)
+genValueBytes :: MonadGen m => Range Length -> m (Value' [] op)
 genValueBytes = fmap ValueBytes . genInternalByteString
 
-genValue' :: MonadGen m => m op -> m (Value' op)
+genValue' :: MonadGen m => m op -> m (Value' [] op)
 genValue' genOp = Gen.recursive Gen.choice
   -- non-recursive constructors
   [ genValueInt def
@@ -252,10 +254,10 @@
   , Gen.subterm (genValue' genOp) ValueSome
   , ValueSeq <$> genSmallNonEmpty (genValue' genOp)
   , ValueMap <$> genSmallNonEmpty (genElt genOp)
-  , ValueLambda <$> genSmallNonEmpty genOp
+  , ValueLambda . toList <$> genSmallNonEmpty genOp
   ]
 
-genElt :: MonadGen m => m op -> m (Elt op)
+genElt :: MonadGen m => m op -> m (Elt [] op)
 genElt genOp = Elt <$> genValue' genOp <*> genValue' genOp
 
 genParameterType :: (MonadGen m, GenBase m ~ Identity) => m ParameterType
@@ -352,3 +354,51 @@
 
 genSmallText :: MonadGen m => m Text
 genSmallText = Gen.text (Range.linear 0 10) Gen.unicodeAll
+
+genMacro :: (MonadGen m, GenBase m ~ Identity) => m Macro
+genMacro = Gen.choice
+  [ CMP <$> cmp
+  , IFX <$> cmp <*> seq' <*> seq'
+  , IFCMP <$> cmp <*> seq' <*> seq'
+  , pure FAIL
+  , PAPAIR <$> pair <*> ann <*> ann
+  , UNPAPAIR <$> unpair
+  , CADR <$> cadr <*> ann <*> ann
+  , CARN <$> ann <*> word
+  , CDRN <$> ann <*> word
+  , SET_CADR <$> cadr <*> ann <*> ann
+  , MAP_CADR <$> cadr <*> ann <*> ann <*> seq'
+  , DIIP <$> word <*> seq'
+  , DUUP <$> word <*> ann
+  , pure ASSERT
+  , ASSERTX <$> cmp
+  , ASSERT_CMP <$> cmp
+  , pure ASSERT_NONE
+  , pure ASSERT_SOME
+  , pure ASSERT_LEFT
+  , pure ASSERT_RIGHT
+  , IF_SOME <$> seq' <*> seq'
+  , IF_RIGHT <$> seq' <*> seq'
+  ]
+  where
+    seq' = pure $ PSSequence []
+    cmp = Gen.choice
+      [ EQ <$> ann
+      , NEQ <$> ann
+      , LT <$> ann
+      , GT <$> ann
+      , LE <$> ann
+      , GE <$> ann
+      ]
+    ann = genAnnotation
+    word = Gen.integral $ Range.linear 1 10
+    pair = Gen.choice
+      [ F <$> ann
+      , P <$> pair <*> pair
+      ]
+    unpair = Gen.choice
+      [ pure UF
+      , UP <$> unpair <*> unpair
+      ]
+    cadr = genSmallList cadr1
+    cadr1 = Gen.choice [pure A, pure D]
diff --git a/src/Hedgehog/Gen/Morley/Micheline.hs b/src/Hedgehog/Gen/Morley/Micheline.hs
--- a/src/Hedgehog/Gen/Morley/Micheline.hs
+++ b/src/Hedgehog/Gen/Morley/Micheline.hs
@@ -112,7 +112,7 @@
     <*> Gen.list (unSmallLength <$> def) doGenExp
     <*> genAnnots
   where
-    genMichelinePrimitive = MichelinePrimitive <$> (Gen.element $ toList michelsonPrimitive)
+    genMichelinePrimitive = Gen.enumBounded
     genAnnots = Gen.list (unSmallLength <$> def) genExprAnnotation
 
 genExprAnnotation :: (MonadGen m, GenBase m ~ Identity) => m Annotation
diff --git a/src/Test/Cleveland/Doc/Michelson.hs b/src/Test/Cleveland/Doc/Michelson.hs
--- a/src/Test/Cleveland/Doc/Michelson.hs
+++ b/src/Test/Cleveland/Doc/Michelson.hs
@@ -17,8 +17,7 @@
   ) where
 
 import Data.Text qualified as T
-import Data.Text.Lazy.Builder (toLazyText)
-import Fmt (blockListF, fmt, nameF)
+import Fmt (blockListF, fmt, nameF, pretty)
 import Test.HUnit (assertBool, assertFailure)
 
 import Morley.Michelson.Doc
@@ -106,7 +105,7 @@
   \contractDoc ->
     let res =
           allContractDocItems contractDoc <&> \(DDescription desc) ->
-            check (toText $ toLazyText desc)
+            check (pretty desc)
     in case nonEmpty (lefts res) of
       Nothing -> pass
       Just errs -> assertFailure . fmt $
diff --git a/src/Test/Cleveland/Instances.hs b/src/Test/Cleveland/Instances.hs
--- a/src/Test/Cleveland/Instances.hs
+++ b/src/Test/Cleveland/Instances.hs
@@ -8,7 +8,7 @@
   ) where
 
 import Data.Default (Default(..))
-import Fmt (Buildable(..), eitherF, hexF, tupleF, (+|), (|+))
+import Fmt (Buildable(..), hexF, (+|), (|+))
 import GHC.Num qualified (fromInteger)
 import Test.Tasty.Runners (FailureReason(..))
 import Time (Time)
@@ -74,26 +74,6 @@
 instance (Eq k, Eq v) => Eq (BigMap k v) where
   BigMap _ bm1 == BigMap _ bm2 = bm1 == bm2
 
-instance Buildable () where build _ = "()"
-
-instance (Buildable a, Buildable b) => Buildable (a, b) where build = tupleF
-instance (Buildable a, Buildable b, Buildable c) => Buildable (a, b, c) where
-  build = tupleF
-instance (Buildable a, Buildable b, Buildable c, Buildable d) =>
-  Buildable (a, b, c, d) where build = tupleF
-instance (Buildable a, Buildable b, Buildable c, Buildable d, Buildable e) =>
-    Buildable (a, b, c, d, e) where build = tupleF
-instance (Buildable a, Buildable b, Buildable c,
-          Buildable d, Buildable e, Buildable f) =>
-          Buildable (a, b, c, d, e, f) where build = tupleF
-instance (Buildable a, Buildable b, Buildable c,
-          Buildable d, Buildable e, Buildable f,
-          Buildable g) => Buildable (a, b, c, d, e, f, g) where build = tupleF
-instance (Buildable a, Buildable b, Buildable c,
-          Buildable d, Buildable e, Buildable f,
-          Buildable g, Buildable h) =>
-          Buildable (a, b, c, d, e, f, g, h) where build = tupleF
-
 instance Buildable ByteString where build bs = "0x" <> hexF bs
 instance Buildable LByteString where build bs = "0x" <> hexF bs
 
@@ -144,9 +124,6 @@
     TestThrewException e -> "Test threw exception: " +| displayException e |+ ""
     TestTimedOut s -> "Test timed out: " +| s |+ ""
     TestDepFailed -> "Test skipped because its dependency failed"
-
-instance (Buildable a, Buildable b) => Buildable (Either a b) where
-  build = eitherF
 
 instance mname ~ 'Nothing => Default (EntrypointRef mname) where
   def = CallDefault
diff --git a/src/Test/Cleveland/Internal/Abstract.hs b/src/Test/Cleveland/Internal/Abstract.hs
--- a/src/Test/Cleveland/Internal/Abstract.hs
+++ b/src/Test/Cleveland/Internal/Abstract.hs
@@ -38,7 +38,7 @@
 import Data.Constraint (Bottom(..), (\\))
 import Data.Default (Default(..))
 import Data.Type.Equality (pattern Refl)
-import Fmt (Buildable(..), Builder, pretty, (+|), (|+))
+import Fmt (Buildable(..), Doc, blockListF, pretty, unlinesF, (+|), (|+))
 import Prelude hiding (Each)
 import Time (KnownDivRat, Second, Time)
 
@@ -309,7 +309,7 @@
   -- ^ Get the timestamp observed by the last block to be baked.
   , cmiGetLevel :: HasCallStack => m Natural
   -- ^ Get the current level observed by the last block to be baked.
-  , cmiFailure :: forall a. HasCallStack => Builder -> m a
+  , cmiFailure :: forall a. HasCallStack => Doc -> m a
   -- ^ Fails the test with the given error message.
   , cmiThrow :: forall a. HasCallStack => SomeException -> m a
   -- ^ Rethrow arbitrary error without affecting the call stack. Used
@@ -331,7 +331,7 @@
   -- ^ Execute a contract's code without originating it.
   -- The chain's state will not be modified.
   , cmiTicketBalance
-    :: forall t. (T.HasNoOp t, T.Comparable t)
+    :: forall t. (T.ForbidOp t, T.Comparable t)
     => L1Address -> ContractAddress -> T.Value t -> m Natural
   -- ^ Get balance for a praticular ticket.
   , cmiAllTicketBalances :: ContractAddress -> m [SomeTicket]
@@ -587,9 +587,106 @@
 -- These can be caught and handled with 'Test.Cleveland.attempt'.
 data TransferFailure = TransferFailure
   { tfAddressAndAlias :: AddressAndAlias
+  , tfCallSeqence :: CallSequence
   , tfReason :: TransferFailureReason
-  } deriving stock (Show, Eq)
+  }
 
+deriving stock instance Show TransferFailure
+
+newtype CallSequence = CallSequence [CallSequenceOp]
+  deriving stock Show
+  deriving newtype (Container, Semigroup, Monoid)
+
+instance Buildable CallSequence where
+  build (CallSequence xs)
+    | null xs = mempty
+    | otherwise = blockListF xs
+
+-- | Build only the last branch of 'CallSequence' as a linear array.
+buildLastBranchLinear :: CallSequence -> Doc
+buildLastBranchLinear = blockListF . go
+  where
+    go (CallSequence xs) = nonEmpty xs &
+      maybe mempty
+      \(last -> CallSequenceOp{..}) -> build csoData : go csoSubCalls
+
+data CallSequenceOp =
+  forall a. (Buildable a, Show a) => CallSequenceOp
+    { csoData :: a
+    , csoSubCalls :: CallSequence
+    }
+deriving stock instance Show CallSequenceOp
+
+instance Buildable CallSequenceOp where
+  build CallSequenceOp{..}
+    | null csoSubCalls = build csoData
+    | otherwise = unlinesF
+        [ build csoData
+        , build csoSubCalls
+        ]
+
+-- | Helper synonym for 'toCallSeq'
+type ToCallSeqM k = State [(k, [CallSequenceOp])]
+
+{- | Given a linear list of operations, reconstruct the "call sequence tree".
+
+The function is polymorphic to support both emulated and network operations.
+
+Uses a rather straightforward stack-based algorithm for reconstruction in
+$O(n)$. However, bear in mind perfect reconstruction is not always possible, so
+this is merely best-effort.
+
+In the following example @Int@ substitutes for @Address@ for simplicity.
+
+>>> import Morley.Util.Interpolate (i)
+>>> :{
+aux :: (Int, Int) -> ToCallSeqM Int (Maybe (Int, CallSequenceOp))
+aux (caller, callee) =
+  Just . (caller,) . CallSequenceOp [i|#{caller} calling #{callee}|] . CallSequence
+    <$> popToCallSeq callee
+:}
+
+>>> :{
+Fmt.pretty $ toCallSeq aux
+  [(1, 2), (2, 3), (2, 3), (2, 4), (4, 2), (2, 5), (5, 1), (5, 3), (2, 3), (7, 1)]
+:}
+- 1 calling 2
+  - 2 calling 3
+  - 2 calling 3
+  - 2 calling 4
+    - 4 calling 2
+      - 2 calling 5
+        - 5 calling 1
+        - 5 calling 3
+      - 2 calling 3
+- 7 calling 1
+
+Note that in this call sequence, it is ambiguous whether the last @2 calling 3@
+happens from @1@ or @4@. The algorithm used here will always assume deepest
+nesting in such cases.
+-}
+toCallSeq :: Eq k => (a -> ToCallSeqM k (Maybe (k, CallSequenceOp))) -> [a] -> CallSequence
+toCallSeq toCallOp = CallSequence . concatMap snd . executingState mempty . go . reverse
+  where
+    go = \case
+      [] -> pass
+      (y : ys) -> toCallOp y >>= maybe pass (uncurry push) >> go ys
+
+    push src op = modify \case
+      (src', ops) : xs | src == src' -> (src', op:ops) : xs
+      xs -> (src, [op]) : xs
+
+-- | Helper function for 'toCallSeq'. Pops the top of the stack if key matches
+-- the supplied argument.
+popToCallSeq :: Eq k => k -> ToCallSeqM k [CallSequenceOp]
+popToCallSeq src = get >>= \case
+  (src', ops) : xs | src == src' -> put xs >> pure ops
+  _ -> pure mempty
+
+instance Eq TransferFailure where
+  tf1 == tf2 = tfAddressAndAlias tf1 == tfAddressAndAlias tf2
+    && tfReason tf1 == tfReason tf2
+
 data TransferFailureReason
   = FailedWith ExpressionOrTypedValue (Maybe ErrorSrcPos)
   -- ^ Expect that interpretation of contract with the given address ended
@@ -608,11 +705,15 @@
   deriving stock (Show, Eq)
 
 instance Buildable TransferFailure where
-  build (TransferFailure addr reason) = case reason of
-    EmptyTransaction -> reason |+ ": " +| addr |+ ""
-    BadParameter -> "Attempted to call contract " +| addr |+ " with a " +| reason |+ ""
-    FailedWith{} -> "Contract: " +| addr |+ " " +| reason |+ ""
-    _ -> "Contract: " +| addr |+ " failed due to a " +| reason |+ ""
+  build (TransferFailure addr stack reason) = unlinesF [message, rest]
+    where
+      message = case reason of
+        EmptyTransaction -> reason |+ ": " +| addr |+ ""
+        BadParameter -> "Attempted to call contract " +| addr |+ " with a " +| reason |+ ""
+        FailedWith{} -> "Contract: " +| addr |+ " " +| reason |+ ""
+        _ -> "Contract: " +| addr |+ " failed due to a " +| reason |+ ""
+      rest | null stack = mempty
+           | otherwise = "Call chain:\n" <> buildLastBranchLinear stack
 
 instance Buildable TransferFailureReason where
   build = \case
diff --git a/src/Test/Cleveland/Internal/Actions/Assertions.hs b/src/Test/Cleveland/Internal/Actions/Assertions.hs
--- a/src/Test/Cleveland/Internal/Actions/Assertions.hs
+++ b/src/Test/Cleveland/Internal/Actions/Assertions.hs
@@ -8,7 +8,7 @@
   ( module Test.Cleveland.Internal.Actions.Assertions
   ) where
 
-import Fmt (Buildable, Builder, build, pretty, unlinesF)
+import Fmt (Buildable, Doc, build, pretty, unlinesF)
 
 import Test.Cleveland.Internal.Abstract
 import Test.Cleveland.Internal.Actions.Helpers
@@ -16,12 +16,12 @@
 {-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}
 
 -- | Fails the test with the given error message.
-failure :: forall a caps m. (HasCallStack, MonadCleveland caps m) => Builder -> m a
+failure :: forall a caps m. (HasCallStack, MonadCleveland caps m) => Doc -> m a
 failure msg = do
   withCap getMiscCap \cap -> cmiFailure cap msg
 
 -- | Fails the test with the given error message if the given condition is false.
-assert :: (HasCallStack, MonadCleveland caps m) => Bool -> Builder -> m ()
+assert :: (HasCallStack, MonadCleveland caps m) => Bool -> Doc -> m ()
 assert b errMsg =
   unless b $ failure errMsg
 
@@ -119,9 +119,9 @@
       ]
 
 -- | Fails the test if the `Maybe` is `Nothing`, otherwise returns the value in the `Just`.
-evalJust :: (HasCallStack, MonadCleveland caps m) => Builder -> Maybe a -> m a
+evalJust :: (HasCallStack, MonadCleveland caps m) => Doc -> Maybe a -> m a
 evalJust err = maybe (failure err) pure
 
 -- | Fails the test if the `Either` is `Left`, otherwise returns the value in the `Right`.
-evalRight :: (HasCallStack, MonadCleveland caps m) => (a -> Builder) -> Either a b -> m b
+evalRight :: (HasCallStack, MonadCleveland caps m) => (a -> Doc) -> Either a b -> m b
 evalRight mkErr = either (failure . mkErr) pure
diff --git a/src/Test/Cleveland/Internal/Actions/ExceptionHandling.hs b/src/Test/Cleveland/Internal/Actions/ExceptionHandling.hs
--- a/src/Test/Cleveland/Internal/Actions/ExceptionHandling.hs
+++ b/src/Test/Cleveland/Internal/Actions/ExceptionHandling.hs
@@ -9,7 +9,7 @@
   ) where
 
 import Data.List.NonEmpty qualified as NE
-import Fmt (Builder, build, indentF, unlinesF)
+import Fmt (Doc, build, indentF, unlinesF)
 
 import Lorentz
   (CustomError(..), ErrorTagMap, IsError, Label, MText, MustHaveErrorArg, errorTagToMText)
@@ -71,7 +71,7 @@
   where
     -- Collect descriptions of all failed predicates
     -- Note that 'Nothing' signifies success here, and Just is a failure description.
-    go :: TransferFailurePredicate -> Maybe Builder
+    go :: TransferFailurePredicate -> Maybe Doc
     go = \case
       AndPredicate ps -> fmap (fmtExpectedOutcomes "AND") . nonEmpty . mapMaybe go $ toList ps
         -- if all results are successful, i.e. 'Nothing', the result is 'Nothing'
@@ -81,7 +81,7 @@
         | p err -> Nothing
         | otherwise -> Just $ build desc
 
-    fmtExpectedOutcomes :: Builder -> NonEmpty Builder -> Builder
+    fmtExpectedOutcomes :: Doc -> NonEmpty Doc -> Doc
     fmtExpectedOutcomes delimiter = \case
       expectedOutcome :| [] -> expectedOutcome
       expectedOutcomes ->
@@ -179,7 +179,7 @@
 -- > for [1..10] \i -> clarifyErrors ("For i=" +| i |+ "") $
 -- >   askContract i @@== i * 2
 clarifyErrors :: forall caps m a. (MonadCleveland caps m)
-              => Builder -> m a -> m a
+              => Doc -> m a -> m a
 clarifyErrors message action =
   attempt action >>= \case
     Left e -> withCap getMiscCap \cap -> cmiThrow cap $
diff --git a/src/Test/Cleveland/Internal/Actions/Misc.hs b/src/Test/Cleveland/Internal/Actions/Misc.hs
--- a/src/Test/Cleveland/Internal/Actions/Misc.hs
+++ b/src/Test/Cleveland/Internal/Actions/Misc.hs
@@ -9,9 +9,8 @@
   ) where
 
 import Data.Singletons (demote)
-import Fmt (Buildable, Builder, build, indentF, unlinesF, (+|), (|+))
+import Fmt (Buildable, Doc, build, indentF, unlinesF, (+|), (|+))
 import Time (KnownDivRat, Second, Time, toNum)
-import Unsafe qualified (fromIntegral)
 
 import Lorentz (BigMapId, Contract(..), DemoteViewsDescriptor, IsoValue)
 import Lorentz.Bytes
@@ -20,7 +19,7 @@
 import Morley.Client
   (MorleyClientEnv, MorleyOnlyRpcEnv, OperationInfo(..), RunError(..), UnexpectedErrors(..))
 import Morley.Client.Types (ImplicitAddressWithAlias, awaAddress)
-import Morley.Michelson.Runtime (ExecutorError'(..), VotingPowers)
+import Morley.Michelson.Runtime (ExecutorErrorPrim(..), VotingPowers)
 import Morley.Michelson.Runtime.GState (GStateUpdateError(..))
 import Morley.Michelson.Runtime.Import qualified as Runtime
 import Morley.Michelson.Typed (SomeAnnotatedValue)
@@ -255,8 +254,8 @@
     Right () -> pass
     Left e
       | Just (UnexpectedRunErrors [DelegateAlreadyActive]) <- fromPossiblyAnnotatedException e -> pass
-      | Just (EEFailedToApplyUpdates GStateAlreadySetDelegate{} :: ExecutorError' AddressAndAlias)
-        <- fromPossiblyAnnotatedException e
+      | Just (EEFailedToApplyUpdates GStateAlreadySetDelegate{})
+        <- fromPossiblyAnnotatedException @(ExecutorErrorPrim AddressAndAlias) e
       -> pass
       | otherwise -> lift $ cmiThrow (getMiscCap caps) e
 
@@ -339,7 +338,7 @@
 getBigMapValue bmId k =
   getBigMapValueMaybe bmId k >>= \case
     Just v -> pure v
-    Nothing -> failure $ unlinesF @_ @Builder
+    Nothing -> failure $ unlinesF @_ @Doc
       [ "Either:"
       , "  1. A big_map with ID '" +| bmId |+ "' does not exist, or"
       , "  2. It exists, but does not contain the key '" +| k |+ "'."
@@ -379,7 +378,7 @@
   )
   => BigMapId k v -> m (Maybe Natural)
 getBigMapSizeMaybe bmId =
-    fmap (fmap (Unsafe.fromIntegral @Int @Natural . length)) (getAllBigMapValuesMaybe bmId)
+    fmap (fmap length) (getAllBigMapValuesMaybe bmId)
 
 -- | Like 'getBigMapSizeMaybe', but fails the tests instead of returning 'Nothing'.
 getBigMapSize
@@ -388,8 +387,7 @@
   , NiceComparable k, NiceUnpackedValue v
   )
   => BigMapId k v -> m Natural
-getBigMapSize bmId =
-  Unsafe.fromIntegral @Int @Natural . length <$> getAllBigMapValues bmId
+getBigMapSize bmId = length <$> getAllBigMapValues bmId
 
 -- | Get the public key associated with given address.
 -- Fail if given address is not an implicit account.
diff --git a/src/Test/Cleveland/Internal/Actions/TransferFailurePredicate.hs b/src/Test/Cleveland/Internal/Actions/TransferFailurePredicate.hs
--- a/src/Test/Cleveland/Internal/Actions/TransferFailurePredicate.hs
+++ b/src/Test/Cleveland/Internal/Actions/TransferFailurePredicate.hs
@@ -9,14 +9,13 @@
   ) where
 
 import Control.Lens (makeLenses)
-import Fmt (Buildable(..), Builder)
+import Fmt (Buildable(..), Doc)
 
 import Lorentz
   (CustomError(..), ErrorTagMap, IsError, Label, MText, MustHaveErrorArg, errorTagToMText,
   errorToVal, errorToValNumeric, toVal)
 import Lorentz.Constraints
 import Morley.Micheline (Expression, fromExpression, toExpression)
-import Morley.Michelson.Printer.Util (buildRenderDoc)
 import Morley.Michelson.Typed (Constrained(..), SomeConstant)
 import Test.Cleveland.Internal.Abstract
 import Test.Cleveland.Lorentz.Types
@@ -33,7 +32,7 @@
 
 data TransferFailurePredicateDesc = TransferFailurePredicateDesc
   { _tfpdNegated :: Bool
-  , _tfpdDescription :: Builder
+  , _tfpdDescription :: Doc
   }
 
 makeLenses ''TransferFailurePredicateDesc
@@ -46,7 +45,7 @@
 instance IsString TransferFailurePredicateDesc where
   fromString = tfpd . fromString
 
-tfpd :: Builder -> TransferFailurePredicateDesc
+tfpd :: Doc -> TransferFailurePredicateDesc
 tfpd = TransferFailurePredicateDesc False
 
 instance Boolean TransferFailurePredicate where
@@ -66,11 +65,10 @@
     OrPredicate xs -> AndPredicate $ not <$> xs
 
 transferFailureReasonPredicate
-  :: Builder
+  :: Doc
   -> (TransferFailureReason -> Bool)
   -> TransferFailurePredicate
-transferFailureReasonPredicate b p = TransferFailurePredicate (tfpd b)
-  \(TransferFailure _ reason) -> p reason
+transferFailureReasonPredicate b p = TransferFailurePredicate (tfpd b) (p . tfReason)
 
 -- | Asserts that interpretation of a contract failed due to an overflow error.
 shiftOverflow :: TransferFailurePredicate
@@ -102,7 +100,7 @@
 -- (e.g. 'constant', 'customError').
 failedWith :: SomeConstant -> TransferFailurePredicate
 failedWith expectedFailWithVal = failedWithPredicate
-  ("Contract failed with: " <> buildRenderDoc expectedFailWithVal)
+  ("Contract failed with: " <> build expectedFailWithVal)
   (isEq expectedFailWithVal)
   where
     isEq :: SomeConstant -> Expression -> Bool
@@ -110,7 +108,7 @@
 
 -- | Asserts that interpretation of a contract ended with @FAILWITH@, and the
 -- error satisfies the given predicate.
-failedWithPredicate :: Builder -> (Expression -> Bool) -> TransferFailurePredicate
+failedWithPredicate :: Doc -> (Expression -> Bool) -> TransferFailurePredicate
 failedWithPredicate msg valPredicate = transferFailureReasonPredicate msg $ \case
   FailedWith eotv _ -> valPredicate $ case eotv of
     EOTVExpression expr -> expr
@@ -124,7 +122,7 @@
   -> TransferFailurePredicate
 addressIs (toAddress -> expectedAddr) = TransferFailurePredicate
   (tfpd $ "Failure occurred in contract with address: " <> build expectedAddr)
-  \(TransferFailure addrAndAlias _) -> toAddress addrAndAlias == expectedAddr
+  \TransferFailure{..} -> toAddress tfAddressAndAlias == expectedAddr
 
 ----------------------------------------------------------------------------
 -- 'FAILWITH' errors
diff --git a/src/Test/Cleveland/Internal/Actions/View.hs b/src/Test/Cleveland/Internal/Actions/View.hs
--- a/src/Test/Cleveland/Internal/Actions/View.hs
+++ b/src/Test/Cleveland/Internal/Actions/View.hs
@@ -35,7 +35,7 @@
   :: forall name arg ret cp st vd m caps.
     ( MonadCleveland caps m, HasView vd name arg ret
     , NiceParameter arg, NiceViewable ret, NiceStorage ret
-    , NiceParameter cp, KnownSymbol name, HasRPCRepr ret
+    , KnownSymbol name, HasRPCRepr ret
     , T.IsoValue (AsRPC ret))
   => ContractHandle cp st vd -- ^ Contract to call.
   -> Label name -- ^ View name. Use @OverloadedLabels@ syntax.
diff --git a/src/Test/Cleveland/Internal/Client.hs b/src/Test/Cleveland/Internal/Client.hs
--- a/src/Test/Cleveland/Internal/Client.hs
+++ b/src/Test/Cleveland/Internal/Client.hs
@@ -12,12 +12,13 @@
 
 import Control.Lens (_head, each, filtered)
 import Data.Aeson.Text qualified as J
-import Data.Constraint (withDict)
+import Data.Constraint (withDict, (\\))
 import Data.Ratio ((%))
 import Data.Set qualified as Set
+import Data.Singletons (demote)
 import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, secondsToNominalDiffTime)
-import Data.Type.Equality (pattern Refl)
-import Fmt (Buildable(build), Builder, indentF, pretty, unlinesF, (+|), (|+))
+import Data.Typeable (cast)
+import Fmt (Buildable(build), Doc, indentF, pretty, unlinesF, (+|), (|+))
 import System.IO (hFlush)
 import Time (KnownDivRat, Second, Time, sec, threadDelay, toNum, toUnit)
 import Unsafe qualified (fromIntegral)
@@ -35,11 +36,13 @@
 import Morley.Client.App (failOnTimeout, retryOnceOnTimeout)
 import Morley.Client.Full qualified as Client
 import Morley.Client.Logging (logInfo, logWarning)
-import Morley.Client.RPC.Error qualified as RPC (ClientRpcError(..), RunCodeErrors(..))
+import Morley.Client.RPC.Error qualified as RPC
 import Morley.Client.RPC.Types
   (AppliedResult(..), BlockConstants(bcHeader), BlockHeaderNoHash(bhnhLevel, bhnhTimestamp),
-  BlockId(..), IntOpEvent(..), OperationHash, OriginationScript(..),
-  ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize))
+  BlockId(..), EventOperation(..), OperationHash, OriginationScript(..),
+  ProtocolParameters(ProtocolParameters, ppCostPerByte, ppMinimalBlockDelay, ppOriginationSize),
+  WithSource(..))
+import Morley.Client.RPC.Types qualified as RPC
 import Morley.Client.TezosClient.Impl qualified as TezosClient
 import Morley.Client.TezosClient.Types (tceMbTezosClientDataDirL)
 import Morley.Client.Util qualified as Client
@@ -87,7 +90,7 @@
 
 instance Buildable MoneybagConfigurationException where
   build = \case
-    NoMoneybagAddress alias -> unlinesF @_ @Builder
+    NoMoneybagAddress alias -> unlinesF @_ @Doc
       [ "Moneybag alias is not registered in the tezos node: " <> build alias
       , ""
       , "Cleveland's network tests require a special address with plenty of XTZ for"
@@ -98,7 +101,7 @@
       , "  * Use a different alias, supplied via '--cleveland-moneybag-alias'."
       , "  * Import a moneybag account, by supplying its secret key via '--cleveland-moneybag-secret-key'."
       ]
-    TwoMoneybagKeys alias envKey existingAddress -> unlinesF @_ @Builder
+    TwoMoneybagKeys alias envKey existingAddress -> unlinesF @_ @Doc
       [ "Tried to import the secret key supplied via '--cleveland-moneybag-secret-key' and"
       , "associate it with the alias '" +| alias |+ "', but the alias already exists."
       , ""
@@ -254,7 +257,7 @@
     }
   where
     cmiTicketBalance
-      :: forall t. (T.HasNoOp t, T.SingI t)
+      :: forall t. (T.ForbidOp t, T.SingI t)
       => L1Address -> ContractAddress -> T.Value t -> ClientM Natural
     cmiTicketBalance owner ticketer value = liftIO . runMorleyClientM neMorleyClientEnv $
       Client.getTicketBalance owner Client.GetTicketBalance
@@ -307,7 +310,7 @@
           _ExpressionSeq
           . each
           . _ExpressionPrim
-          . filtered (\prim -> prim ^. mpaPrimL == MichelinePrimitive "storage")
+          . filtered (\prim -> prim ^. mpaPrimL == Prim_storage)
           . mpaArgsL
           . _head
 
@@ -439,10 +442,10 @@
       `catch` \case
         err@(RPC.RunCodeErrors errs)
           | Just clientErr <- runErrorsToClientError errs
-          -> throwM =<< exceptionToTransferFailure neMorleyClientEnv clientErr
+          -> throwM =<< exceptionToTransferFailure neMorleyClientEnv [] clientErr
           | otherwise -> throwM err
 
-clientFailure :: Builder -> ClientM a
+clientFailure :: Doc -> ClientM a
 clientFailure = throwM . CustomTestError . pretty
 
 comment :: Text -> ClientM ()
@@ -502,9 +505,8 @@
         , tdMbFee = Nothing
         }
     OpTransferTicket TransferTicketData{..}
-      | T.VTicket ttdTicketTicketer (ttdTicketContents :: T.Value t) ttdTicketAmount <- ttdParameter
-      , Refl <- T.comparabilityImpliesNoNestedBigMaps @t
-      , Refl <- T.comparabilityImpliesNoOp @t
+      | T.VTicket ttdTicketTicketer ttdTicketContents ttdTicketAmount <- ttdParameter
+      , T.Dict <- T.comparableImplies ttdTicketContents
       -> pure $ OpTransferTicket Client.TransferTicketData
         { ttdDestination = L.toAddress $ toL1Address ttdTo
         , ttdMbFee = Nothing
@@ -631,10 +633,10 @@
   OpReveal ops -> pure $ OpReveal ops
   OpDelegation ops -> pure $ OpDelegation ops
 
-intOpEventToContractEvent :: IntOpEvent -> ClientM ContractEvent
-intOpEventToContractEvent IntOpEvent{..} = do
-  T.AsUType (ceType :: T.Notes t) <- either throwM (pure . toTy) $ fromExpression @U.T ioeType
-  cePayload <- case ioePayload of
+intOpEventToContractEvent :: WithSource EventOperation -> ClientM ContractEvent
+intOpEventToContractEvent WithSource{wsOtherData = EventOperation{..}, ..} = do
+  T.AsUType (ceType :: T.Notes t) <- either throwM (pure . toTy) $ fromExpression @U.T eoType
+  cePayload <- case eoPayload of
     Nothing -> pure Nothing
     Just payload -> case fromExpression @(T.Value t) . toExpression $ payload of
       Right value -> pure . Just $ SomeAnnotatedValue ceType value
@@ -646,9 +648,13 @@
           , "Decoding error:"
           , indentF 2 $ build err
           ]
+  ceSource :: ContractAddress <- case wsSource of
+    Constrained ceSource@ContractAddress{} -> pure ceSource
+    Constrained (addr :: KindedAddress kind) ->
+      throwM $ CustomTestError $ "Unexpected event source kind: " <> pretty (demote @kind)
+        \\ addressKindSanity addr
   pure $ ContractEvent
-    { ceSource = ioeSource
-    , ceTag = maybe "" unMText ioeTag
+    { ceTag = maybe "" unMText eoTag
     , ..
     }
   where
@@ -686,8 +692,12 @@
      ContractAddress{} -> AddressAndAlias addr <$> getAliasMaybe env addr
      SmartRollupAddress{} -> pure (AddressAndAlias addr Nothing)
 
-exceptionToTransferFailure :: MorleyClientEnv -> RPC.ClientRpcError -> ClientM TransferFailure
-exceptionToTransferFailure env = \case
+exceptionToTransferFailure
+  :: MorleyClientEnv
+  -> [RPC.OperationResp RPC.WithSource]
+  -> RPC.ClientRpcError
+  -> ClientM TransferFailure
+exceptionToTransferFailure env stack = \case
     RPC.ContractFailed addr expr -> mkTransferFailure addr $ FailedWith (EOTVExpression expr) Nothing
     RPC.BadParameter (MkAddress addr) _ -> mkTransferFailure addr BadParameter
     RPC.EmptyTransaction addr -> mkTransferFailure addr EmptyTransaction
@@ -696,12 +706,35 @@
     internalError -> throwM internalError
     where
       mkTransferFailure :: KindedAddress kind -> TransferFailureReason -> ClientM TransferFailure
-      mkTransferFailure addr e = TransferFailure <$> resolveAddressAndAlias env addr <*> pure e
+      mkTransferFailure addr e = do
+        addr' <- resolveAddressAndAlias env addr
+        pure $ TransferFailure addr' (rpcToCallSeq stack) e
 
+rpcToCallSeq :: [RPC.OperationResp RPC.WithSource] -> CallSequence
+rpcToCallSeq = toCallSeq \case
+  RPC.TransactionOpResp RPC.WithSource{wsOtherData=to@RPC.TransactionOperation{..},..} ->
+    Just . (wsSource,) . CallSequenceOp to . CallSequence <$> popToCallSeq toDestination
+  RPC.TransferTicketOpResp RPC.WithSource{wsOtherData=to@RPC.TransferTicketOperation{..},..} ->
+    Just . (wsSource,) . CallSequenceOp to . CallSequence <$> popToCallSeq ttoDestination
+  RPC.OriginationOpResp RPC.WithSource{..} ->
+    pure $ Just (wsSource, CallSequenceOp wsOtherData mempty)
+  RPC.DelegationOpResp RPC.WithSource{..} ->
+    pure $ Just (wsSource, CallSequenceOp wsOtherData mempty)
+  RPC.RevealOpResp RPC.WithSource{..} ->
+    pure $ Just (wsSource, CallSequenceOp wsOtherData mempty)
+  RPC.EventOpResp RPC.WithSource{..} ->
+    pure $ Just (wsSource, CallSequenceOp wsOtherData mempty)
+  RPC.OtherOpResp _ ->
+    pure Nothing
+
+
 exceptionHandler :: MorleyClientEnv -> ClientM a -> ClientM a
-exceptionHandler env action = try action >>= \case
-  Left err -> exceptionToTransferFailure env err >>= throwM
-  Right res -> return res
+exceptionHandler env action = action `catch` \case
+  se@(SomeException e)
+    | Just err <- cast e -> throwM =<< exceptionToTransferFailure env [] err
+    | Just RPC.ClientRpcErrorWithStack{..} <- cast e
+    -> throwM =<< exceptionToTransferFailure env (toList crewsStack) crewsError
+    | otherwise -> throwM se
 
 resolveSpecificOrDefaultAlias :: SpecificOrDefaultAlias -> ClientM ImplicitAlias
 resolveSpecificOrDefaultAlias (SpecificAlias alias) = pure alias
diff --git a/src/Test/Cleveland/Internal/Exceptions/Annotated.hs b/src/Test/Cleveland/Internal/Exceptions/Annotated.hs
--- a/src/Test/Cleveland/Internal/Exceptions/Annotated.hs
+++ b/src/Test/Cleveland/Internal/Exceptions/Annotated.hs
@@ -11,7 +11,7 @@
 import Data.Dependent.Map qualified as Map
 import Data.GADT.Compare (GCompare(..), GEq(..), GOrdering(..))
 import Data.Typeable (cast, eqT)
-import Fmt (Buildable(..), Builder, build, pretty)
+import Fmt (Buildable(..), Doc, build, pretty)
 import Text.Show qualified as Show (Show(..))
 import Type.Reflection (typeRep)
 
@@ -138,10 +138,10 @@
 -- | Print all annotations from an 'AnnotationMap', given the initial message.
 --
 -- Essentially right-fold using 'displayAnnotation'.
-printAnnotations :: Buildable a => AnnotationMap -> a -> Builder
+printAnnotations :: Buildable a => AnnotationMap -> a -> Doc
 printAnnotations (AnnotationMap annmap) = flip (Map.foldrWithKey go) annmap . build
   where
-    go :: Key t -> Identity t -> Builder -> Builder
+    go :: Key t -> Identity t -> Doc -> Doc
     go Key (Identity a) acc = displayAnnotation a acc
 
 -- | Try to find the given type @t@ in an 'AnnotationMap'.
@@ -167,9 +167,9 @@
 
 -- | Type class for exception annotations.
 class (Show ann, Typeable ann) => ExceptionAnnotation ann where
-  -- | Given an annotation and the error message (as 'Builder'), produce the
+  -- | Given an annotation and the error message (as 'Doc'), produce the
   -- text annotated with the annotation.
-  displayAnnotation :: ann -> Builder -> Builder
+  displayAnnotation :: ann -> Doc -> Doc
 
   -- | Relative priority for sorting annotations. Annotations with higher
   -- priority will be applied first. Default is @0@.
diff --git a/src/Test/Cleveland/Internal/Exceptions/ErrorsClarification.hs b/src/Test/Cleveland/Internal/Exceptions/ErrorsClarification.hs
--- a/src/Test/Cleveland/Internal/Exceptions/ErrorsClarification.hs
+++ b/src/Test/Cleveland/Internal/Exceptions/ErrorsClarification.hs
@@ -9,14 +9,14 @@
   ( module Test.Cleveland.Internal.Exceptions.ErrorsClarification
   ) where
 
-import Fmt (Builder, nameF)
+import Fmt (Doc, nameF)
 
 import Test.Cleveland.Internal.Exceptions.Annotated
 
 -- | Used to add text prefixes to exception messages.
 --
 -- Implementation detail of 'Test.Cleveland.clarifyErrors'.
-newtype ErrorsClarification = ErrorsClarification [Builder]
+newtype ErrorsClarification = ErrorsClarification [Doc]
   deriving stock Show
   deriving newtype Semigroup
 
diff --git a/src/Test/Cleveland/Internal/Pure.hs b/src/Test/Cleveland/Internal/Pure.hs
--- a/src/Test/Cleveland/Internal/Pure.hs
+++ b/src/Test/Cleveland/Internal/Pure.hs
@@ -21,8 +21,7 @@
 import Data.Map qualified as Map
 import Data.Ratio ((%))
 import Data.Set qualified as Set
-import Data.Type.Equality (pattern Refl)
-import Fmt (Buildable(..), Builder, build, pretty, unlinesF, (+|), (|+))
+import Fmt (Buildable(..), Doc, build, nameF, pretty, unlinesF, (+|), (|+))
 import Time (Second, toNum, toUnit)
 
 import Lorentz (Mutez, NiceComparable, pattern DefEpName)
@@ -32,7 +31,7 @@
 import Morley.Client.Types (AddressWithAlias(..))
 import Morley.Michelson.Interpret
   (InterpretError(..), MichelsonFailed(..), MichelsonFailureWithStack(..), ResultStateLogs(..))
-import Morley.Michelson.Runtime hiding (ExecutorOp(..), transfer)
+import Morley.Michelson.Runtime hiding (transfer)
 import Morley.Michelson.Runtime qualified as Runtime
 import Morley.Michelson.Runtime.Dummy
   (dummyLevel, dummyMaxSteps, dummyMinBlockTime, dummyNow, dummyOrigination)
@@ -41,6 +40,7 @@
   gsChainIdL, gsContractAddressAliasesL, gsContractAddressesL, gsImplicitAddressAliasesL,
   gsVotingPowersL, initGState, lookupBalance, toTicketKey)
 import Morley.Michelson.TypeCheck (TcError)
+import Morley.Michelson.TypeCheck qualified as TC
 import Morley.Michelson.Typed
   (BigMapId(..), IsoValue, SingI, SomeAnnotatedValue(..), SomeVBigMap(..), ToT, Value, Value'(..),
   castM, fromVal, toVal)
@@ -95,10 +95,9 @@
 
 instance Buildable TestError where
   build = \case
-    UnexpectedTypeCheckError tcErr ->
-      "Unexpected type check error. Reason: " +| tcErr |+ ""
-    UnexpectedStorageType merr ->
-      "Unexpected storage type.\n" +| merr |+ ""
+    UnexpectedTypeCheckError tcErr -> nameF "Unexpected type check error. Reason" $ build tcErr
+    UnexpectedStorageType merr -> build $
+      TC.UnexpectedTopLevelType TC.TltStorageType merr
     UnexpectedBigMapType bigMapId mismatchError ->
       unlinesF
         [ "A big_map with the ID " +| bigMapId |+ " was found, but it does not have the expected type."
@@ -150,10 +149,9 @@
         OpTransfer TransferData{..} ->
           OpTransfer <$> doTransfer sender tdTo tdAmount tdEntrypoint tdParameter
         OpTransferTicket TransferTicketData{..}
-          | T.VTicket _ (_ :: T.Value t) _ <- ttdParameter
-          , Refl <- T.comparabilityImpliesNoOp @t
-          -> OpTransferTicket <$>
-            doTransfer sender ttdTo zeroMutez ttdEntrypoint ttdParameter
+          | T.VTicket _ val _ <- ttdParameter
+          , T.Dict <- T.comparableImplies val
+          -> OpTransferTicket <$> doTransfer sender ttdTo zeroMutez ttdEntrypoint ttdParameter
         OpReveal{} -> do
           -- We do not care about reveals in our Morley runtime
           return $ OpReveal ()
@@ -302,7 +300,7 @@
           \\ rpcStorageScopeEvi @t
 
     cmiTicketBalance
-      :: forall t. (T.HasNoOp t, T.Comparable t)
+      :: forall t. (T.Comparable t)
       => L1Address -> ContractAddress -> T.Value t -> PureM Natural
     cmiTicketBalance (Constrained owner) ticketer value = case owner of
       ContractAddress{} -> do
@@ -345,7 +343,7 @@
         seedInt = os2ip seedBytes
         keyTypes = filter (/= KeyTypeBLS) [minBound..]
         keyType = keyTypes Unsafe.!!
-          (fromIntegralOverflowing $ seedInt `mod` fromIntegral (length keyTypes))
+          (fromIntegralOverflowing $ seedInt `mod` length keyTypes)
         sk = detSecretKey' keyType seedBytes
 
       importSecretKey sk alias
@@ -383,7 +381,8 @@
             resolveRunCodeBigMaps bigMapFinder
       rcParameterT <- tcBm rcParameter
       rcStorageT <- tcBm rcStorage
-      (_, finalStorage) <- either (throwEE . EEInterpreterFailed (toAddress sender)) pure $
+      let liftError = throwEE . ExecutorError mempty .  EEInterpreterFailed (toAddress sender)
+      (_, finalStorage) <- either liftError pure $
         Runtime.runCode
           (Runtime.runCodeParameters contract rcStorageT epc rcParameterT)
             { Runtime.rcAmount = rcAmount
@@ -419,27 +418,35 @@
   Right res -> return res
   where
     exceptionToTransferFailure :: ExecutorError' AddressAndAlias -> PureM TransferFailure
-    exceptionToTransferFailure err = case err of
+    exceptionToTransferFailure err@ExecutorError{..} = case eeError of
       EEZeroTransaction addr -> return $
-        TransferFailure addr EmptyTransaction
+        TransferFailure addr callSeq EmptyTransaction
       EEIllTypedParameter addr _ -> return $
-        TransferFailure addr BadParameter
+        TransferFailure addr callSeq BadParameter
       EEUnexpectedParameterType addr _ -> return $
-        TransferFailure addr BadParameter
+        TransferFailure addr callSeq BadParameter
       EEInterpreterFailed addr (InterpretError{ieFailure=MichelsonFailureWithStack{..}}) ->
-        case mfwsFailed of
-          MichelsonFailedWith val -> return $
-            TransferFailure addr $
-              FailedWith (EOTVTypedValue val) (Just mfwsErrorSrcPos)
-          MichelsonArithError (T.ShiftArithError{}) -> return $
-            TransferFailure addr ShiftOverflow
-          MichelsonArithError (T.MutezArithError errType _ _) -> return $
-            TransferFailure addr $ MutezArithError errType
-          MichelsonGasExhaustion -> return $
-            TransferFailure addr GasExhaustion
+        TransferFailure addr callSeq <$> case mfwsFailed of
+          MichelsonFailedWith val -> pure $ FailedWith (EOTVTypedValue val) (Just mfwsErrorSrcPos)
+          MichelsonArithError (T.ShiftArithError{}) -> pure ShiftOverflow
+          MichelsonArithError (T.MutezArithError errType _ _) -> pure $ MutezArithError errType
+          MichelsonGasExhaustion -> pure GasExhaustion
           _ -> throwM err
       _ -> throwM err
+      where
+        callSeq = pureToCallSeq eeCallStack
 
+pureToCallSeq :: [ExecutorOp] -> CallSequence
+pureToCallSeq = toCallSeq \op -> case op of
+  TransferOp TransferOperation{..} ->
+    Just . (toAddress $ tdSenderAddress toTxData,) . CallSequenceOp op . CallSequence
+      <$> popToCallSeq toDestination
+  OriginateOp OriginationOperation{..} ->
+    pure $ Just (toAddress ooOriginator, CallSequenceOp op mempty)
+  SetDelegateOp SetDelegateOperation{..} ->
+    pure $ Just (toAddress sdoContract, CallSequenceOp op mempty)
+  EmitOp EmitOperation{..} ->
+    pure $ Just (toAddress eoSource, CallSequenceOp op mempty)
 
 getMorleyLogsImpl :: PureM a -> PureM (LogsInfo, a)
 getMorleyLogsImpl action = swap <$> listen action
@@ -490,7 +497,7 @@
   throwM . CustomTestError .
   mappend "Unknown address alias: " . pretty
 
-failure :: forall a. Builder -> PureM a
+failure :: forall a. Doc -> PureM a
 failure = throwM . CustomTestError . pretty
 
 getSecretKey :: ImplicitAddress -> PureM SecretKey
@@ -582,7 +589,8 @@
   where
     extractLogs :: Either ExecutorError (ExecutorRes, a) -> [ScenarioLogs]
     extractLogs = \case
-      Left (EEInterpreterFailed addr InterpretError{..}) -> [ScenarioLogs addr ieLogs]
+      Left (ExecutorError _ (EEInterpreterFailed addr InterpretError{..})) ->
+        [ScenarioLogs addr ieLogs]
       Right (res, _) -> res ^. erInterpretResults <&>
         \(addr, SomeInterpretResult ResultStateLogs{..}) -> ScenarioLogs addr rslLogs
       _ -> []
diff --git a/src/Test/Cleveland/Michelson/Internal/Entrypoints.hs b/src/Test/Cleveland/Michelson/Internal/Entrypoints.hs
--- a/src/Test/Cleveland/Michelson/Internal/Entrypoints.hs
+++ b/src/Test/Cleveland/Michelson/Internal/Entrypoints.hs
@@ -10,7 +10,7 @@
 
 import Data.Aeson (eitherDecode, encode)
 import Data.Map qualified as Map
-import Fmt (Buildable(..), blockMapF, nameF, pretty, unlinesF)
+import Fmt (Buildable(..), blockMapF, isEmpty, nameF, pretty, unlinesF)
 import Test.HUnit (Assertion, assertFailure)
 import Test.Tasty (TestName, TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
@@ -48,7 +48,7 @@
 instance Buildable EPMismatch where
   build EPComparisonResultOK = "Entrypoints match specificaton"
   build EPMismatch{..} = nameF "Entrypoints do not match specification" $
-    unlinesF $ filter (/=mempty) [extra, missing, typemm]
+    unlinesF $ filter (not . isEmpty) [extra, missing, typemm]
     where
     extra | null epmmExtra = mempty
           | otherwise = nameF "Extraneous entrypoints in the contract" $ blockMapF epmmExtra
diff --git a/src/Test/Cleveland/Tasty/Internal/Report.hs b/src/Test/Cleveland/Tasty/Internal/Report.hs
--- a/src/Test/Cleveland/Tasty/Internal/Report.hs
+++ b/src/Test/Cleveland/Tasty/Internal/Report.hs
@@ -11,8 +11,9 @@
 import Data.Char (isPrint, isSpace)
 import Data.Ix (Ix(inRange))
 import Data.List qualified as List
+import Data.Text (justifyRight)
 import Data.Text.IO.Utf8 qualified as Utf8
-import Fmt (Buildable(build), Builder, indentF, padLeftF, unlinesF, (+|), (|+))
+import Fmt (Buildable(build), Doc, indentF, unlinesF, (+|), (|+))
 import GHC.Stack (SrcLoc(..))
 import System.Directory (makeRelativeToCurrentDirectory)
 import System.IO.Error
@@ -60,7 +61,7 @@
   :: Natural -- ^ The number of source code lines to print before and after the location of the error
   -> CallStack -- ^ The error's callstack
   -> String -- ^ The error message to display below the expression that caused the error
-  -> IO Builder
+  -> IO Doc
 formatError contextLines cstack errMsg = do
   case getLocation cstack of
     Nothing -> pure $ build errMsg
@@ -86,7 +87,7 @@
         <> (srcLineF lineNumberPadding <$> afterLines)
         <> ["", build (prettyCallStack cstack)]
   where
-    handleIOError :: IOError -> IO Builder
+    handleIOError :: IOError -> IO Doc
     handleIOError err =
       if isAlreadyInUseError err || isDoesNotExistError err || isPermissionError err
         then pure $ unlinesF $
@@ -132,33 +133,34 @@
 -- Formatters
 ----------------------------------------------------------------------------
 
-verticalBorder :: Builder
+verticalBorder :: Doc
 verticalBorder = " ┃ "
 
-headerF :: Int -> FilePath -> Builder
+headerF :: Int -> FilePath -> Doc
 headerF lineNumberPadding path =
   indentF lineNumberPadding $
     " ┏━━ " +| path |+ " ━━━"
 
-srcLineF :: Int -> Line -> Builder
+srcLineF :: Int -> Line -> Doc
 srcLineF lineNumberPadding line =
-  padLeftF lineNumberPadding ' ' (lineNumber line) +| verticalBorder +| build (lineText line)
+  justifyRight lineNumberPadding ' ' (show $ lineNumber line)
+     |+ verticalBorder +| build (lineText line)
 
-errorMsgF :: Int -> SrcLoc -> NonEmpty Line -> String -> [Builder]
+errorMsgF :: Int -> SrcLoc -> NonEmpty Line -> String -> [Doc]
 errorMsgF lineNumberPadding loc errorLines errMsg =
   indentF lineNumberPadding . addPadding <$>
     (carets : errLines)
   where
     (startColumn, endColumn) = caretColumns loc errorLines
 
-    addPadding :: Builder -> Builder
+    addPadding :: Doc -> Doc
     addPadding line =
       verticalBorder +| indentF (startColumn - 1) line
 
-    carets :: Builder
+    carets :: Doc
     carets = build $ replicate (endColumn - startColumn) '^'
 
-    errLines :: [Builder]
+    errLines :: [Doc]
     errLines = List.lines errMsg <&> \line ->
       "| " +| build line
 
diff --git a/src/Test/Cleveland/Util.hs b/src/Test/Cleveland/Util.hs
--- a/src/Test/Cleveland/Util.hs
+++ b/src/Test/Cleveland/Util.hs
@@ -68,7 +68,7 @@
 import Data.Text qualified as T
 import Data.Time (NominalDiffTime, secondsToNominalDiffTime)
 import Data.Typeable (typeRep)
-import Fmt (Buildable, Builder, build, pretty, (+|), (|+))
+import Fmt (Buildable, Doc, build, pretty, (+|), (|+))
 import Hedgehog
   (Gen, MonadGen, MonadTest, Property, annotate, evalIO, failure, forAll, property, success,
   tripping, withTests)
@@ -80,8 +80,8 @@
 import Statistics.Types (Estimate(estPoint))
 import Test.HUnit (Assertion, assertFailure)
 import Test.Tasty (TestTree)
-import Test.Tasty.HUnit (testCase)
 import Test.Tasty.Hedgehog (testProperty)
+import Test.Tasty.HUnit (testCase)
 import Text.Hex (decodeHex)
 import Text.Printf (printf)
 import Text.Show qualified
@@ -298,10 +298,10 @@
 -- Pretty-printing
 ----------------------------------------------------------------------------
 
-formatValue :: forall t. SingI t => T.Value t -> Builder
+formatValue :: forall t. SingI t => T.Value t -> Doc
 formatValue v = "" +| build v |+ " of type " +| demote @t |+ ""
 
-formatSomeValue :: (forall t. c t => SingI t) => SomeConstrainedValue c -> Builder
+formatSomeValue :: (forall t. c t => SingI t) => SomeConstrainedValue c -> Doc
 formatSomeValue = foldConstrained formatValue
 
 -- | Derive a 'Show' instance for a type using a custom "show" function.
diff --git a/test/TestSuite/Cleveland/Assertions.hs b/test/TestSuite/Cleveland/Assertions.hs
--- a/test/TestSuite/Cleveland/Assertions.hs
+++ b/test/TestSuite/Cleveland/Assertions.hs
@@ -20,7 +20,7 @@
 
 import Test.Cleveland
 
-import Morley.Util.Interpolate (i)
+import Morley.Util.Interpolate (i, itu)
 import TestSuite.Util (shouldFailWithMessage)
 
 {-# ANN module ("HLint: ignore Reduce duplication" :: Text) #-}
@@ -92,11 +92,13 @@
 test_checkComparesWith_fails =
   testScenario "`checkComparesWith` fails when the comparison fails and prints values" $ scenario do
     checkComparesWith @Int toCardinal 1 elem (pretty . fmap toOrdinal) [2, 3]
-      & shouldFailWithMessage [i|
-━━ lhs ━━
-One
-━━ rhs ━━
-[Second,Third]|]
+      & shouldFailWithMessage [itu|
+          Failed
+          ━━ lhs ━━
+          One
+          ━━ rhs ━━
+          [Second, Third]
+          |]
   where
     toCardinal = \case
       1 -> "One"
diff --git a/test/TestSuite/Cleveland/Entrypoints.hs b/test/TestSuite/Cleveland/Entrypoints.hs
--- a/test/TestSuite/Cleveland/Entrypoints.hs
+++ b/test/TestSuite/Cleveland/Entrypoints.hs
@@ -26,7 +26,7 @@
             Ty (TOr do1 do1 (Ty TInt n)
                  (Ty (TPair n n n n (Ty TInt n) (Ty TInt n)) n)) n) n
         , contractStorage = Ty TUnit n
-        , contractCode = []
+        , contractCode = SeqEx []
         , entriesOrder = def
         , contractViews = def
         }
diff --git a/test/TestSuite/Cleveland/ExpectFailure.hs b/test/TestSuite/Cleveland/ExpectFailure.hs
--- a/test/TestSuite/Cleveland/ExpectFailure.hs
+++ b/test/TestSuite/Cleveland/ExpectFailure.hs
@@ -13,7 +13,7 @@
 
 import Lorentz as L hiding (comment)
 
-import Fmt (Builder, jsonListF', pretty, unlinesF)
+import Fmt (Doc, listF', nameF, pretty)
 import Hedgehog (Gen, Property, PropertyT, forAllWith, property)
 import Hedgehog.Gen qualified as Gen
 import Test.Tasty (TestTree, testGroup)
@@ -25,8 +25,8 @@
 import Morley.Util.Interpolate (it)
 import Test.Cleveland
 import Test.Cleveland.Internal.Abstract
-  (AddressAndAlias(..), ExpressionOrTypedValue(..), GenericTestError(..), TransferFailure(..),
-  TransferFailureReason(..))
+  (AddressAndAlias(..), CallSequence, ExpressionOrTypedValue(..), GenericTestError(..),
+  TransferFailure(..), TransferFailureReason(..))
 import Test.Cleveland.Internal.Actions (TransferFailurePredicate(..))
 import Test.Cleveland.Internal.Exceptions
 import Test.Cleveland.Util (failedTest, fromHex)
@@ -156,7 +156,7 @@
                 annotateExceptions (ScenarioBranchName ["a"]) $
                   addCallStack $
                     annotateExceptions (ScenarioBranchName ["b"]) $
-                      throwM $ TransferFailure (AddressAndAlias [ta|tz1fsFpWk691ncq1xwS62dbotECB67B13gfC|] Nothing) BadParameter
+                      throwM $ TransferFailure (AddressAndAlias [ta|tz1fsFpWk691ncq1xwS62dbotECB67B13gfC|] Nothing) fcs BadParameter
 
     res <- attempt @TransferFailure action
 
@@ -273,20 +273,16 @@
 
           forM_ ps (isFlattened predicate)
 
-    showPredicate :: TransferFailurePredicate -> Builder
+    showPredicate :: TransferFailurePredicate -> Doc
     showPredicate = \case
       TransferFailurePredicate{} ->
         "TransferFailurePredicate (TransferFailurePredicateDesc  \"\" (const True))"
       AndPredicate ps ->
-        pretty $ unlinesF
-          [ "AndPredicate"
-          , jsonListF' showPredicate ps
-          ]
+        pretty $ nameF "AndPredicate" $
+          listF' showPredicate ps
       OrPredicate ps ->
-        pretty $ unlinesF
-          [ "OrPredicate"
-          , jsonListF' showPredicate ps
-          ]
+        pretty $ nameF "OrPredicate" $
+          listF' showPredicate ps
 
     genTransferFailurePredicate :: Gen TransferFailurePredicate
     genTransferFailurePredicate =
@@ -322,12 +318,12 @@
 
 impl_test_AndPredicate_succeeds_if_all_conditions_hold conv =
   testScenario "AndPredicate succeeds if all conditions hold" $ scenario do
-    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) $ FailedWith (conv $ toVal @Integer 1) Nothing
+    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) fcs $ FailedWith (conv $ toVal @Integer 1) Nothing
     checkTransferFailure err $ failedWith (constant @Integer 1) && addressIs genesisAddress1
 
 impl_test_OrPredicate_succeeds_if_any_condition_holds conv =
   testScenario "AndPredicate succeeds if any condition holds" $ scenario do
-    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) $ FailedWith (conv $ toVal @Integer 1) Nothing
+    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) fcs $ FailedWith (conv $ toVal @Integer 1) Nothing
     checkTransferFailure err $
       failedWith (constant @Integer 1) ||
       failedWith (constant @Integer 2) ||
@@ -335,7 +331,7 @@
 
 impl_test_AndPredicate_fails_if_any_condition_fails conv =
   testScenario "AndPredicate succeeds if all conditions hold" $ scenario do
-    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) $ FailedWith (conv $ toVal @Integer 1) Nothing
+    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) fcs $ FailedWith (conv $ toVal @Integer 1) Nothing
 
     checkTransferFailure err
       ( failedWith (constant @Integer 1) &&
@@ -357,7 +353,7 @@
 
 impl_test_OrPredicate_fails_if_all_conditions_fail conv =
   testScenario "AndPredicate succeeds if all conditions hold" $ scenario do
-    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) $ FailedWith (conv $ toVal @Integer 1) Nothing
+    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) fcs $ FailedWith (conv $ toVal @Integer 1) Nothing
 
     checkTransferFailure err
       ( failedWith (constant @Integer 2) ||
@@ -381,7 +377,7 @@
 
 impl_test_checkTransferFailure_shows_only_failing_predicates conv =
   testScenario "checkTransferFailure shows only failing predicates" $ scenario do
-    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) $ FailedWith (conv $ toVal @Integer 1) Nothing
+    let err = TransferFailure (AddressAndAlias genesisAddress1 Nothing) fcs $ FailedWith (conv $ toVal @Integer 1) Nothing
 
     checkTransferFailure err
       ( (failedWith (constant @Integer 1) && failedWith (constant @Integer 2)) &&
@@ -409,3 +405,7 @@
 But these conditions were not met.
 Actual transfer error:
   Contract: #{genesisAddress1} failed with: 1|]
+
+-- | Fake contract call sequence.
+fcs :: CallSequence
+fcs = mempty
diff --git a/test/TestSuite/Cleveland/FailureSequence.hs b/test/TestSuite/Cleveland/FailureSequence.hs
new file mode 100644
--- /dev/null
+++ b/test/TestSuite/Cleveland/FailureSequence.hs
@@ -0,0 +1,171 @@
+-- SPDX-FileCopyrightText: 2023 Oxhead Alpha
+-- SPDX-License-Identifier: LicenseRef-MIT-OA
+
+{-# LANGUAGE QualifiedDo, NoApplicativeDo #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+
+module TestSuite.Cleveland.FailureSequence
+  ( test_FailureSequence
+  , test_FailureTree
+  ) where
+
+import Lorentz qualified as L
+import Lorentz.Instr as L
+import Lorentz.Macro as L
+
+import Test.Tasty (TestTree)
+
+import Morley.Michelson.Typed (untypeValueOptimized)
+import Morley.Michelson.Untyped qualified as U
+import Morley.Tezos.Crypto.Util (encodeBase58Check)
+import Morley.Util.Interpolate (itu)
+import Test.Cleveland
+import Test.Cleveland.Internal.Abstract (Sender(..), senderL)
+import TestSuite.Util
+import TestSuite.Util.Contracts (inContractsDir)
+
+test_FailureSequence :: TestTree
+test_FailureSequence =
+  testScenario "Prints contract call sequence on failure" $ scenario do
+    testContract <- importContract @Integer @Natural @() $
+      inContractsDir "call_self_several_times_then_fail_in_view.tz"
+    contractHndl <- originate "Test failure call sequence" 0 testContract [tz|100u|]
+    Sender (toAddress -> senderAddr) <- Prelude.view senderL
+
+    let contractAddr = toAddress contractHndl
+
+    msg <- ifEmulation
+      (pure [itu|
+        Call chain:
+        - Transfer to #{contractAddr} entrypoint <default> from
+          #{senderAddr} with parameter '9' and amount 0 μꜩ
+        - Transfer to #{contractAddr} entrypoint <default> from
+          #{contractAddr} with parameter '8' and amount 1 μꜩ
+        - Transfer to #{contractAddr} entrypoint <default> from
+          #{contractAddr} with parameter '7' and amount 1 μꜩ
+        - Transfer to #{contractAddr} entrypoint <default> from
+          #{contractAddr} with parameter '6' and amount 1 μꜩ
+
+        |])
+      (pure [itu|
+        Call chain:
+        - Transaction with amount: 0 μꜩ, destination:
+          #{contractAddr}, and parameter:
+          entrypoint: default, value: 9
+        - Transaction with amount: 1 μꜩ, destination:
+          #{contractAddr}, and parameter:
+          entrypoint: default, value: 8
+        - Transaction with amount: 1 μꜩ, destination:
+          #{contractAddr}, and parameter:
+          entrypoint: default, value: 7
+        - Transaction with amount: 1 μꜩ, destination:
+          #{contractAddr}, and parameter:
+          entrypoint: default, value: 6
+
+        |])
+
+    transfer contractHndl (calling def 9) &
+      shouldFailWithMessage msg
+
+test_FailureTree :: TestTree
+test_FailureTree =
+  testScenario "Prints only the last branch of the call tree on failure" $ scenario do
+    (callingSelf, callingOther, callingTree) <- inBatch $
+      (,,) <$> (L.toContractRef <$> originate "CallingSelf" () callingSelfCt)
+           <*> (L.toContractRef <$> originate "CallingOther" () callingOtherCt)
+           <*> (originate "CallingTree" () callingTreeCt)
+    Sender (toAddress -> senderAddr) <- Prelude.view senderL
+
+    let selfBs = formatAddr $ toAddress callingSelf
+        otherBs = formatAddr $ toAddress callingOther
+        -- annoyingly, address is passed as bytes, and when we get it as
+        -- Expression from network, it's like this.
+        formatAddr = encodeBase58Check . unBytes . untypeValueOptimized . L.toVal
+        unBytes = \case
+          U.ValueBytes (U.InternalByteString bs) -> bs
+          _ -> error "impossible"
+        callingTreeAddr = toAddress callingTree
+        callingSelfAddr = toAddress callingSelf
+        callingOtherAddr = toAddress callingOther
+
+    msg <- ifEmulation
+      (pure [itu|
+        Call chain:
+        - Transfer to #{callingTreeAddr} entrypoint <default> from
+          #{senderAddr} with parameter
+            Pair
+              "#{callingSelfAddr}"
+              "#{callingOtherAddr}"
+          and amount 0 μꜩ
+        - Transfer to #{callingSelfAddr} entrypoint <default> from
+          #{callingTreeAddr} with parameter '-1' and amount 0 μꜩ
+
+        |])
+      (pure [itu|
+        Call chain:
+        - Transaction with amount: 0 μꜩ, destination:
+          #{callingTreeAddr}, and parameter:
+          entrypoint: default, value:
+          [#{selfBs}, #{otherBs}]
+        - Transaction with amount: 0 μꜩ, destination:
+          #{callingSelfAddr}, and parameter:
+          entrypoint: default, value: -1
+
+        |])
+
+    addr <- newFreshAddress auto
+
+    inBatch (transfer addr [tz|100u|] *> transfer callingTree (calling def (callingSelf, callingOther))) &
+      shouldFailWithMessage msg
+
+    transfer callingTree (calling def (callingSelf, callingOther)) &
+      shouldFailWithMessage msg
+
+callingSelfCt :: L.Contract Integer () ()
+callingSelfCt = L.defaultContract L.do
+  car
+  dup
+  dup
+  isNat
+  assertSome [L.mt|foobar|]
+  L.drop
+  ifEq0 (L.drop L.# unit L.# nil L.# pair) L.do
+    push @Integer 1
+    rsub
+    dip L.do
+      selfCalling @Integer CallDefault
+      push 0
+    transferTokens
+    dip nil
+    cons
+    dip unit
+    pair
+
+callingOtherCt :: L.Contract (L.ContractRef Integer) () ()
+callingOtherCt = L.defaultContract L.do
+  car
+  push 0
+  push 5
+  transferTokens
+  dip nil
+  cons
+  dip unit
+  pair
+
+callingTreeCt :: L.Contract (L.ContractRef Integer, L.ContractRef (L.ContractRef Integer)) () ()
+callingTreeCt = L.defaultContract L.do
+  car
+  unpair
+  dup
+  dip L.do
+    dip $ push 0
+    transferTokens
+    dip nil
+  push 0
+  push (-1)
+  transferTokens
+  L.swap
+  dip cons
+  cons
+  dip unit
+  pair
diff --git a/test/TestSuite/Cleveland/Lorentz/Entrypoints.hs b/test/TestSuite/Cleveland/Lorentz/Entrypoints.hs
--- a/test/TestSuite/Cleveland/Lorentz/Entrypoints.hs
+++ b/test/TestSuite/Cleveland/Lorentz/Entrypoints.hs
@@ -108,8 +108,10 @@
   , testContractCoversEntrypoints
       "testContractCoversEntrypoints fails on missing entrypoints"
         (idContract @MyEntrypoints1 @()) [ ( #do123, [utypeQ| int |] ) ]
-      & expectFailure "Entrypoints do not match specification: \
-          \Missing entrypoints in the contract: do123: int"
+      & expectFailure [itu|
+          Entrypoints do not match specification:
+            Missing entrypoints in the contract: do123: int
+          |]
   , testContractCoversEntrypoints
       "testContractCoversEntrypoints handles implicit default entrypoints if those are expected"
         (idContract @MyEntrypoints2 @()) [ ( U.DefEpName, [utypeQ| or (unit %do10) (nat %do11) |] ) ]
@@ -168,8 +170,11 @@
   , testContractMatchesEntrypoints
       "testContractMatchesEntrypoints fails on extraneous entrypoints"
         (idContract @MyEntrypoints1 @()) epSpecPartial
-      & expectFailure "Entrypoints do not match specification:\
-          \ Extraneous entrypoints in the contract: do4: pair (unit %param1) (bytes %param2)"
+      & expectFailure [itu|
+          Entrypoints do not match specification:
+            Extraneous entrypoints in the contract:
+              do4: pair (unit %param1) (bytes %param2)
+          |]
   , testContractMatchesEntrypoints
       "testContractMatchesEntrypoints handles implicit default entrypoints if those are expected"
         (idContract @MyEntrypoints1 @()) $
@@ -183,8 +188,10 @@
   , testContractMatchesEntrypoints
       "testContractMatchesEntrypoints handles explicit default entrypoints if those are unexpected"
         (idContract @MyEntrypoints3 @()) [ (#do33, [utypeQ| int |]) ]
-      & expectFailure "Entrypoints do not match specification: \
-          \Extraneous entrypoints in the contract: <default>: nat"
+      & expectFailure [itu|
+          Entrypoints do not match specification:
+            Extraneous entrypoints in the contract: <default>: nat
+          |]
   , testContractMatchesEntrypoints
       "testContractMatchesEntrypoints fails on type mismatch in default entrypoint"
         (idContract @MyEntrypoints1 @()) (epSpecFull <> [ ( U.DefEpName, [utypeQ| unit |] ) ])
diff --git a/test/TestSuite/Cleveland/MismatchError.hs b/test/TestSuite/Cleveland/MismatchError.hs
--- a/test/TestSuite/Cleveland/MismatchError.hs
+++ b/test/TestSuite/Cleveland/MismatchError.hs
@@ -10,7 +10,7 @@
   , unit_StackEqError
   ) where
 
-import Fmt (pretty)
+import Fmt (pretty, prettyText)
 import Test.Tasty.HUnit (Assertion, (@?=))
 
 import Morley.Michelson.TypeCheck.Error
@@ -36,13 +36,13 @@
 
 unit_StackEqErrorSimple :: Assertion
 unit_StackEqErrorSimple = do
-  pretty @_ @Text (
+  prettyText (
     StackEqError
       MkMismatchError { meExpected = [T.TInt], meActual = [T.TUnit] })
     @?= [itu|
       Stacks not equal:
-      Expected: [int]
-      Actual:   [unit]
+        Expected: [int]
+        Actual:   [unit]
       |]
 
 unit_UnexpectedStorageType :: Assertion
@@ -61,7 +61,7 @@
 
 unit_StackEqError :: Assertion
 unit_StackEqError = do
-  pretty @_ @Text (
+  prettyText (
     StackEqError
       MkMismatchError
         { meExpected =
@@ -74,28 +74,28 @@
           ]})
     @?= [itu|
       Stacks not equal:
-      Expected: [pair int nat bytes, pair nat unit bool]
-      Actual:   [pair unit nat bytes, pair nat int bool, pair nat nat]
-      Mismatch:
-        --- expected +++ actual
-      - [ pair int nat bytes
-      - , pair nat unit bool
-      + [ pair unit nat bytes
-      + , pair nat int bool
-      + , pair nat nat
-        ]
+        Expected: [pair int nat bytes, pair nat unit bool]
+        Actual:   [pair unit nat bytes, pair nat int bool, pair nat nat]
+        Mismatch:
+          --- expected +++ actual
+        - [ pair int nat bytes
+        - , pair nat unit bool
+        + [ pair unit nat bytes
+        + , pair nat int bool
+        + , pair nat nat
+          ]
       |]
 
 expectedSimple :: Text
 expectedSimple = [itu|
-  Unexpected storage type.
-  Expected: int
-  Actual:   unit
+  Unexpected storage type:
+    Expected: int
+    Actual:   unit
   |]
 
 expected :: Text
 expected = [itu|
-  Unexpected storage type.
-  Expected: int
-  Actual:   pair unit nat bytes
+  Unexpected storage type:
+    Expected: int
+    Actual:   pair unit nat bytes
   |]
diff --git a/test/TestSuite/Cleveland/StorageCheck.hs b/test/TestSuite/Cleveland/StorageCheck.hs
--- a/test/TestSuite/Cleveland/StorageCheck.hs
+++ b/test/TestSuite/Cleveland/StorageCheck.hs
@@ -12,7 +12,7 @@
   ) where
 
 import Control.Lens (from, (^?!))
-import Fmt (Buildable(..), GenericBuildable(..))
+import Fmt (Buildable(..))
 import System.FilePath ((</>))
 import Test.Tasty (TestTree)
 
@@ -31,8 +31,7 @@
   , _stField2 :: BigMap Natural MText
   }
   deriving stock (Generic, Show, Eq)
-  deriving anyclass (IsoValue, HasAnnotation)
-  deriving Buildable via GenericBuildable Storage
+  deriving anyclass (IsoValue, HasAnnotation, Buildable)
 
 deriveRPC "Storage"
 
diff --git a/test/TestSuite/Cleveland/StorageWithBigMaps.hs b/test/TestSuite/Cleveland/StorageWithBigMaps.hs
--- a/test/TestSuite/Cleveland/StorageWithBigMaps.hs
+++ b/test/TestSuite/Cleveland/StorageWithBigMaps.hs
@@ -22,9 +22,8 @@
 import Control.Lens (to)
 import Data.Data (Data)
 import Data.Data.Lens (biplate)
-import Fmt (Builder, blockListF, unlinesF)
+import Fmt (Doc, blockListF, unlinesF)
 import Test.Tasty (TestTree, testGroup)
-import Unsafe qualified (fromIntegral)
 
 import Test.Cleveland
 import TestSuite.Util (idContract, saveInStorageContract)
@@ -239,7 +238,7 @@
     length bigMapIds @== 30
 
     assert (bigMapIds == ordNub bigMapIds) $
-      unlinesF @[] @Builder
+      unlinesF @[] @Doc
         [ "Expected all big_maps to have unique IDs, but some duplicates were found:"
         , blockListF (sort bigMapIds)
         ]
@@ -271,15 +270,13 @@
 test_getBigMapSize :: TestTree
 test_getBigMapSize =
   testScenario "getBigMapSize retrieves the correct size" $ scenario do
-    let
-      bmList = sampleList ++ [(5, "d")]
-      expectedSize = Unsafe.fromIntegral @Int @Natural $ length bmList
+    let bmList = sampleList ++ [(5, "d")]
     c <- originate "contract" (mkBigMap bmList) $ idContract @() @(BigMap Integer MText)
 
     bigMapId <- getStorage c
     bmSize <- getBigMapSize bigMapId
 
-    bmSize @== expectedSize
+    bmSize @== length bmList
 
 test_getAllBigMapValues :: TestTree
 test_getAllBigMapValues =
diff --git a/test/TestSuite/Cleveland/Tasty/Report.hs b/test/TestSuite/Cleveland/Tasty/Report.hs
--- a/test/TestSuite/Cleveland/Tasty/Report.hs
+++ b/test/TestSuite/Cleveland/Tasty/Report.hs
@@ -8,7 +8,7 @@
 
 import Data.Char (isSpace)
 import Data.Text qualified as Text
-import Fmt (build, indentF, pretty, unlinesF)
+import Fmt (build, indentF, pretty, prettyText, unlinesF)
 import GHC.Stack (SrcLoc(..), fromCallSiteList)
 import System.FilePath ((</>))
 import Test.Tasty (TestName, TestTree, testGroup)
@@ -16,6 +16,8 @@
 import Test.Tasty.Options (singleOption)
 import Test.Tasty.Runners (Result(resultDescription))
 
+import Morley.Util.Interpolate (itu)
+
 import Test.Cleveland
 import Test.Cleveland.Tasty.Internal.Options (ContextLinesOpt(ContextLinesOpt))
 import Test.Cleveland.Tasty.Internal.Report (formatError)
@@ -66,10 +68,10 @@
       )
       "err msg"
 
-  pretty builder @?=
-    unlines
-      [ "err msg"
-      , ""
-      , "CallStack (from HasCallStack):"
-      , toText ("  expectCustomError_, called at src" </> "invalid" </> "path:1:1 in pkg:Module")
-      ]
+  prettyText builder @?= let path = "src" </> "invalid" </> "path" in
+    [itu|
+      err msg
+
+      CallStack (from HasCallStack):
+        expectCustomError_, called at #{path}:1:1 in pkg:Module
+      |]
diff --git a/test/TestSuite/Cleveland/TicketBalance.hs b/test/TestSuite/Cleveland/TicketBalance.hs
--- a/test/TestSuite/Cleveland/TicketBalance.hs
+++ b/test/TestSuite/Cleveland/TicketBalance.hs
@@ -70,7 +70,7 @@
   assert (x `elem` xs) $ "Expected " +| xs |+ " to contain " +| x |+ ""
 
 ticketerContract
-  :: (NiceComparable t, NiceParameter t, HasAnnotation t)
+  :: (NiceComparable t, NiceParameter t, NiceStorage t, HasAnnotation t)
   => Contract (t, Natural) [Ticket t] ()
 ticketerContract = defaultContract
   $ unpair
diff --git a/test/TestSuite/Util.hs b/test/TestSuite/Util.hs
--- a/test/TestSuite/Util.hs
+++ b/test/TestSuite/Util.hs
@@ -21,11 +21,11 @@
 import Lorentz
 
 import Data.List (isInfixOf)
-import Fmt (Buildable, GenericBuildable(..), build, indentF, pretty, unlinesF)
+import Fmt (Buildable, build, indentF, pretty, unlinesF)
 import Hedgehog (Property)
 import System.Environment (lookupEnv, setEnv, unsetEnv)
-import Test.Tasty.HUnit (Assertion, assertFailure, testCase)
 import Test.Tasty.Hedgehog (testProperty)
+import Test.Tasty.HUnit (Assertion, assertFailure, testCase)
 import Test.Tasty.Options (OptionSet, singleOption)
 import Test.Tasty.Providers (IsTest(run), TestName)
 import Test.Tasty.Runners
@@ -165,5 +165,4 @@
   , ssField2 :: Natural
   }
   deriving stock (Generic, Show, Eq)
-  deriving anyclass (IsoValue)
-  deriving Buildable via GenericBuildable BigMapInStorage
+  deriving anyclass (IsoValue, Buildable)