diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,11 @@
+# Changelog
+
+`fused-effects-th` uses [PVP Versioning][1].
+The changelog is available [on GitHub][2].
+
+## 0.0.0.0
+
+* Initially created.
+
+[1]: https://pvp.haskell.org
+[2]: https://github.com/patrickt/fused-effects-th/releases
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2020, Patrick Thomson
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the copyright holder nor the names of its
+   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 HOLDER 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,33 @@
+# fused-effects-th
+
+[![GitHub CI](https://github.com/fused-effects/fused-effects-th/workflows/CI/badge.svg)](https://github.com/fused-effects/fused-effects-th/actions)
+[![Hackage](https://img.shields.io/hackage/v/fused-effects-th.svg?logo=haskell)](https://hackage.haskell.org/package/fused-effects-th)
+[![BSD-3-Clause license](https://img.shields.io/badge/license-BSD--3--Clause-blue.svg)](LICENSE)
+
+This package provides Template Haskell helpers for fused-effects. The `makeSmartConstructors` splice, given the name of a GADT defining an effect, iterates through the possible constructors and generates functions that construct effects using `send`. That is to say, given the standard `State` type:
+
+``` haskell
+data State s m k where
+  Get :: State s m s
+  Put :: s -> State s m ()
+```
+
+calling `makeSmartConstructors ''State` generates the following code (cleaned up a little from the native Template Haskell output):
+
+``` haskell
+get ::
+  forall s sig m
+  Has (State s) sig m =>
+  m s
+get = send Get
+{-# INLINEABLE get #-}
+ put ::
+  forall s sig m.
+  Has (State s) sig m =>
+  s ->
+  m ()
+put a = send (Put a)
+{-# INLINEABLE put #-}
+```
+
+Bug reports are welcome on the [issue tracker](https://github.com/fused-effects/fused-effects-th/issues).
diff --git a/fused-effects-th.cabal b/fused-effects-th.cabal
new file mode 100644
--- /dev/null
+++ b/fused-effects-th.cabal
@@ -0,0 +1,60 @@
+cabal-version:       2.4
+name:                fused-effects-th
+version:             0.1.0.0
+synopsis:            Template Haskell helpers for fused-effects.
+description:         Template Haskell helpers for fused-effects.
+homepage:            https://github.com/patrickt/fused-effects-th
+bug-reports:         https://github.com/patrickt/fused-effects-th/issues
+license:             BSD-3-Clause
+license-file:        LICENSE
+author:              Patrick Thomson
+maintainer:          Patrick Thomson <patrickt@github.com>
+copyright:           2020 Patrick Thomson
+category:            Control
+build-type:          Simple
+extra-doc-files:     README.md
+                     CHANGELOG.md
+tested-with:         GHC == 8.8.3
+
+source-repository head
+  type:                git
+  location:            https://github.com/patrickt/fused-effects-th.git
+
+common common-options
+  build-depends:       base >= 4.9 && < 4.15
+                     , fused-effects ^>= 1.1
+                     , template-haskell >= 2.12 && < 2.17
+
+  ghc-options:         -Wall
+                       -Wcompat
+                       -Widentities
+                       -Wincomplete-uni-patterns
+                       -Wincomplete-record-updates
+  if impl(ghc >= 8.0)
+    ghc-options:       -Wredundant-constraints
+  if impl(ghc >= 8.2)
+    ghc-options:       -fhide-source-paths
+  if impl(ghc >= 8.4)
+    ghc-options:       -Wmissing-export-lists
+                       -Wpartial-fields
+  if impl(ghc >= 8.8)
+    ghc-options:       -Wmissing-deriving-strategies
+
+  default-language:    Haskell2010
+
+library
+  import:              common-options
+  hs-source-dirs:      src
+  exposed-modules:     Control.Effect.TH
+
+test-suite fused-effects-th-test
+  import:              common-options
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      test
+  main-is:             Spec.hs
+  build-depends:       fused-effects-th
+                     , tasty ^>= 1.3
+                     , tasty-hunit >= 0.10
+  ghc-options:         -threaded
+                       -rtsopts
+                       -with-rtsopts=-N
diff --git a/src/Control/Effect/TH.hs b/src/Control/Effect/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Control/Effect/TH.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Defines splices that cut down on boilerplate associated with declaring new effects.
+module Control.Effect.TH
+  ( makeSmartConstructors,
+  )
+where
+
+import Control.Algebra
+import Control.Monad (join)
+import Data.Char (toLower)
+import Data.Foldable
+import Data.Traversable
+import Language.Haskell.TH as TH
+
+data PerEffect = PerEffect
+  { typeName :: TH.Name,
+    effectTypeVars :: [TH.TyVarBndr],
+    monadTypeVar :: TH.TyVarBndr,
+    forallConstructor :: TH.Con
+  }
+
+data PerDecl = PerDecl
+  { ctorName :: TH.Name,
+    functionName :: TH.Name,
+    ctorArgs :: [TH.Type],
+    returnType :: TH.Type,
+    perEffect :: PerEffect,
+    extraTyVars :: [TyVarBndr]
+  }
+
+-- | Given an effect type, this splice generates functions that create per-constructor request functions.
+--
+-- That is to say, given the standard @State@ type
+--
+-- @
+--   data State s m k where
+--     Get :: State s m s
+--     Put :: s -> State s m ()
+-- @
+--
+-- an invocation of @makeSmartConstructors ''State@ will generate code that looks like
+--
+--
+-- >   get ::
+-- >     forall (s :: Type) sig (m :: Type -> Type).
+-- >     Has (State s) sig m =>
+-- >     m s
+-- >   get = send Get
+-- >   {-# INLINEABLE get #-}
+-- >    put ::
+-- >     forall (s :: Type) sig (m :: Type -> Type).
+-- >     Has (State s) sig m =>
+-- >     s ->
+-- >     m ()
+-- >   put a = send (Put a)
+-- >   {-# INLINEABLE put #-}
+--
+--
+-- The type variables in each declared function signature will appear in the order
+-- they were defined in the effect type.
+--
+makeSmartConstructors :: Name -> TH.DecsQ
+makeSmartConstructors typ =
+  TH.reify typ >>= \case
+    TH.TyConI (TH.DataD _ctx typeName tyvars _kind cons _derive) -> do
+      -- Pick out the `m` argument. We can drop `k` on the floor.
+      (effectTypeVarsWithoutSig, monadTypeVar) <- case reverse tyvars of
+        _cont : monad : rest -> pure (reverse rest, monad)
+        _ -> fail ("Effect types need at least two type arguments: a monad `m` and continuation `k`.")
+      -- Continue, recording the various relevant data from the type in question.
+      let effectTypeVars = effectTypeVarsWithoutSig ++ [TH.PlainTV (mkName "sig")]
+      join <$> traverse (\forallConstructor -> makeDeclaration PerEffect {..}) cons
+    other -> fail ("Can't generate definitions for a non-data-constructor: " <> pprint other)
+
+makeDeclaration :: PerEffect -> TH.DecsQ
+makeDeclaration perEffect@PerEffect {..} = do
+  (names, ctorArgs, returnWithResult, extraTyVars) <- case forallConstructor of
+    TH.ForallC vars _ctx (TH.GadtC names bangtypes returnType) ->
+      pure (names, fmap snd bangtypes, returnType, vars)
+    _ ->
+      fail ("BUG: expected forall-qualified constructor, but didn't get one")
+  returnType <- case returnWithResult of
+    AppT _ final -> pure final
+    _ -> fail ("BUG: Couldn't get a return type out of " <> pprint returnWithResult)
+  fmap join . for names $ \ctorName -> do
+    let downcase = \case
+          x : xs -> toLower x : xs
+          [] -> []
+        functionName = TH.mkName . downcase . TH.nameBase $ ctorName
+    let decl = PerDecl {..}
+    sign <- makeSignature decl
+    func <- makeFunction decl
+    prag <- makePragma decl
+    pure [sign, func, prag]
+
+makePragma :: PerDecl -> TH.DecQ
+makePragma PerDecl {..} =
+  TH.pragInlD functionName TH.Inlinable TH.FunLike TH.AllPhases
+
+makeFunction :: PerDecl -> Q Dec
+makeFunction d =
+  TH.funD (functionName d) [makeClause d]
+
+makeClause :: PerDecl -> ClauseQ
+makeClause PerDecl {..} = TH.clause pats body []
+  where
+    body = TH.normalB [e|send ($(applies))|]
+    pats = fmap TH.varP names
+    applies = foldl' (\e n -> e `appE` varE n) (conE ctorName) names
+    names = fmap (mkName . pure) (take (length ctorArgs) ['a' .. 'z'])
+
+makeSignature :: PerDecl -> TH.DecQ
+makeSignature PerDecl {perEffect = PerEffect {..}, ..} =
+  let sigVar = last effectTypeVars
+      rest = init effectTypeVars
+      getTyVar = \case
+        TH.PlainTV t -> t
+        TH.KindedTV t _ -> t
+      monadName = varT (getTyVar monadTypeVar)
+      invocation = foldl' appT (conT typeName) (fmap (varT . getTyVar) rest)
+      hasConstraint = [t|Has $(parensT invocation) $(varT (mkName "sig")) $(monadName)|]
+      folded = foldr (\a b -> arrowT `appT` pure a `appT` b) (monadName `appT` pure returnType) ctorArgs
+   in TH.sigD functionName (TH.forallT (extraTyVars ++ [sigVar]) (TH.cxt [hasConstraint]) folded)
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,66 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -ddump-splices #-}
+{-# OPTIONS_GHC -Wno-unused-binds #-}
+
+module Main
+  ( main,
+  )
+where
+
+import Control.Carrier.State.Strict (evalState)
+import Control.Effect.State hiding (get, put)
+import Control.Effect.Reader hiding (ask, local)
+import Control.Effect.Writer hiding (tell, listen, censor)
+import Control.Effect.TH
+import Control.Exception (SomeException, try)
+import Data.Either
+import Language.Haskell.TH (runQ)
+import System.IO
+import Test.Tasty
+import Test.Tasty.HUnit
+
+makeSmartConstructors ''State
+makeSmartConstructors ''Reader
+makeSmartConstructors ''Writer
+
+-- Need to ensure that if a constructor introduces a new type variable,
+-- that it is introduced in the corresponding invocation. The question is
+-- where we can put it. Probably before `sig m`.
+
+assertThrows :: String -> IO a -> Assertion
+assertThrows msg go =
+  fmap isLeft (try @SomeException go) >>= assertBool msg
+
+testState :: TestTree
+testState = testCase "Generated State functions" $ do
+  assertEqual "get" (run $ evalState "hello" get) "hello"
+  assertEqual "get-put" (run $ evalState "bad" (put "good" *> get)) "good"
+
+data BadGADT where
+  BadGADT :: BadGADT
+
+testDataErrors :: TestTree
+testDataErrors =
+  testCase "Bad data types" $ do
+    assertThrows "Bool" (runQ (makeSmartConstructors ''Bool))
+    assertThrows "Ill-formed GADT" (runQ (makeSmartConstructors ''BadGADT))
+
+main :: IO ()
+main = do
+  hClose stderr -- silences TH warnings
+  defaultMain $
+    testGroup
+      "Language.Haskell.TH"
+      [ testGroup
+          "Behavior"
+          [ testState
+          ],
+        testGroup
+          "Template Haskell errors"
+          [ testDataErrors
+          ]
+      ]