Add annotation API for verifying fusion

CHANGELOG.md

@@ -1,3 +1,8 @@
+## 0.1.1
+
+* Add `Inspect`, `FuseSpec`, `checkFusion`, `forbid`, `allow`, `forbidTypes`,
+  and `allowOnlyTypes` for per-binding fusion inspection via `ANN` pragmas.
+
 ## 0.1.0
 
 * Initial release

fusion-plugin-types.cabal

@@ -1,7 +1,7 @@
 cabal-version:       2.2
 
 name:                fusion-plugin-types
-version:             0.1.0
+version:             0.1.1
 synopsis:            Types for the fusion-plugin package.
 description:         GHC package that provides types that when used in a package can be identified by the <https://hackage.haskell.org/package/fusion-plugin fusion-plugin> package to perform any extra optimizations.
 homepage:            https://github.com/composewell/fusion-plugin-types
@@ -26,6 +26,7 @@ source-repository head
 library
   exposed-modules:   Fusion.Plugin.Types
   build-depends:     base >= 4.0 && < 5.0
+                   , template-haskell
   hs-source-dirs:    src
   ghc-options:       -Wall
   if impl(ghc >= 8.0)

src/Fusion/Plugin/Types.hs

@@ -11,10 +11,18 @@
 
 module Fusion.Plugin.Types
   ( Fuse(..)
+  , Inspect(..)
+  , FuseSpec
+  , checkFusion
+  , forbid
+  , allow
+  , forbidTypes
+  , allowOnlyTypes
   )
 where
 
 import Data.Data (Data)
+import Language.Haskell.TH.Syntax (Name)
 
 -- | A GHC annotation to inform the plugin to aggressively inline join points
 -- that perform a case match on the constructors of the annotated type.
@@ -36,3 +44,86 @@ import Data.Data (Data)
 -- @
 data Fuse = Fuse
     deriving (Eq, Data)
+
+-- | A GHC annotation attached to a specific top level binding (via an
+-- @ANN@ pragma on the binding, not on a type) that requests a focused
+-- fusion report for just that binding, independent of the module-wide
+-- @-fplugin-opt=Fusion.Plugin:verbose=N@ flag.
+--
+-- Build values of this type via 'checkFusion', 'forbidTypes', or
+-- 'allowOnlyTypes' rather than the raw constructors.
+--
+-- Type references are Template Haskell 'Name's (e.g. @''Step@), not plain
+-- strings. This means a typo, or a later rename of the referenced type in
+-- source, is caught by GHC's ordinary renamer when the @ANN@ pragma itself
+-- is compiled -- a "not in scope" compile error, not a silently-stale
+-- check. Using @''Foo@ requires @{-\# LANGUAGE TemplateHaskellQuotes \#-}@
+-- (or the heavier @TemplateHaskell@) in the annotated module.
+data Inspect
+    = ForbidTypes [Name]
+    -- ^ Built via 'forbidTypes'.
+    | CheckFusion [Name] [Name]
+    -- ^ Built via 'checkFusion'.
+    | AllowOnlyTypes [Name]
+    -- ^ Built via 'allowOnlyTypes'.
+    deriving (Eq, Data)
+
+-- | A composable specification of extra types to forbid, and types to
+-- allow, on top of the baseline set of 'Fuse'-annotated types checked by
+-- 'checkFusion'. Build one with 'forbid' and/or 'allow' and combine them
+-- with @('<>')@; 'mempty' means "just the baseline".
+data FuseSpec = FuseSpec
+    { fuseSpecForbid :: [Name]
+    , fuseSpecAllow :: [Name]
+    }
+
+instance Semigroup FuseSpec where
+    FuseSpec f1 a1 <> FuseSpec f2 a2 = FuseSpec (f1 <> f2) (a1 <> a2)
+
+instance Monoid FuseSpec where
+    mempty = FuseSpec [] []
+
+-- | Also forbid the named types, even though they carry no 'Fuse'
+-- annotation. Used with 'checkFusion'.
+forbid :: [Name] -> FuseSpec
+forbid names = mempty { fuseSpecForbid = names }
+
+-- | Allow the named types even if they are 'Fuse'-annotated or otherwise
+-- forbidden -- an overriding allow-list. Used with 'checkFusion'.
+allow :: [Name] -> FuseSpec
+allow names = mempty { fuseSpecAllow = names }
+
+-- | Report occurrences of every 'Fuse'-annotated type found in the binding
+-- -- the same base set the module-wide report uses -- plus any types named
+-- via 'forbid', minus any types named via 'allow'. A name present in both
+-- is allowed (the allow-list wins). @checkFusion mempty@ enforces just the
+-- baseline: nothing 'Fuse'-annotated may survive to core.
+--
+-- @
+-- {-\# ANN function1 (checkFusion mempty) #-}
+-- {-\# ANN function1a (checkFusion (forbid [''Text])) #-}
+-- {-\# ANN function1b (checkFusion (forbid [''Text] <> allow [''ByteString])) #-}
+-- @
+checkFusion :: FuseSpec -> Inspect
+checkFusion (FuseSpec f a) = CheckFusion f a
+
+-- | Blocklist: report occurrences of exactly the named types/constructors
+-- found anywhere in the binding, regardless of whether they carry a 'Fuse'
+-- annotation. Everything else in core is fine.
+--
+-- @
+-- {-\# ANN function2 (forbidTypes [''SomeType]) #-}
+-- @
+forbidTypes :: [Name] -> Inspect
+forbidTypes = ForbidTypes
+
+-- | Allowlist: report occurrences of literally every type/constructor found
+-- in the binding -- a general "boxing detector", not limited to
+-- 'Fuse'-annotated types -- except the named types, which may appear
+-- freely.
+--
+-- @
+-- {-\# ANN function3 (allowOnlyTypes [''Int, ''IO]) #-}
+-- @
+allowOnlyTypes :: [Name] -> Inspect
+allowOnlyTypes = AllowOnlyTypes