diff --git a/hs-bindgen/app/HsBindgen/Cli/GenTests.hs b/hs-bindgen/app/HsBindgen/Cli/GenTests.hs
index eaddf7c67..4ff48ce60 100644
--- a/hs-bindgen/app/HsBindgen/Cli/GenTests.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/GenTests.hs
@@ -57,5 +57,5 @@ parseOpts =
 exec :: GlobalOpts -> Opts -> IO ()
 exec GlobalOpts{..} Opts{..} = do
     let artefact = writeTests output
-        bindgenConfig = toBindgenConfig config uniqueId def
+        bindgenConfig = toBindgenConfig config uniqueId def def
     void $ hsBindgen tracerConfig bindgenConfig inputs artefact
diff --git a/hs-bindgen/app/HsBindgen/Cli/Info/IncludeGraph.hs b/hs-bindgen/app/HsBindgen/Cli/Info/IncludeGraph.hs
index cbc966ebd..a2cd73276 100644
--- a/hs-bindgen/app/HsBindgen/Cli/Info/IncludeGraph.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/Info/IncludeGraph.hs
@@ -64,5 +64,5 @@ parseOutput' = strOption $ mconcat [
 exec :: GlobalOpts -> Opts -> IO ()
 exec GlobalOpts{..} Opts{..} = do
     let artefact = writeIncludeGraph output
-        bindgenConfig = toBindgenConfig config uniqueId baseModuleName
+        bindgenConfig = toBindgenConfig config uniqueId baseModuleName def
     void $ hsBindgen tracerConfig bindgenConfig inputs artefact
diff --git a/hs-bindgen/app/HsBindgen/Cli/Info/UseDeclGraph.hs b/hs-bindgen/app/HsBindgen/Cli/Info/UseDeclGraph.hs
index f1c3823dd..613b6f478 100644
--- a/hs-bindgen/app/HsBindgen/Cli/Info/UseDeclGraph.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/Info/UseDeclGraph.hs
@@ -64,5 +64,5 @@ parseOutput' = strOption $ mconcat [
 exec :: GlobalOpts -> Opts -> IO ()
 exec GlobalOpts{..} Opts{..} = do
     let artefact = writeUseDeclGraph output
-        bindgenConfig = toBindgenConfig config uniqueId baseModuleName
+        bindgenConfig = toBindgenConfig config uniqueId baseModuleName def
     void $ hsBindgen tracerConfig bindgenConfig inputs artefact
diff --git a/hs-bindgen/app/HsBindgen/Cli/Internal/Frontend.hs b/hs-bindgen/app/HsBindgen/Cli/Internal/Frontend.hs
index 5d80eec76..418e8904b 100644
--- a/hs-bindgen/app/HsBindgen/Cli/Internal/Frontend.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/Internal/Frontend.hs
@@ -14,6 +14,7 @@ module HsBindgen.Cli.Internal.Frontend (
   ) where
 
 import Control.Monad.IO.Class
+import Data.Default (Default (..))
 import Options.Applicative hiding (info)
 
 import HsBindgen
@@ -54,5 +55,5 @@ parseOpts =
 exec :: GlobalOpts -> Opts -> IO ()
 exec GlobalOpts{..} Opts{..} = do
     let artefact = ReifiedC >>= liftIO . print
-        bindgenConfig = toBindgenConfig config uniqueId baseModuleName
+        bindgenConfig = toBindgenConfig config uniqueId baseModuleName def
     hsBindgen tracerConfig bindgenConfig inputs artefact
diff --git a/hs-bindgen/app/HsBindgen/Cli/Preprocess.hs b/hs-bindgen/app/HsBindgen/Cli/Preprocess.hs
index ecc17f775..57003aa52 100644
--- a/hs-bindgen/app/HsBindgen/Cli/Preprocess.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/Preprocess.hs
@@ -76,8 +76,11 @@ exec GlobalOpts{..} Opts{..} = do
 
     void $ run $ artefacts
   where
+    -- TODO https://github.com/well-typed/hs-bindgen/issues/1328: Which command
+    -- line options to adjust the binding category predicate do we want to
+    -- provide?
     bindgenConfig :: BindgenConfig
-    bindgenConfig = toBindgenConfig config uniqueId baseModuleName
+    bindgenConfig = toBindgenConfig config uniqueId baseModuleName def
 
     run :: Artefact a -> IO a
     run = hsBindgen tracerConfig bindgenConfig inputs
diff --git a/hs-bindgen/app/HsBindgen/Cli/ToolSupport/Literate.hs b/hs-bindgen/app/HsBindgen/Cli/ToolSupport/Literate.hs
index a2d79d743..aeeffa551 100644
--- a/hs-bindgen/app/HsBindgen/Cli/ToolSupport/Literate.hs
+++ b/hs-bindgen/app/HsBindgen/Cli/ToolSupport/Literate.hs
@@ -24,7 +24,7 @@ import Text.Read (readMaybe)
 
 import HsBindgen
 import HsBindgen.App
-import HsBindgen.Backend.SHs.AST
+import HsBindgen.Backend.Category (useSafeCategory)
 import HsBindgen.Config
 import HsBindgen.Errors
 import HsBindgen.Frontend.RootHeader
@@ -73,7 +73,6 @@ data Lit = Lit {
     , config         :: Config
     , uniqueId       :: UniqueId
     , baseModuleName :: BaseModuleName
-    , safety         :: Safety
     , inputs         :: [UncheckedHashIncludeArg]
     }
 
@@ -83,22 +82,8 @@ parseLit = Lit
   <*> parseConfig
   <*> parseUniqueId
   <*> parseBaseModuleName
-  <*> parseSafety
   <*> parseInputs
 
-parseSafety :: Parser Safety
-parseSafety = asum [
-      flag' Safe $ mconcat [
-          long "safe"
-        , help "Use _safe_ foreign function imports (default)"
-        ]
-    , flag' Unsafe $ mconcat [
-          long "unsafe"
-        , help "Use _unsafe_ foreign function imports"
-        ]
-    , pure Safe
-    ]
-
 {-------------------------------------------------------------------------------
   Execution
 -------------------------------------------------------------------------------}
@@ -110,9 +95,12 @@ exec literateOpts = do
     Lit{..} <- maybe (throwIO' "cannot parse arguments in literate file") return $
       pureParseLit args
     let GlobalOpts{..} = globalOpts
-        bindgenConfig = toBindgenConfig config uniqueId baseModuleName
+        -- TODO https://github.com/well-typed/hs-bindgen/issues/1328: Which command
+        -- line options to adjust the binding category predicate do we want to
+        -- provide?
+        bindgenConfig = toBindgenConfig config uniqueId baseModuleName useSafeCategory
     void $ hsBindgen tracerConfig bindgenConfig inputs $
-      writeBindings safety (Just literateOpts.output)
+      writeBindings (Just literateOpts.output)
   where
     throwIO' :: String -> IO a
     throwIO' = throwIO . LiterateFileException literateOpts.input
diff --git a/hs-bindgen/hs-bindgen.cabal b/hs-bindgen/hs-bindgen.cabal
index 786de5211..56cb2f767 100644
--- a/hs-bindgen/hs-bindgen.cabal
+++ b/hs-bindgen/hs-bindgen.cabal
@@ -75,6 +75,8 @@ library internal
     HsBindgen
     HsBindgen.Artefact
     HsBindgen.Backend
+    HsBindgen.Backend.Category
+    HsBindgen.Backend.Category.ApplyChoice
     HsBindgen.Backend.Extensions
     HsBindgen.Backend.Hs.AST
     HsBindgen.Backend.Hs.AST.Strategy
@@ -376,6 +378,7 @@ test-suite test-hs-bindgen
     , directory
     , filepath
     , mtl
+    , optics-core
     , process
     , tasty
     , tasty-hunit
diff --git a/hs-bindgen/src-internal/HsBindgen.hs b/hs-bindgen/src-internal/HsBindgen.hs
index d63c87774..a26c15478 100644
--- a/hs-bindgen/src-internal/HsBindgen.hs
+++ b/hs-bindgen/src-internal/HsBindgen.hs
@@ -17,14 +17,15 @@ module HsBindgen
 
 import Control.Monad (join)
 import Control.Monad.Trans.Reader (ask)
-import Data.Map qualified as Map
+import Optics.Core (view)
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath (takeDirectory, (</>))
 
 import HsBindgen.Artefact
 import HsBindgen.Backend
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.HsModule.Render
-import HsBindgen.Backend.SHs.AST
+import HsBindgen.Backend.HsModule.Translation
 import HsBindgen.BindingSpec.Gen
 import HsBindgen.Boot
 import HsBindgen.Config.Internal
@@ -109,25 +110,26 @@ writeUseDeclGraph mPath = do
          $ UseDeclGraph.dumpMermaid index useDeclGraph
 
 -- | Get bindings (single module).
-getBindings :: Safety -> Artefact String
-getBindings safety = do
-    finalModule <- finalModuleArtefact
-    Lift $ pure . render $ finalModule
-  where finalModuleArtefact = case safety of
-          Safe   -> FinalModuleSafe
-          Unsafe -> FinalModuleUnsafe
+getBindings :: Artefact String
+getBindings = do
+    name  <- FinalModuleBaseName
+    decls <- FinalDecls
+    pure $ render $ translateModuleSingle name decls
 
 -- | Write bindings to file.
 --
 -- If no file is given, print to standard output.
-writeBindings :: Safety -> Maybe FilePath -> Artefact ()
-writeBindings safety mPath = do
-    bindings <- getBindings safety
+writeBindings :: Maybe FilePath -> Artefact ()
+writeBindings mPath = do
+    bindings <- getBindings
     Lift $ write "bindings" mPath bindings
 
 -- | Get bindings (one module per binding category).
-getBindingsMultiple :: Artefact (ByCategory String)
-getBindingsMultiple = fmap render <$> FinalModules
+getBindingsMultiple :: Artefact (ByCategory_ (Maybe String))
+getBindingsMultiple = do
+  name  <- FinalModuleBaseName
+  decls <- FinalDecls
+  pure $ fmap render <$> translateModuleMultiple name decls
 
 -- | Write bindings to files in provided output directory.
 --
@@ -154,11 +156,11 @@ writeBindingSpec path = do
   liftIO $
     genBindingSpec
       target
-      (fromBaseModuleName moduleBaseName (Just BType))
+      (fromBaseModuleName moduleBaseName (Just CType))
       path
       getMainHeaders
       omitTypes
-      (fromMaybe [] (Map.lookup BType $ unByCategory hsDecls))
+      (view (lensForCategory CType) hsDecls)
 
 -- | Create test suite in directory.
 writeTests :: FilePath -> Artefact ()
@@ -190,13 +192,14 @@ writeByCategory ::
      String
   -> FilePath
   -> BaseModuleName
-  -> ByCategory String
+  -> ByCategory_ (Maybe String)
   -> ArtefactM ()
 writeByCategory what hsOutputDir moduleBaseName =
-    mapM_ (uncurry writeCategory) . Map.toList . unByCategory
+    sequence_ . mapWithCategory_ writeCategory
   where
-    writeCategory :: BindingCategory -> String -> ArtefactM ()
-    writeCategory cat str = do
+    writeCategory :: Category -> Maybe String -> ArtefactM ()
+    writeCategory _    Nothing   = pure ()
+    writeCategory cat (Just str) = do
         write whatWithCategory (Just path) str
       where
         moduleName :: Hs.ModuleName
diff --git a/hs-bindgen/src-internal/HsBindgen/Artefact.hs b/hs-bindgen/src-internal/HsBindgen/Artefact.hs
index 31f9b274f..9fec9213a 100644
--- a/hs-bindgen/src-internal/HsBindgen/Artefact.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Artefact.hs
@@ -18,10 +18,9 @@ import Text.SimplePrettyPrint qualified as PP
 import Clang.Paths
 
 import HsBindgen.Backend
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
 import HsBindgen.Backend.Hs.CallConv (UserlandCapiWrapper)
-import HsBindgen.Backend.HsModule.Translation
-import HsBindgen.Backend.SHs.AST
 import HsBindgen.Backend.SHs.AST qualified as SHs
 import HsBindgen.Boot
 import HsBindgen.Config
@@ -56,12 +55,9 @@ data Artefact (a :: Star) where
   ReifiedC            :: Artefact [C.Decl]
   Dependencies        :: Artefact [SourcePath]
   -- * Backend
-  HsDecls             :: Artefact (ByCategory [Hs.Decl])
-  FinalDecls          :: Artefact (ByCategory ([UserlandCapiWrapper], [SHs.SDecl]))
+  HsDecls             :: Artefact (ByCategory_ [Hs.Decl])
+  FinalDecls          :: Artefact (ByCategory_ ([UserlandCapiWrapper], [SHs.SDecl]))
   FinalModuleBaseName :: Artefact BaseModuleName
-  FinalModuleSafe     :: Artefact HsModule
-  FinalModuleUnsafe   :: Artefact HsModule
-  FinalModules        :: Artefact (ByCategory HsModule)
   -- * Lift and sequence artefacts
   Lift                :: ArtefactM a -> Artefact a
   Bind                :: Artefact b  -> (b -> Artefact c ) -> Artefact c
@@ -140,9 +136,6 @@ runArtefacts
       HsDecls             -> liftIO backendHsDecls
       FinalDecls          -> liftIO backendFinalDecls
       FinalModuleBaseName -> pure backendFinalModuleBaseName
-      FinalModuleSafe     -> liftIO backendFinalModuleSafe
-      FinalModuleUnsafe   -> liftIO backendFinalModuleUnsafe
-      FinalModules        -> liftIO backendFinalModules
       -- Lift and sequence.
       (Lift f)            -> lift f
       (Bind x   f)        -> do
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend.hs b/hs-bindgen/src-internal/HsBindgen/Backend.hs
index 74c86b18e..a6fd6a66a 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend.hs
@@ -4,10 +4,11 @@ module HsBindgen.Backend
   , BackendMsg(..)
   ) where
 
+import HsBindgen.Backend.Category
+import HsBindgen.Backend.Category.ApplyChoice
 import HsBindgen.Backend.Hs.AST qualified as Hs
 import HsBindgen.Backend.Hs.CallConv
 import HsBindgen.Backend.Hs.Translation qualified as Hs
-import HsBindgen.Backend.HsModule.Translation
 import HsBindgen.Backend.SHs.AST qualified as SHs
 import HsBindgen.Backend.SHs.Simplify qualified as SHs
 import HsBindgen.Backend.SHs.Translation qualified as SHs
@@ -29,27 +30,23 @@ backend :: Tracer BackendMsg
   -> IO BackendArtefact
 backend tracer BackendConfig{..} BootArtefact{..} FrontendArtefact{..} = do
     -- 1. Reified C declarations to @Hs@ declarations.
-    backendHsDecls <- cache $
+    backendHsDeclsAll <- cache $
       Hs.generateDeclarations
         backendTranslationConfig
         backendHaddockConfig
         moduleBaseName <$> frontendIndex
                        <*> frontendCDecls
 
+    backendHsDecls <- cache $ do
+      decls <- backendHsDeclsAll
+      pure $ applyBindingCategoryChoice backendBindingCategoryChoice decls
+
     -- 2. @Hs@ declarations to simple @Hs@ declarations.
     sHsDecls <- cache $ SHs.translateDecls <$> backendHsDecls
 
     -- 3. Simplify.
     backendFinalDecls <- cache $ SHs.simplifySHs <$> sHsDecls
 
-    -- 4. Translate to modules.
-    backendFinalModuleSafe <- cache $
-      translateModuleSingle SHs.Safe moduleBaseName <$> backendFinalDecls
-    backendFinalModuleUnsafe <- cache $
-      translateModuleSingle SHs.Unsafe moduleBaseName <$> backendFinalDecls
-    backendFinalModules <- cache $
-      translateModuleMultiple moduleBaseName <$> backendFinalDecls
-
     pure $ BackendArtefact {
       backendFinalModuleBaseName = moduleBaseName
     , ..
@@ -65,12 +62,9 @@ backend tracer BackendConfig{..} BootArtefact{..} FrontendArtefact{..} = do
 -------------------------------------------------------------------------------}
 
 data BackendArtefact = BackendArtefact {
-    backendHsDecls             :: IO (SHs.ByCategory [Hs.Decl])
-  , backendFinalDecls          :: IO (SHs.ByCategory ([UserlandCapiWrapper], [SHs.SDecl]))
+    backendHsDecls             :: IO (ByCategory_ [Hs.Decl])
+  , backendFinalDecls          :: IO (ByCategory_ ([UserlandCapiWrapper], [SHs.SDecl]))
   , backendFinalModuleBaseName :: BaseModuleName
-  , backendFinalModuleSafe     :: IO HsModule
-  , backendFinalModuleUnsafe   :: IO HsModule
-  , backendFinalModules        :: IO (SHs.ByCategory HsModule)
   }
 
 {-------------------------------------------------------------------------------
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Category.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Category.hs
new file mode 100644
index 000000000..379b7db7b
--- /dev/null
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/Category.hs
@@ -0,0 +1,193 @@
+{-# LANGUAGE OverloadedLabels #-}
+
+-- | This module is intended for unqualified import because some declarations
+-- | are reexported from the public Template Haskell interface.
+module HsBindgen.Backend.Category (
+    -- * Binding categories
+    TermCategory(..)
+  , Category(..)
+  , allCategories
+  , ByCategory(..)
+  , mapWithCategory
+  , ByCategory_(..)
+  , mapWithCategory_
+  , lensForCategory
+  , lensForTermCategory
+    -- * Binding category levels
+  , CategoryLvl(..)
+    -- * Binding category choices
+  , RenameTerm(..)
+  , Choice(..)
+  , useSafeCategory
+  , useUnsafeCategory
+  ) where
+
+import Data.Functor.Const (Const (..))
+import Optics.Core (Lens', iso, (%))
+import Optics.Iso (Iso')
+
+import HsBindgen.Imports hiding (toList)
+
+data TermCategory =
+    -- | Foreign import bindings with a @safe@ foreign import modifier.
+    CSafe
+    -- | Foreign import bindings with an @unsafe@ foreign import modifier.
+  | CUnsafe
+    -- | Pointers to functions; generally @unsafe@.
+  | CFunPtr
+    -- | Temporary category for bindings to global variables or constants.
+  | CGlobal
+  deriving stock (Show, Eq, Ord, Enum, Bounded)
+
+-- | Binding category.
+data Category =
+    -- | Types (top-level bindings).
+    CType
+  | CTerm TermCategory
+  deriving stock (Show, Eq, Ord)
+
+allCategories :: [Category]
+allCategories = [CType] ++ map CTerm [minBound .. maxBound]
+
+-- | Like 'Data.Map.Strict.mapWithKey'.
+mapWithCategory ::
+     (f LvlType -> g LvlType)
+  -> (TermCategory -> f LvlTerm -> g LvlTerm)
+  -> ByCategory f
+  -> ByCategory g
+mapWithCategory f g ByCategory{..} =
+  ByCategory {
+      cType   = f         cType
+    , cSafe   = g CSafe   cSafe
+    , cUnsafe = g CUnsafe cUnsafe
+    , cFunPtr = g CFunPtr cFunPtr
+    , cGlobal = g CGlobal cGlobal
+    }
+
+-- | A strict, total map from 'Category' to 'a'.
+type ByCategory :: (CategoryLvl -> Star) -> Star
+data ByCategory f = ByCategory {
+      cType   :: !(f LvlType)
+    , cSafe   :: !(f LvlTerm)
+    , cUnsafe :: !(f LvlTerm)
+    , cFunPtr :: !(f LvlTerm)
+    , cGlobal :: !(f LvlTerm)
+  }
+  deriving stock (Generic)
+
+deriving instance (Eq (f LvlType),   Eq (f LvlTerm))         => Eq (ByCategory f)
+deriving instance (Show (f LvlType), Show (f LvlTerm))       => Show (ByCategory f)
+deriving instance (Default (f LvlType), Default (f LvlTerm)) => Default (ByCategory f)
+
+newtype ByCategory_ a = ByCategory_ { getByCategory_ :: ByCategory (Const a) }
+  deriving stock (Show, Eq, Generic)
+
+instance Functor ByCategory_ where
+  fmap f (ByCategory_ x) = ByCategory_ $
+    mapWithCategory (applyConst f) (\_ -> applyConst f) x
+
+mapWithCategory_ :: (Category -> a -> b) -> ByCategory_ a -> ByCategory_ b
+mapWithCategory_ f (ByCategory_ x) =
+  ByCategory_ $ mapWithCategory (applyConst (f CType)) (applyConst . f . CTerm) x
+
+toList :: ByCategory_ a -> [a]
+toList (ByCategory_ (ByCategory t s u f g)) = [
+      getConst t
+    , getConst s
+    , getConst u
+    , getConst f
+    , getConst g
+    ]
+
+instance Foldable ByCategory_ where
+  foldMap f = foldMap f . toList
+
+instance Semigroup a => Semigroup (ByCategory_ a) where
+  (ByCategory_ l) <> (ByCategory_ r) =
+    ByCategory_ $ ByCategory {
+        cType   = l.cType   <> r.cType
+      , cSafe   = l.cSafe   <> r.cSafe
+      , cUnsafe = l.cUnsafe <> r.cUnsafe
+      , cFunPtr = l.cFunPtr <> r.cFunPtr
+      , cGlobal = l.cGlobal <> r.cGlobal
+      }
+
+instance Monoid a => Monoid (ByCategory_ a) where
+  mempty = ByCategory_ $ ByCategory mempty mempty mempty mempty mempty
+
+isoByCategory :: Iso' (ByCategory_ a) (ByCategory (Const a))
+isoByCategory = iso getByCategory_ ByCategory_
+
+isoConst :: Iso' (Const a b) a
+isoConst = iso getConst Const
+
+lensForCategory :: Category -> Lens' (ByCategory_ a) a
+lensForCategory = \case
+    CType     -> isoByCategory % #cType % isoConst
+    CTerm cat -> isoByCategory % lensForTermCategory cat % isoConst
+
+lensForTermCategory :: TermCategory -> Lens' (ByCategory f) (f LvlTerm)
+lensForTermCategory = \case
+  CSafe   -> #cSafe
+  CUnsafe -> #cUnsafe
+  CFunPtr -> #cFunPtr
+  CGlobal -> #cGlobal
+
+-- | A category may contain types or terms.
+data CategoryLvl = LvlType | LvlTerm
+
+newtype RenameTerm = RenameTerm (Text -> Text)
+
+instance Show RenameTerm where
+  show = const "<RenameTerm>"
+
+instance Default RenameTerm where
+  def = RenameTerm id
+
+-- | Include or exclude categories.
+--
+-- Possibly rename declarations in categories of 'Level' 'LvlTerm'. We only
+-- allow renaming of 'LvlTerm' because for 'LvlType' we would also need to
+-- rename the use sites, instances etc.
+type Choice :: CategoryLvl -> Star
+data Choice lvl where
+  ExcludeCategory     :: Choice lvl
+  IncludeTypeCategory :: Choice LvlType
+  IncludeTermCategory :: RenameTerm -> Choice LvlTerm
+
+deriving instance Show (Choice lvl)
+
+instance Default (Choice LvlType) where
+  def = IncludeTypeCategory
+instance Default (Choice LvlTerm) where
+  def = IncludeTermCategory def
+
+-- | Use 'CType', 'CSafe', and 'CGlobal'; do not rename declarations.
+useSafeCategory :: ByCategory Choice
+useSafeCategory = ByCategory {
+      cType   = IncludeTypeCategory
+    , cSafe   = IncludeTermCategory def
+    , cUnsafe = ExcludeCategory
+    , cFunPtr = ExcludeCategory
+    , cGlobal = IncludeTermCategory def
+    }
+
+-- | Use 'CType', 'CUnsafe', and 'CGlobal'; do not rename declarations.
+useUnsafeCategory :: ByCategory Choice
+useUnsafeCategory = ByCategory {
+      cType   = IncludeTypeCategory
+    , cSafe   = ExcludeCategory
+    , cUnsafe = IncludeTermCategory def
+    , cFunPtr = ExcludeCategory
+    , cGlobal = IncludeTermCategory def
+    }
+
+-- TODO_PR: Fix #1262
+
+-- TODO_PR: Golden test case for #1262.
+
+-- TODO_PR: Check whether files for empty categories are NOT created (golden
+-- tests and client). Recreate all fixtures and check they are non-empty.
+
+applyConst :: (a -> b) -> Const a c -> Const b c
+applyConst f = Const . f . getConst
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Category/ApplyChoice.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Category/ApplyChoice.hs
new file mode 100644
index 000000000..5fb4d981c
--- /dev/null
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/Category/ApplyChoice.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE OverloadedLabels #-}
+
+module HsBindgen.Backend.Category.ApplyChoice (
+    applyBindingCategoryChoice
+  ) where
+
+import Optics.Core (Lens', over, view)
+
+import HsBindgen.Backend.Category
+import HsBindgen.Backend.Hs.AST qualified as Hs
+import HsBindgen.Backend.SHs.AST qualified as SHs
+import HsBindgen.Errors (panicPure)
+import HsBindgen.Imports
+import HsBindgen.Language.Haskell qualified as Hs
+
+{-------------------------------------------------------------------------------
+  Binding category choice
+-------------------------------------------------------------------------------}
+
+applyTypes :: Choice LvlType -> [a] -> [a]
+applyTypes = \case
+  ExcludeCategory     -> const []
+  IncludeTypeCategory -> id
+
+applyTerms :: Choice LvlTerm -> [Hs.Decl] -> [Hs.Decl]
+applyTerms = \case
+    ExcludeCategory                    -> const []
+    IncludeTermCategory (RenameTerm f) -> map (renameHsDeclWith f)
+  where
+    renameHsDeclWith :: (Text -> Text) -> Hs.Decl -> Hs.Decl
+    renameHsDeclWith f d = case d of
+        Hs.DeclData{}           -> p "Data"
+        Hs.DeclEmpty{}          -> p "Empty"
+        Hs.DeclNewtype{}        -> p "Newtype"
+        Hs.DeclPatSyn{}         -> p "PatSyn"
+        Hs.DeclDefineInstance{} -> p "DefineInstance"
+        Hs.DeclDeriveInstance{} -> p "DeriveInstance"
+        Hs.DeclForeignImport x  -> Hs.DeclForeignImport $ overN #foreignImportName f x
+        Hs.DeclFunction      x  -> Hs.DeclFunction      $ overN #functionDeclName  f x
+        Hs.DeclMacroExpr{}      -> p "MacroExpr"
+        Hs.DeclUnionGetter{}    -> p "UnionGetter"
+        Hs.DeclUnionSetter{}    -> p "UnionSetter"
+        Hs.DeclSimple        x  -> Hs.DeclSimple        $ renameSHsDeclWith f x
+      where
+        p :: String -> a
+        p e = panicPure $ "applyTerms: renameHsDeclWith (" <> show d <> "): " <> e
+
+    renameSHsDeclWith :: (Text -> Text) -> SHs.SDecl -> SHs.SDecl
+    renameSHsDeclWith f d = case d of
+        SHs.DVar x                   -> SHs.DVar $ overN #varName f x
+        SHs.DInst{}                  -> p "Instance"
+        SHs.DRecord{}                -> p "Record"
+        SHs.DNewtype{}               -> p "Newtype"
+        SHs.DEmptyData{}             -> p "EmptyData"
+        SHs.DDerivingInstance{}      -> p "DerivingInstance"
+        SHs.DForeignImport{}         -> p "ForeignImport"
+        SHs.DFunction{}              -> p "Function"
+        SHs.DPatternSynonym{}        -> p "PatternSynonym"
+        SHs.DPragma (SHs.NOINLINE n) -> SHs.DPragma (SHs.NOINLINE $ fN f n)
+      where
+        p :: String -> a
+        p e = panicPure $ "applyTerms: renameSHsDeclWith: (" <> show d <> "): " <> e
+
+    fN :: (Text -> Text) -> Hs.Name n -> Hs.Name n
+    fN f = Hs.Name . f . Hs.getName
+
+    overN :: Lens' a (Hs.Name n) -> (Text -> Text) -> a -> a
+    overN l f = over l (fN f)
+
+
+-- | Choose binding categories and possibly rename declarations in term-level
+-- | categories.
+applyBindingCategoryChoice ::
+     ByCategory Choice
+  -> ByCategory_ [Hs.Decl]
+  -> ByCategory_ [Hs.Decl]
+applyBindingCategoryChoice choice =
+    mapWithCategory_ aux
+  where
+    aux :: Category -> [Hs.Decl] -> [Hs.Decl]
+    aux = \case
+      CType     -> applyTypes choice.cType
+      CTerm cat -> applyTerms (view (lensForTermCategory cat) choice)
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs
index dfe4e8e67..901a63c5b 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/Hs/Translation.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedLabels #-}
+
 -- | Low-level translation of the C header to a Haskell module
 module HsBindgen.Backend.Hs.Translation (
     generateDeclarations
@@ -11,7 +13,9 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Data.Type.Nat (SNatI)
 import Data.Vec.Lazy qualified as Vec
+import Optics.Core (over)
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
 import HsBindgen.Backend.Hs.AST.Type
 import HsBindgen.Backend.Hs.CallConv
@@ -53,24 +57,20 @@ generateDeclarations ::
   -> BaseModuleName
   -> DeclIndex
   -> [C.Decl]
-  -> ByCategory [Hs.Decl]
+  -> ByCategory_ [Hs.Decl]
 generateDeclarations opts config name declIndex =
-    ByCategory . Map.map reverse .
-      foldl' partitionBindingCategories  Map.empty .
+    fmap reverse .
+      foldl' partitionBindingCategories mempty .
       generateDeclarations' opts config name declIndex
   where
     partitionBindingCategories ::
-      Map BindingCategory [a] -> WithCategory a  -> Map BindingCategory [a]
-    partitionBindingCategories m (WithCategory cat decl) =
-      Map.alter (addDecl decl) cat m
-
-    addDecl :: a -> Maybe [a] -> Maybe [a]
-    addDecl decl Nothing      = Just [decl]
-    addDecl decl (Just decls) = Just $ decl : decls
+      ByCategory_ [a] -> WithCategory a  -> ByCategory_ [a]
+    partitionBindingCategories xs (WithCategory cat decl) =
+      over (lensForCategory cat) (decl :) xs
 
 -- | Internal. Top-level declaration with foreign import category.
 data WithCategory a = WithCategory {
-    _withCategoryCategory :: BindingCategory
+    _withCategoryCategory :: Category
   , _withCategoryDecl     :: a
   } deriving (Show)
 
@@ -88,7 +88,7 @@ generateDeclarations' opts haddockConfig moduleName declIndex decs =
           -- These go in the main module to avoid orphan instances
           --WithCategory c
           fFIStubsAndFunPtrInstances =
-                   [ WithCategory BType d
+                   [ WithCategory CType d
                    | C.TypePointer (C.TypeFun args res) <- Set.toList scannedFunctionPointerTypes
                    , not (any hasUnsupportedType (res:args))
                    , any (isDefinedInCurrentModule declIndex) (res:args)
@@ -157,15 +157,15 @@ generateDecs ::
   -> m [WithCategory Hs.Decl]
 generateDecs opts haddockConfig moduleName (C.Decl info kind spec) =
     case kind of
-      C.DeclStruct struct -> withCategoryM BType $
+      C.DeclStruct struct -> withCategoryM CType $
         reifyStructFields struct $ structDecs opts haddockConfig info struct spec
-      C.DeclUnion union -> withCategoryM BType $
+      C.DeclUnion union -> withCategoryM CType $
         unionDecs haddockConfig info union spec
-      C.DeclEnum e -> withCategoryM BType $
+      C.DeclEnum e -> withCategoryM CType $
         enumDecs opts haddockConfig info e spec
-      C.DeclTypedef d -> withCategoryM BType $
+      C.DeclTypedef d -> withCategoryM CType $
         typedefDecs opts haddockConfig info d spec
-      C.DeclOpaque cNameKind -> withCategoryM BType $
+      C.DeclOpaque cNameKind -> withCategoryM CType $
         opaqueDecs cNameKind haddockConfig info spec
       C.DeclFunction f ->
         let funDeclsWith safety =
@@ -175,20 +175,20 @@ generateDecs opts haddockConfig moduleName (C.Decl info kind spec) =
             -- functions that take a function pointer of the appropriate type.
             funPtrDecls = fst $
               addressStubDecs opts haddockConfig moduleName info funType spec
-        in  pure $ withCategory BSafe   (funDeclsWith SHs.Safe)
-                ++ withCategory BUnsafe (funDeclsWith SHs.Unsafe)
-                ++ withCategory BFunPtr  funPtrDecls
-      C.DeclMacro macro -> withCategoryM BType $
+        in  pure $ withCategory (CTerm CSafe)   (funDeclsWith SHs.Safe)
+                ++ withCategory (CTerm CUnsafe) (funDeclsWith SHs.Unsafe)
+                ++ withCategory (CTerm CFunPtr)  funPtrDecls
+      C.DeclMacro macro -> withCategoryM CType $
         macroDecs opts haddockConfig info macro spec
       C.DeclGlobal ty ->
         State.get >>= \instsMap ->
-          pure $ withCategory BGlobal $
+          pure $ withCategory (CTerm CGlobal) $
             global opts haddockConfig moduleName instsMap info ty spec
     where
-      withCategory :: BindingCategory -> [a] -> [WithCategory a]
+      withCategory :: Category -> [a] -> [WithCategory a]
       withCategory c = map (WithCategory c)
 
-      withCategoryM :: Functor m => BindingCategory -> m [a] -> m [WithCategory a]
+      withCategoryM :: Functor m => Category -> m [a] -> m [WithCategory a]
       withCategoryM c = fmap (withCategory c)
 
 
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Translation.hs
index 26abb0118..3224c6202 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Translation.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/HsModule/Translation.hs
@@ -10,13 +10,13 @@ module HsBindgen.Backend.HsModule.Translation (
     -- * Translation
   , translateModuleMultiple
   , translateModuleSingle
-  , mergeDecls
   ) where
 
 import Data.Foldable qualified as Foldable
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Extensions
 import HsBindgen.Backend.Hs.AST qualified as Hs
 import HsBindgen.Backend.Hs.AST.Type qualified as Hs
@@ -70,46 +70,28 @@ data HsModule = HsModule {
 
 translateModuleMultiple ::
      BaseModuleName
-  -> ByCategory ([UserlandCapiWrapper], [SDecl])
-  -> ByCategory HsModule
+  -> ByCategory_ ([UserlandCapiWrapper], [SDecl])
+  -> ByCategory_ (Maybe HsModule)
 translateModuleMultiple moduleBaseName declsByCat =
-  mapByCategory go declsByCat
+    mapWithCategory_ go declsByCat
   where
-    go :: BindingCategory -> ([UserlandCapiWrapper], [SDecl]) -> HsModule
-    go cat (wrappers, decls) =
-      translateModule' (Just cat) moduleBaseName wrappers decls
+    go :: Category -> ([UserlandCapiWrapper], [SDecl]) -> Maybe HsModule
+    go _ ([], []) = Nothing
+    go cat xs     = Just $ translateModule' (Just cat) moduleBaseName xs
 
 translateModuleSingle ::
-     Safety
-  -> BaseModuleName
-  -> ByCategory ([UserlandCapiWrapper], [SDecl])
+     BaseModuleName
+  -> ByCategory_ ([UserlandCapiWrapper], [SDecl])
   -> HsModule
-translateModuleSingle safety name declsByCat =
-  translateModule' Nothing name wrappers decls
-  where
-    wrappers :: [UserlandCapiWrapper]
-    decls :: [SDecl]
-    (wrappers, decls) = mergeDecls safety declsByCat
-
-mergeDecls ::
-  Safety
-  -> ByCategory ([UserlandCapiWrapper], [SDecl])
-  -> ([UserlandCapiWrapper], [SDecl])
-mergeDecls safety declsByCat =
-    Foldable.fold $ ByCategory $ removeSafetyCategory $ unByCategory declsByCat
-  where
-    safetyToRemove = case safety of
-      Safe   -> BUnsafe
-      Unsafe -> BSafe
-    removeSafetyCategory = Map.filterWithKey (\k _ -> k /= safetyToRemove)
+translateModuleSingle name declsByCat =
+    translateModule' Nothing name $ Foldable.fold declsByCat
 
 translateModule' ::
-     Maybe BindingCategory
+     Maybe Category
   -> BaseModuleName
-  -> [UserlandCapiWrapper]
-  -> [SDecl]
+  -> ([UserlandCapiWrapper], [SDecl])
   -> HsModule
-translateModule' mcat moduleBaseName hsModuleUserlandCapiWrappers hsModuleDecls =
+translateModule' mcat moduleBaseName (hsModuleUserlandCapiWrappers, hsModuleDecls) =
     let hsModulePragmas =
           resolvePragmas hsModuleUserlandCapiWrappers hsModuleDecls
         hsModuleImports =
@@ -151,7 +133,7 @@ resolveDeclPragmas decl =
 -- | Resolve imports in a list of declarations
 resolveImports ::
      BaseModuleName
-  -> Maybe BindingCategory
+  -> Maybe Category
   -> [UserlandCapiWrapper]
   -> [SDecl]
   -> [ImportListItem]
@@ -169,10 +151,10 @@ resolveImports baseModule cat wrappers ds =
     bindingCatImport False = mempty
     bindingCatImport True = case cat of
       Nothing    -> mempty
-      Just BType -> mempty
+      Just CType -> mempty
       _otherCat  ->
         let base = HsImportModule{
-                hsImportModuleName  = fromBaseModuleName baseModule (Just BType)
+                hsImportModuleName  = fromBaseModuleName baseModule (Just CType)
               , hsImportModuleAlias = Nothing
               }
         in  Set.singleton $ UnqualifiedImportListItem base Nothing
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs
index 6448c049d..de0a59214 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/AST.hs
@@ -10,8 +10,6 @@ module HsBindgen.Backend.SHs.AST (
     SAlt (..),
     PatExpr (..),
     SDecl (..),
-    ByCategory(..),
-    mapByCategory,
     Pragma (..),
     ClosedType,
     SType (..),
@@ -29,8 +27,6 @@ module HsBindgen.Backend.SHs.AST (
     PatternSynonym (..),
 ) where
 
-import Data.Map qualified as Map
-
 import C.Char qualified as CExpr.Runtime
 
 import HsBindgen.Backend.Hs.AST.Strategy qualified as Hs
@@ -39,7 +35,6 @@ import HsBindgen.Backend.Hs.CallConv
 import HsBindgen.Backend.Hs.Haddock.Documentation qualified as HsDoc
 import HsBindgen.Backend.Hs.Origin qualified as Origin
 import HsBindgen.BindingSpec qualified as BindingSpec
-import HsBindgen.Config.Prelims
 import HsBindgen.Frontend.Naming qualified as C
 import HsBindgen.Imports
 import HsBindgen.Language.Haskell qualified as Hs
@@ -287,8 +282,8 @@ data SAlt ctx where
 deriving stock instance Show (SAlt ctx)
 
 -- | Simple declarations
-data SDecl =
-    DVar Var
+data SDecl
+  = DVar Var
   | DInst Instance
   | DRecord Record
   | DNewtype Newtype
@@ -300,12 +295,6 @@ data SDecl =
   | DPragma Pragma
   deriving stock (Show)
 
-newtype ByCategory a = ByCategory { unByCategory :: Map BindingCategory a }
-  deriving newtype (Functor, Foldable, Show)
-
-mapByCategory :: (BindingCategory -> a -> b) -> ByCategory a -> ByCategory b
-mapByCategory f = ByCategory . Map.mapWithKey f . unByCategory
-
 type ClosedType = SType EmptyCtx
 
 -- | Simple types
@@ -335,7 +324,7 @@ data Var = Var {
     , varExpr    :: ClosedExpr
     , varComment :: Maybe HsDoc.Comment
     }
-  deriving stock (Show)
+  deriving stock (Show, Generic)
 
 data Instance = Instance {
       instanceClass   :: Global
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Simplify.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Simplify.hs
index 1f4c96dcd..2bf71cf7a 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Simplify.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Simplify.hs
@@ -5,6 +5,7 @@ import Data.Either (partitionEithers)
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST.Strategy
 import HsBindgen.Backend.Hs.CallConv
 import HsBindgen.Backend.SHs.AST
@@ -16,8 +17,8 @@ import HsBindgen.Language.Haskell qualified as Hs
 -------------------------------------------------------------------------------}
 
 simplifySHs ::
-     ByCategory ([UserlandCapiWrapper], [SDecl])
-  -> ByCategory ([UserlandCapiWrapper], [SDecl])
+     ByCategory_ ([UserlandCapiWrapper], [SDecl])
+  -> ByCategory_ ([UserlandCapiWrapper], [SDecl])
 simplifySHs = fmap (\(x, y) -> (x, go y))
   where
     go :: [SDecl] -> [SDecl]
diff --git a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs
index 4b72b6c73..68be34982 100644
--- a/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Backend/SHs/Translation.hs
@@ -11,6 +11,7 @@ import Data.Map.Strict qualified as Map
 import Data.Text qualified as T
 import Data.Vec.Lazy qualified as Vec
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
 import HsBindgen.Backend.Hs.AST.Type
 import HsBindgen.Backend.Hs.CallConv
@@ -27,7 +28,7 @@ import HsBindgen.NameHint
 -------------------------------------------------------------------------------}
 
 translateDecls ::
-  ByCategory [Hs.Decl] -> ByCategory ([UserlandCapiWrapper], [SDecl])
+  ByCategory_ [Hs.Decl] -> ByCategory_ ([UserlandCapiWrapper], [SDecl])
 translateDecls = fmap go
   where
     go :: [Hs.Decl] -> ([UserlandCapiWrapper], [SDecl])
diff --git a/hs-bindgen/src-internal/HsBindgen/Boot.hs b/hs-bindgen/src-internal/HsBindgen/Boot.hs
index ec8cf15c0..5d21a98da 100644
--- a/hs-bindgen/src-internal/HsBindgen/Boot.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Boot.hs
@@ -15,6 +15,7 @@ import Text.SimplePrettyPrint qualified as PP
 import Clang.Args
 import Clang.LowLevel.Core
 
+import HsBindgen.Backend.Category (Category (..))
 import HsBindgen.BindingSpec
 import HsBindgen.Cache
 import HsBindgen.Clang
@@ -70,7 +71,7 @@ boot
         (contramap BootBindingSpec tracer)
         clangArgs
         target
-        (fromBaseModuleName baseModuleName (Just BType))
+        (fromBaseModuleName baseModuleName (Just CType))
         (bootBindingSpecConfig bindgenBootConfig)
 
     getExternalBindingSpecs <- cache "getExternalBindingSpecs" $ do
diff --git a/hs-bindgen/src-internal/HsBindgen/Config.hs b/hs-bindgen/src-internal/HsBindgen/Config.hs
index 3c99fe3e2..e06d6ba26 100644
--- a/hs-bindgen/src-internal/HsBindgen/Config.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Config.hs
@@ -15,9 +15,9 @@ module HsBindgen.Config (
   )
 where
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.Haddock.Config
 import HsBindgen.Backend.Hs.Translation.Config
-import HsBindgen.Backend.SHs.AST
 import HsBindgen.BindingSpec
 import HsBindgen.Config.ClangArgs
 import HsBindgen.Config.Internal
@@ -46,14 +46,19 @@ data Config_ path = Config {
   , programSlicing  :: ProgramSlicing
 
     -- * Backend
-  , haddockPathStyle :: PathStyle
+  , haddockPathStyle         :: PathStyle
   }
-  deriving stock (Show, Eq, Generic)
+  deriving stock (Eq, Show, Generic)
   deriving stock (Functor, Foldable, Traversable)
   deriving anyclass (Default)
 
-toBindgenConfig :: Config_ FilePath -> UniqueId -> BaseModuleName -> BindgenConfig
-toBindgenConfig Config{..} uniqueId baseModuleName =
+toBindgenConfig ::
+     Config_ FilePath
+  -> UniqueId
+  -> BaseModuleName
+  -> ByCategory Choice
+  -> BindgenConfig
+toBindgenConfig Config{..} uniqueId baseModuleName choice =
     BindgenConfig bootConfig frontendConfig backendConfig
   where
     bootConfig = BootConfig {
@@ -74,6 +79,7 @@ toBindgenConfig Config{..} uniqueId baseModuleName =
       , backendHaddockConfig = HaddockConfig {
             pathStyle = haddockPathStyle
           }
+      , backendBindingCategoryChoice = choice
       }
 
 {-------------------------------------------------------------------------------
@@ -98,16 +104,15 @@ instance Default OutputDirPolicy where
 
 -- | Configuration specific to Template-Haskell mode
 data ConfigTH = ConfigTH {
-    -- | Foreign import safety
+    -- | Some identifiers (e.g., identifiers of @safe@ and @unsafe@ foreign
+    -- imports) are identical, so we have to choose which ones to generate
+    -- bindings for.
     --
-    -- The generated identifiers of @safe@ and @unsafe@ foreign imports are
-    -- identical, so we have to choose one.
+    -- We can also include all declarations, carefully renaming identifiers to
+    -- avoid name clashes.
     --
-    -- Default:
-    --
-    -- >>> def :: Safety
-    -- Safe
-    safety :: Safety
+    -- Default: 'Category.useSafe'.
+    bindingCategoryChoice    :: ByCategory Choice
 
     -- | Show trace messages of the provided 'Level' or higher.
     --
@@ -123,5 +128,11 @@ data ConfigTH = ConfigTH {
     -- errors.
   , customLogLevelSettings :: [CustomLogLevelSetting]
   }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass Default
+  deriving stock (Generic)
+
+instance Default ConfigTH where
+  def = ConfigTH {
+            bindingCategoryChoice    = useSafeCategory
+          , verbosity                = def
+          , customLogLevelSettings   = def
+          }
diff --git a/hs-bindgen/src-internal/HsBindgen/Config/Internal.hs b/hs-bindgen/src-internal/HsBindgen/Config/Internal.hs
index 776dc524a..1c14219e5 100644
--- a/hs-bindgen/src-internal/HsBindgen/Config/Internal.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Config/Internal.hs
@@ -13,6 +13,7 @@ module HsBindgen.Config.Internal
   , module HsBindgen.Config.Prelims
   ) where
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.Haddock.Config
 import HsBindgen.Backend.Hs.Translation.Config
 import HsBindgen.BindingSpec
@@ -39,8 +40,8 @@ data BindgenConfig = BindgenConfig {
     , bindgenFrontendConfig :: FrontendConfig
     , bindgenBackendConfig  :: BackendConfig
     }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass Default
+  deriving stock (Show, Generic)
+  deriving anyclass (Default)
 
 {-------------------------------------------------------------------------------
   Boot configuration
@@ -85,10 +86,11 @@ data FrontendConfig = FrontendConfig {
 --
 -- See also the notes at 'FrontendConfig'.
 data BackendConfig = BackendConfig {
-      backendTranslationConfig :: TranslationConfig
-    , backendHaddockConfig     :: HaddockConfig
+      backendTranslationConfig     :: TranslationConfig
+    , backendHaddockConfig         :: HaddockConfig
+    , backendBindingCategoryChoice :: ByCategory Choice
     }
-  deriving stock (Show, Eq, Generic)
+  deriving stock (Show, Generic)
   deriving anyclass Default
 
 checkBackendConfig :: Tracer BackendConfigMsg -> BackendConfig -> IO ()
diff --git a/hs-bindgen/src-internal/HsBindgen/Config/Prelims.hs b/hs-bindgen/src-internal/HsBindgen/Config/Prelims.hs
index 50052a00d..c99b56753 100644
--- a/hs-bindgen/src-internal/HsBindgen/Config/Prelims.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Config/Prelims.hs
@@ -2,7 +2,6 @@ module HsBindgen.Config.Prelims (
     -- * Base module name
     BaseModuleName(..)
   , baseModuleNameToString
-  , BindingCategory(..)
   , fromBaseModuleName
 
     -- * Unique IDs
@@ -15,6 +14,7 @@ import Data.Aeson (FromJSON, ToJSON)
 import Data.Text qualified as Text
 import Text.SimplePrettyPrint qualified as PP
 
+import HsBindgen.Backend.Category
 import HsBindgen.Imports
 import HsBindgen.Language.Haskell qualified as Hs
 import HsBindgen.Util.Tracer
@@ -37,35 +37,22 @@ instance Default BaseModuleName where
 baseModuleNameToString :: BaseModuleName -> String
 baseModuleNameToString = Text.unpack . baseModuleNameToText
 
--- | Foreign import category.
-data BindingCategory =
-    -- | Types (top-level bindings).
-    BType
-    -- | Foreign import bindings with a @safe@ foreign import modifier.
-  | BSafe
-    -- | Foreign import bindings with an @unsafe@ foreign import modifier.
-  | BUnsafe
-    -- | Pointers to functions; generally @unsafe@.
-  | BFunPtr
-    -- | Temporary category for bindings to global variables or constants.
-  | BGlobal
-  deriving stock (Show, Eq, Ord, Enum, Bounded)
-
-fromBaseModuleName :: BaseModuleName -> Maybe BindingCategory -> Hs.ModuleName
+fromBaseModuleName :: BaseModuleName -> Maybe Category -> Hs.ModuleName
 fromBaseModuleName (BaseModuleName base) Nothing =
     Hs.moduleNameFromText base
-fromBaseModuleName (BaseModuleName base) (Just cat) =
-    Hs.moduleNameFromText (base <> maybe mempty ("." <>) (submodule cat))
+fromBaseModuleName (BaseModuleName base) (Just CType) =
+    Hs.moduleNameFromText base
+fromBaseModuleName (BaseModuleName base) (Just (CTerm cat)) =
+    Hs.moduleNameFromText (base <> "." <> submodule cat)
   where
     -- NOTE: It is important that types are stored in a module without any
     -- suffix; we depend on this assumption for binding specifications (which
     -- only refer to types, never to functions or globals).
-    submodule :: BindingCategory -> Maybe Text
-    submodule BType   = Nothing
-    submodule BSafe   = Just "Safe"
-    submodule BUnsafe = Just "Unsafe"
-    submodule BFunPtr = Just "FunPtr"
-    submodule BGlobal = Just "Global"
+    submodule :: TermCategory -> Text
+    submodule CSafe   = "Safe"
+    submodule CUnsafe = "Unsafe"
+    submodule CFunPtr = "FunPtr"
+    submodule CGlobal = "Global"
 
 {-------------------------------------------------------------------------------
   Unique IDs
diff --git a/hs-bindgen/src-internal/HsBindgen/Frontend.hs b/hs-bindgen/src-internal/HsBindgen/Frontend.hs
index 3990c55da..a26576409 100644
--- a/hs-bindgen/src-internal/HsBindgen/Frontend.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Frontend.hs
@@ -13,6 +13,7 @@ import Clang.Enum.Bitfield
 import Clang.LowLevel.Core
 import Clang.Paths
 
+import HsBindgen.Backend.Category (Category (..))
 import HsBindgen.Boot
 import HsBindgen.Cache
 import HsBindgen.Clang
@@ -153,7 +154,7 @@ frontend tracer FrontendConfig{..} BootArtefact{..} = do
       let (afterResolveBindingSpecs, msgsResolveBindingSpecs) =
             resolveBindingSpecs
               target
-              (fromBaseModuleName bootBaseModule (Just BType))
+              (fromBaseModuleName bootBaseModule (Just CType))
               extSpecs
               pSpec
               afterNameAnon
diff --git a/hs-bindgen/src-internal/HsBindgen/TH/Internal.hs b/hs-bindgen/src-internal/HsBindgen/TH/Internal.hs
index b96252fdc..7f86cfbf4 100644
--- a/hs-bindgen/src-internal/HsBindgen/TH/Internal.hs
+++ b/hs-bindgen/src-internal/HsBindgen/TH/Internal.hs
@@ -13,6 +13,7 @@ module HsBindgen.TH.Internal (
   ) where
 
 import Control.Monad.State (State, execState, modify)
+import Data.Foldable qualified as Foldable
 import Data.Set qualified as Set
 import Language.Haskell.TH qualified as TH
 import Optics.Core ((&), (.~))
@@ -21,9 +22,9 @@ import System.FilePath ((</>))
 import Clang.Paths
 
 import HsBindgen
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Extensions
 import HsBindgen.Backend.Hs.CallConv
-import HsBindgen.Backend.HsModule.Translation
 import HsBindgen.Backend.SHs.AST qualified as SHs
 import HsBindgen.Backend.TH.Translation
 import HsBindgen.Config
@@ -71,7 +72,7 @@ withHsBindgen config ConfigTH{..} hashIncludes = do
     checkHsBindgenRuntimePreludeIsInScope
     packageRoot <- getPackageRoot
 
-    bindgenConfig <- toBindgenConfigTH packageRoot config
+    bindgenConfig <- toBindgenConfigTH config packageRoot bindingCategoryChoice
 
     let tracerConfig :: TracerConfig Level TraceMsg
         tracerConfig =
@@ -89,10 +90,7 @@ withHsBindgen config ConfigTH{..} hashIncludes = do
           reverse $ bindgenStateUncheckedHashIncludeArgs bindgenState
 
         artefact :: Artefact ([SourcePath], ([UserlandCapiWrapper], [SHs.SDecl]))
-        artefact = do
-          deps  <- Dependencies
-          decls <- FinalDecls
-          pure (deps, mergeDecls safety decls)
+        artefact = (,) <$> Dependencies <*> (Foldable.fold <$> FinalDecls)
 
     (deps, decls) <- liftIO $
       hsBindgen
@@ -216,8 +214,8 @@ checkLanguageExtensions requiredExts = do
         "Missing language extension(s): " :
           (map (("    - " ++) . show) (toList missingExts))
 
-toBindgenConfigTH :: FilePath -> Config -> TH.Q BindgenConfig
-toBindgenConfigTH packageRoot config = do
+toBindgenConfigTH :: Config -> FilePath -> ByCategory Choice -> TH.Q BindgenConfig
+toBindgenConfigTH config packageRoot choice = do
     uniqueId <- getUniqueId
     hsModuleName <- fromString . TH.loc_module <$> TH.location
     let bindgenConfig :: BindgenConfig
@@ -226,6 +224,7 @@ toBindgenConfigTH packageRoot config = do
             (toFilePath packageRoot <$> config)
             uniqueId
             hsModuleName
+            choice
     pure bindgenConfig
   where
     getUniqueId :: TH.Q UniqueId
diff --git a/hs-bindgen/src-internal/HsBindgen/Test.hs b/hs-bindgen/src-internal/HsBindgen/Test.hs
index 74a6fd5d3..700f4b2b7 100644
--- a/hs-bindgen/src-internal/HsBindgen/Test.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Test.hs
@@ -7,8 +7,8 @@ import Data.List qualified as List
 import System.Directory qualified as Dir
 import System.FilePath qualified as FilePath
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
-import HsBindgen.Backend.SHs.AST (ByCategory)
 import HsBindgen.Config
 import HsBindgen.Config.Prelims
 import HsBindgen.Frontend.RootHeader
@@ -24,7 +24,7 @@ import HsBindgen.Test.Readme (genTestsReadme)
 -- | Generate test suite
 genTests ::
      [HashIncludeArg]
-  -> ByCategory [Hs.Decl]
+  -> ByCategory_ [Hs.Decl]
   -> BaseModuleName -- ^ Generated Haskell module name
   -> FilePath       -- ^ Test suite directory path
   -> IO ()
diff --git a/hs-bindgen/src-internal/HsBindgen/Test/C.hs b/hs-bindgen/src-internal/HsBindgen/Test/C.hs
index 7fcc1476d..b622181af 100644
--- a/hs-bindgen/src-internal/HsBindgen/Test/C.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Test/C.hs
@@ -2,8 +2,8 @@ module HsBindgen.Test.C (
     genTestsC
   ) where
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
-import HsBindgen.Backend.SHs.AST
 import HsBindgen.Errors
 import HsBindgen.Frontend.RootHeader
 
@@ -13,10 +13,10 @@ import HsBindgen.Frontend.RootHeader
 
 -- | Generate C test header and source files
 genTestsC ::
-     FilePath             -- ^ C test header file path
-  -> FilePath             -- ^ C test source file path
-  -> [HashIncludeArg] -- ^ C header paths
-  -> ByCategory [Hs.Decl]            -- ^ Declarations
+     FilePath              -- ^ C test header file path
+  -> FilePath              -- ^ C test source file path
+  -> [HashIncludeArg]      -- ^ C header paths
+  -> ByCategory_ [Hs.Decl] -- ^ Declarations
   -> IO ()
 genTestsC = throwPure_TODO 22 "generate test suite"
 
diff --git a/hs-bindgen/src-internal/HsBindgen/Test/Hs.hs b/hs-bindgen/src-internal/HsBindgen/Test/Hs.hs
index d2ff97eb4..405cdd33c 100644
--- a/hs-bindgen/src-internal/HsBindgen/Test/Hs.hs
+++ b/hs-bindgen/src-internal/HsBindgen/Test/Hs.hs
@@ -2,8 +2,8 @@ module HsBindgen.Test.Hs (
     genTestsHs
   ) where
 
+import HsBindgen.Backend.Category
 import HsBindgen.Backend.Hs.AST qualified as Hs
-import HsBindgen.Backend.SHs.AST
 import HsBindgen.Config
 import HsBindgen.Errors
 
@@ -13,12 +13,12 @@ import HsBindgen.Errors
 
 -- | Generate Haskell test modules
 genTestsHs ::
-     FilePath       -- ^ Test module path
-  -> FilePath       -- ^ Spec module path
-  -> FilePath       -- ^ Main module path
-  -> BaseModuleName -- ^ Generated Haskell module name
-  -> FilePath       -- ^ C test header file path
-  -> ByCategory [Hs.Decl]    -- ^ Declarations
+     FilePath              -- ^ Test module path
+  -> FilePath              -- ^ Spec module path
+  -> FilePath              -- ^ Main module path
+  -> BaseModuleName        -- ^ Generated Haskell module name
+  -> FilePath              -- ^ C test header file path
+  -> ByCategory_ [Hs.Decl] -- ^ Declarations
   -> IO ()
 genTestsHs = throwPure_TODO 22 "generate test suite"
 
diff --git a/hs-bindgen/src/HsBindgen/TH.hs b/hs-bindgen/src/HsBindgen/TH.hs
index d4f8fb3a3..fff225d81 100644
--- a/hs-bindgen/src/HsBindgen/TH.hs
+++ b/hs-bindgen/src/HsBindgen/TH.hs
@@ -39,12 +39,16 @@ module HsBindgen.TH (
   , Predicate.SelectPredicate(..)
   , Select.ProgramSlicing(..)
 
+     -- ** Binding categories
+  , Category.ByCategory(..)
+  , Category.Choice(..)
+  , Category.RenameTerm(..)
+  , Category.useSafeCategory
+  , Category.useUnsafeCategory
+
     -- ** Haddocks
   , Haddock.PathStyle(..)
 
-    -- ** Safety
-  , Safety.Safety(..)
-
     -- ** Tracer
   , Tracer.Verbosity(..)
   , Tracer.Level(..)
@@ -56,8 +60,8 @@ module HsBindgen.TH (
 
 import Data.Default qualified as Default
 
+import HsBindgen.Backend.Category qualified as Category
 import HsBindgen.Backend.Hs.Haddock.Config qualified as Haddock
-import HsBindgen.Backend.SHs.AST qualified as Safety
 import HsBindgen.BindingSpec qualified as BindingSpec
 import HsBindgen.Config qualified as Config
 import HsBindgen.Config.ClangArgs qualified as ClangArgs
diff --git a/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden/Check/PP.hs b/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden/Check/PP.hs
index 7c475ff4f..e6b803bb2 100644
--- a/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden/Check/PP.hs
+++ b/hs-bindgen/test/hs-bindgen/Test/HsBindgen/Golden/Check/PP.hs
@@ -2,8 +2,8 @@
 module Test.HsBindgen.Golden.Check.PP (check) where
 
 import Control.Monad (when)
-import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe)
+import Optics.Core (view)
 import System.Directory (createDirectoryIfMissing)
 import System.FilePath ((</>))
 import Test.Common.Util.Tasty
@@ -14,7 +14,7 @@ import Test.Tasty
 
 import HsBindgen (getBindingsMultiple)
 import HsBindgen hiding (getBindingsMultiple)
-import HsBindgen.Backend.SHs.AST (ByCategory (..))
+import HsBindgen.Backend.Category
 import HsBindgen.Config.Prelims
 import HsBindgen.Errors (panicIO)
 import HsBindgen.Language.Haskell qualified as Hs
@@ -34,7 +34,7 @@ check testResources test =
           -- it can render all modules at the same time, but it's cheap to do so
           -- in practice.
           let artefacts = (,) <$> FinalModuleBaseName <*> getBindingsMultiple
-          (baseName,(ByCategory output))
+          (baseName, output)
             <- runTestHsBindgen report testResources test artefacts
 
           -- A sanity check to make sure that that the modules we're rendering
@@ -42,11 +42,13 @@ check testResources test =
           when (baseName /= "Example") $
             panicIO "The module base name should be Example!"
 
+
           -- Render the Haskell module
-          let ppOutput = fromMaybe (renderEmptyModule bc) (output Map.!? bc)
+          let ppOutput =
+                fromMaybe (renderEmptyModule bc) (view (lensForCategory bc) output)
           return $ ActualValue ppOutput
 
-      | (bc :: BindingCategory) <- [minBound .. maxBound]
+      | (bc :: Category) <- allCategories
       ]
   where
     -- === Filepaths
@@ -71,7 +73,7 @@ check testResources test =
           (\_ -> k)
 
     -- | The names of sub-modules are based solely on the binding category
-    fixture :: BindingCategory -> FilePath
+    fixture :: Category -> FilePath
     fixture bc = testOutputDir test </> Hs.moduleNamePath moduleName
       where
         moduleName :: Hs.ModuleName
@@ -85,7 +87,7 @@ check testResources test =
     -- compile!) with the correct module name.
 
     -- | Render an empty module
-    renderEmptyModule :: BindingCategory -> String
+    renderEmptyModule :: Category -> String
     renderEmptyModule bc = concat [
           "module "
         , Hs.moduleNameToString moduleName
diff --git a/hs-bindgen/test/th/Test/TH/Simple.hs b/hs-bindgen/test/th/Test/TH/Simple.hs
index 8c238c6be..23a6939be 100644
--- a/hs-bindgen/test/th/Test/TH/Simple.hs
+++ b/hs-bindgen/test/th/Test/TH/Simple.hs
@@ -1,3 +1,5 @@
+-- {-# OPTIONS_GHC -ddump-splices #-}
+
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE MagicHash #-}
@@ -26,6 +28,7 @@ let cfg :: Config
     cfgTH = def
               & #verbosity .~ Verbosity Warning
               & #customLogLevelSettings .~ [EnableMacroWarnings]
+              & #bindingCategoryChoice .~ useUnsafeCategory
  in withHsBindgen cfg cfgTH $
       hashInclude "simple.h"