diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Changelog for hs-opentelemetry-instrumentation-tasty
+
+## 0.0.1.0
+
+- Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Ian Duncan (c) 2021
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Ian Duncan nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,19 @@
+# hs-opentelemetry-instrumentation-tasty
+
+OpenTelemetry instrumentation library for Tasty.
+It creates spans for:
+
+1. Individual test cases
+2. Test groups
+3. Resource setup and teardown
+
+The library should be robust to tests running in parallel.
+
+## Usage
+
+Usage requires:
+
+1. Setting and tearing down a trace provider as normal in your test executable.
+2. Calling `instrumentTestTree` on your `TestTree`.
+
+See the test suite for examples of how to use the library. 
diff --git a/hs-opentelemetry-instrumentation-tasty.cabal b/hs-opentelemetry-instrumentation-tasty.cabal
new file mode 100644
--- /dev/null
+++ b/hs-opentelemetry-instrumentation-tasty.cabal
@@ -0,0 +1,51 @@
+cabal-version: 2.0
+name:          hs-opentelemetry-instrumentation-tasty
+version:       0.1
+
+description:        Please see the README on GitHub at <https://github.com/iand675/hs-opentelemetry/tree/main/instrumentation/tasty#readme>
+homepage:           https://github.com/iand675/hs-opentelemetry#readme
+bug-reports:        https://github.com/iand675/hs-opentelemetry/issues
+author:             Michael Peyton Jones
+maintainer:         me@michaelpj.com
+copyright:          2024 Ian Duncan, Mercury Technologies
+license:            BSD3
+license-file:       LICENSE
+build-type:         Simple
+extra-source-files:
+    README.md
+    ChangeLog.md
+
+source-repository head
+  type: git
+  location: https://github.com/iand675/hs-opentelemetry
+
+library
+  default-language: Haskell2010
+  build-depends:
+    base >=4.7 && <5
+    , hs-opentelemetry-api ^>=0.2
+    , tagged ^>= 0.8
+    , tasty ^>= 1.5
+    , text
+
+  exposed-modules: OpenTelemetry.Instrumentation.Tasty
+  hs-source-dirs:  src
+
+test-suite tests
+  default-language: Haskell2010
+  type:           exitcode-stdio-1.0
+  main-is:        Main.hs
+  build-depends:
+    async
+    , base
+    , containers
+    , hs-opentelemetry-api
+    , hs-opentelemetry-instrumentation-tasty
+    , hs-opentelemetry-sdk
+    , tasty
+    , tasty-hunit
+    , text
+
+  other-modules:  OpenTelemetry.Instrumentation.Tasty.Tests
+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N
+  hs-source-dirs: tests
diff --git a/src/OpenTelemetry/Instrumentation/Tasty.hs b/src/OpenTelemetry/Instrumentation/Tasty.hs
new file mode 100644
--- /dev/null
+++ b/src/OpenTelemetry/Instrumentation/Tasty.hs
@@ -0,0 +1,140 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module OpenTelemetry.Instrumentation.Tasty (instrumentTestTree, instrumentTestTreeWithTracer) where
+
+import Control.Exception (bracket)
+import Data.Tagged (Tagged, retag)
+import Data.Text qualified as T
+import OpenTelemetry.Context (insertSpan, lookupSpan, removeSpan)
+import OpenTelemetry.Context.ThreadLocal (adjustContext, getContext)
+import OpenTelemetry.Trace.Core (Span, SpanStatus (Error, Ok), Tracer, addAttribute, createSpan, defaultSpanArguments, detectInstrumentationLibrary, endSpan, getGlobalTracerProvider, inSpan, makeTracer, setStatus, tracerOptions)
+import Test.Tasty (TestTree, withResource)
+import Test.Tasty.Options (OptionDescription)
+import Test.Tasty.Providers (IsTest (run, testOptions))
+import Test.Tasty.Runners (Outcome (Failure, Success), ResourceSpec (ResourceSpec), Result (Result, resultDescription, resultOutcome), TestTree (After, AskOptions, PlusTestOptions, SingleTest, TestGroup, WithResource))
+
+
+{- | A test case with a wrapper function that can do some IO around the
+test. We use the wrapper to set up spans appropriately.
+-}
+data WrappedTest t = WrappedTest
+  {wrapper :: forall a. IO a -> IO a, innerTest :: t}
+
+
+instance IsTest t => IsTest (WrappedTest t) where
+  run opts (WrappedTest {wrapper, innerTest}) progress =
+    wrapper $ do
+      ctx <- getContext
+      let mspan = lookupSpan ctx
+      res@Result {resultOutcome, resultDescription} <- run opts innerTest progress
+      case mspan of
+        Just s -> do
+          addAttribute s "result.description" (T.pack resultDescription)
+          case resultOutcome of
+            Success -> do
+              setStatus s $ Ok
+            Failure reason -> do
+              setStatus s $ Error $ T.pack $ show reason
+        Nothing -> pure ()
+
+      pure res
+  testOptions = retag (testOptions :: Tagged t [OptionDescription])
+
+
+-- | Transform a 'TestTree' into one that emits spans around tests and test groups.
+instrumentTestTree :: TestTree -> IO TestTree
+instrumentTestTree t = do
+  provider <- getGlobalTracerProvider
+  let tracer = makeTracer provider $detectInstrumentationLibrary tracerOptions
+  pure $ instrumentTestTreeWithTracer tracer t
+
+
+-- | See 'instrumentTestTree'.
+instrumentTestTreeWithTracer :: Tracer -> TestTree -> TestTree
+instrumentTestTreeWithTracer tracer = instrumentTestTree' tracer (pure Nothing)
+
+
+instrumentTestTree'
+  :: Tracer
+  -> IO (Maybe Span)
+  -> TestTree
+  -> TestTree
+instrumentTestTree' tracer = go
+  where
+    -- See Note [Test parallelism] for why we pass around 'getParentSpan'
+    go :: IO (Maybe Span) -> TestTree -> TestTree
+    go getParentSpan = \case
+      TestGroup name tests ->
+        -- We use 'withResource' to associate the creation and destruction of the
+        -- group span with the beginning and end of the group itself. This way
+        -- 'tasty' manages the lifetime of the span for us.
+        withResource
+          (mkSpan (T.pack name))
+          (\s -> endSpan s Nothing)
+          $ \getGroupSpan ->
+            let getParentSpan' = Just <$> getGroupSpan
+            in TestGroup name (fmap (go getParentSpan') tests)
+      SingleTest name t ->
+        SingleTest name $
+          WrappedTest {wrapper = withNamedSpan name, innerTest = t}
+      WithResource (ResourceSpec acquire release) f ->
+        -- Add spans for resource acquisition and release
+        -- Nit: currently we don't create a span for the top-level itself, so
+        -- if you acquire outside a test group then the spans will be detached.
+        -- We could add a span for the top level, although it's maybe a little odd.
+        let newResourceSpec = ResourceSpec (withNamedSpan "acquire" acquire) (fmap (withNamedSpan "release") release)
+        in WithResource newResourceSpec (go' . f)
+      PlusTestOptions modifier t -> PlusTestOptions modifier (go' t)
+      AskOptions f -> AskOptions (go' . f)
+      After d e t -> After d e $ go' t
+      where
+        go' = go getParentSpan
+        mkSpan name = do
+          ctx <- getContext
+          -- See Note [Test parallelism]
+          parentSpan <- getParentSpan
+          -- This does not modify the thread-local context, just locally
+          ctx' <- case parentSpan of
+            Just s -> pure $ insertSpan s ctx
+            Nothing -> pure ctx
+          createSpan tracer ctx' name defaultSpanArguments
+        withNamedSpan :: String -> (forall a. IO a -> IO a)
+        withNamedSpan name act = do
+          -- See Note [Test parallelism]
+          parentSpan <- getParentSpan
+          let wrapper = case parentSpan of
+                Just ps -> withParentSpan ps
+                Nothing -> id
+          wrapper $ inSpan tracer (T.pack name) defaultSpanArguments act
+
+
+-- Possibly should upstream this to the SDK?
+
+{- | Given a span, produces a wrapper function that sets the given span
+as the installed span in the context.
+-}
+withParentSpan :: Span -> (forall a. IO a -> IO a)
+withParentSpan parentSpan act =
+  bracket setup teardown $ \_ -> act
+  where
+    setup = do
+      ctx <- getContext
+      adjustContext (insertSpan parentSpan)
+      pure (lookupSpan ctx, ctx)
+    teardown (originalParentSpan, _ctx) = do
+      adjustContext $ \ctx -> maybe (removeSpan ctx) (`insertSpan` ctx) originalParentSpan
+
+{- Note [Test parallelism]
+Tasty runs tests in parallel by default, and we don't want to disturb that.
+However, that means that any individual test case may be running on a random thread at tasty's
+discretion, and so we can't rely on the thread-local context to link up spans.
+
+Our solution is just to track (an action to access) the parent span manually as we traverse
+the tree, so we can connect them up manually.
+-}
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Main (main) where
+
+import OpenTelemetry.Instrumentation.Tasty.Tests qualified
+import Test.Tasty (TestTree, defaultMain, testGroup)
+
+
+main :: IO ()
+main = defaultMain tests
+
+
+tests :: TestTree
+tests =
+  testGroup "Tasty instrumentation" $
+    [OpenTelemetry.Instrumentation.Tasty.Tests.tests]
diff --git a/tests/OpenTelemetry/Instrumentation/Tasty/Tests.hs b/tests/OpenTelemetry/Instrumentation/Tasty/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/OpenTelemetry/Instrumentation/Tasty/Tests.hs
@@ -0,0 +1,194 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module OpenTelemetry.Instrumentation.Tasty.Tests (tests) where
+
+import Control.Concurrent (newEmptyMVar, putMVar, takeMVar)
+import Control.Concurrent.Async (async)
+import Control.Exception (bracket)
+import Data.Functor (void)
+import Data.IORef (atomicModifyIORef, newIORef, readIORef)
+import Data.Map (Map)
+import Data.Map qualified as Map
+import Data.Maybe (fromMaybe)
+import Data.Set qualified as Set
+import Data.Text (Text)
+import OpenTelemetry.Instrumentation.Tasty (instrumentTestTree)
+import OpenTelemetry.Processor.Span (ShutdownResult (ShutdownSuccess), SpanProcessor, spanProcessorForceFlush, spanProcessorOnEnd, spanProcessorOnStart, spanProcessorShutdown, pattern SpanProcessor)
+import OpenTelemetry.Trace (ImmutableSpan (ImmutableSpan, spanName, spanParent), createTracerProvider, defaultSpanArguments, emptyTracerProviderOptions, getGlobalTracerProvider, inSpan, makeTracer, setGlobalTracerProvider, shutdownTracerProvider, tracerOptions)
+import OpenTelemetry.Trace.Core (unsafeReadSpan)
+import Test.Tasty (DependencyType (AllFinish), TestTree, sequentialTestGroup, testGroup, withResource)
+import Test.Tasty.HUnit (testCase, (@?=))
+import Test.Tasty.Ingredients (tryIngredients)
+import Test.Tasty.Ingredients.Basic (Quiet (Quiet), consoleTestReporter)
+import Test.Tasty.Options (setOption)
+
+
+tests :: TestTree
+-- each of these tests sets and tears down the global tracer provider,
+-- so they have to run sequentially
+tests =
+  sequentialTestGroup
+    "OpenTelemetry.Instrumentation.Tasty"
+    AllFinish
+    [ basic
+    , simpleNesting
+    , branching
+    , testWithSpan
+    , parallelism
+    , resources
+    ]
+
+
+basic :: TestTree
+basic = testCase "basic" $ do
+  (_, trees) <- spanTrees $ do
+    testTree <- instrumentTestTree $ testCase "hello" $ pure ()
+    runTests $ testTree
+  trees @?= [Leaf "hello"]
+
+
+simpleNesting :: TestTree
+simpleNesting = testCase "nested groups make a simple tree" $ do
+  (_, trees) <- spanTrees $ do
+    testTree <-
+      instrumentTestTree $
+        testGroup
+          "g1"
+          [ testGroup "g2" [testCase "t1" (pure ())]
+          ]
+    runTests $ testTree
+  trees @?= [Branch "g1" [Branch "g2" [Leaf "t1"]]]
+
+
+branching :: TestTree
+branching = testCase "nested groups make a branching tree" $ do
+  (_, trees) <- spanTrees $ do
+    testTree <-
+      instrumentTestTree $
+        testGroup
+          "g1"
+          [ testGroup "g2" [testCase "t1" (pure ()), testCase "t2" (pure ())]
+          , testGroup "g3" [testCase "t3" (pure ())]
+          ]
+    runTests $ testTree
+  trees @?= [Branch "g1" [Branch "g2" [Leaf "t1", Leaf "t2"], Branch "g3" [Leaf "t3"]]]
+
+
+testWithSpan :: TestTree
+testWithSpan = testCase "test that has a span itself" $ do
+  (_, trees) <- spanTrees $ do
+    testTree <- instrumentTestTree $ testCase "hello" $ do
+      tp <- getGlobalTracerProvider
+      let tracer = makeTracer tp "test" tracerOptions
+      inSpan tracer "inner" defaultSpanArguments $ pure ()
+    runTests $ testTree
+  trees @?= [Branch "hello" [Leaf "inner"]]
+
+
+parallelism :: TestTree
+parallelism = testCase "parallelism works" $ do
+  block <- newEmptyMVar
+  (_, trees) <- spanTrees $ do
+    testTree <-
+      instrumentTestTree $
+        testGroup
+          "g1"
+          -- Force t1 to wait for t2 before it can even begin, so we
+          -- should definitely not start the span for t1 until then
+          [ testGroup
+              "g2"
+              [ withResource (takeMVar block) (const $ pure ()) $ \_ ->
+                  testCase "t1" (pure ())
+              ]
+          , testGroup "g3" [testCase "t2" (putMVar block ())]
+          ]
+    runTests $ testTree
+  trees @?= [Branch "g1" [Branch "g2" [Leaf "acquire", Leaf "t1", Leaf "release"], Branch "g3" [Leaf "t2"]]]
+
+
+resources :: TestTree
+resources = testCase "spans for resource setup and teardown" $ do
+  (_, trees) <- spanTrees $ do
+    tp <- getGlobalTracerProvider
+    let tracer = makeTracer tp "test" tracerOptions
+    let acquire = inSpan tracer "myAcquire" defaultSpanArguments $ pure ()
+    let release _ = inSpan tracer "myRelease" defaultSpanArguments $ pure ()
+    testTree <- instrumentTestTree $ withResource acquire release $ \_ -> testCase "hello" $ pure ()
+    runTests $ testTree
+  trees @?= [Leaf "hello", Branch "acquire" [Leaf "myAcquire"], Branch "release" [Leaf "myRelease"]]
+
+
+data Tree a = Branch a (Set.Set (Tree a)) | Leaf a
+  deriving stock (Show, Eq, Ord)
+
+
+spanTrees :: IO a -> IO (a, Set.Set (Tree Text))
+spanTrees act = do
+  (processor, readSpans) <- recordingProcessor
+  res <- bracket (setup processor) shutdownTracerProvider $ \_ -> do
+    act
+  spans <- readSpans
+  trees <- spansToTrees spans
+  pure (res, Set.fromList trees)
+  where
+    setup processor = do
+      tp <- createTracerProvider [processor] emptyTracerProviderOptions
+      setGlobalTracerProvider tp
+      pure tp
+
+
+toChildMap :: [ImmutableSpan] -> ([Text], Map Text [Text]) -> IO ([Text], Map Text [Text])
+toChildMap [] acc = pure acc
+toChildMap (ImmutableSpan {spanParent, spanName} : spans) (accRoots, accChildren) = case spanParent of
+  Just parent -> do
+    ImmutableSpan {spanName = parentName} <- unsafeReadSpan parent
+    let existingChildren = fromMaybe mempty $ Map.lookup parentName accChildren
+    toChildMap spans (accRoots, Map.insert parentName (existingChildren ++ [spanName]) accChildren)
+  Nothing -> toChildMap spans (spanName : accRoots, accChildren)
+
+
+toTree :: (Ord a) => Map a [a] -> a -> Tree a
+toTree childMap node = case Map.lookup node childMap of
+  Nothing -> Leaf node
+  Just children ->
+    if null children
+      then Leaf node
+      else Branch node $ Set.fromList $ fmap (toTree childMap) children
+
+
+spansToTrees :: [ImmutableSpan] -> IO [Tree Text]
+spansToTrees spans = do
+  (roots, childMap) <- toChildMap spans mempty
+  let trees = fmap (toTree childMap) roots
+  pure trees
+
+
+recordingProcessor :: IO (SpanProcessor, IO [ImmutableSpan])
+recordingProcessor = do
+  spans <- newIORef []
+
+  let processor =
+        SpanProcessor
+          { spanProcessorOnStart = mempty
+          , spanProcessorOnEnd = \spanRef -> do
+              immutableSpan <- readIORef spanRef
+              atomicModifyIORef spans $ \soFar -> (soFar ++ [immutableSpan], ())
+          , spanProcessorShutdown = async $ pure ShutdownSuccess
+          , spanProcessorForceFlush = mempty
+          }
+
+  setGlobalTracerProvider
+    =<< createTracerProvider [processor] emptyTracerProviderOptions
+
+  pure (processor, readIORef spans)
+
+
+runTests :: TestTree -> IO ()
+runTests t = case tryIngredients [consoleTestReporter] (setOption (Quiet True) mempty) t of
+  Just act -> void act
+  Nothing -> error "no ingredient"