diff --git a/effectful-th/src/Effectful/TH.hs b/effectful-th/src/Effectful/TH.hs index ba70aed..6f82818 100644 --- a/effectful-th/src/Effectful/TH.hs +++ b/effectful-th/src/Effectful/TH.hs @@ -53,6 +53,9 @@ import Effectful.Dispatch.Dynamic -- lowercase or removes the @:@ symbol in case of operators. Any fixity -- annotations defined for the constructors are preserved for the corresponding -- definitions. +-- +-- If the constructor declaration has Haddock, then this is reused for the +-- sending functions, otherwise a simple placeholder is used. makeEffect :: Name -> Q [Dec] makeEffect = makeEffectImpl True @@ -246,10 +249,15 @@ makeTyp esVar substM resTy = \case withHaddock :: Name -> [Dec] -> Q [Dec] #if MIN_VERSION_template_haskell(2,18,0) -withHaddock name dec = withDecsDoc - ("Perform the operation '" ++ nameBase name ++ "'.") (pure dec) +withHaddock name decs = do + existingHaddock <- getDoc (DeclDoc name) + let newDoc = + case existingHaddock of + Just doc -> doc + Nothing -> "Perform the operation '" ++ nameBase name ++ "'." + withDecsDoc newDoc (pure decs) #else -withHaddock _ dec = pure dec +withHaddock _ decs = pure decs #endif checkRequiredExtensions :: Q () diff --git a/effectful-th/tests/ThTests.hs b/effectful-th/tests/ThTests.hs index d119749..634f2d9 100644 --- a/effectful-th/tests/ThTests.hs +++ b/effectful-th/tests/ThTests.hs @@ -16,6 +16,7 @@ main = pure () -- only compilation tests data SimpleADT (m :: Type -> Type) (a :: Type) = SimpleADTC1 Int | SimpleADTC2 String + -- ^ This one does the second thing -- Test generation of fixity information. infixl 1 `SimpleADTC1` @@ -40,6 +41,7 @@ makeEffect ''ADTSyntax3 data GADTSyntax :: Effect where GADTSyntaxC1 :: Int -> GADTSyntax m Int + -- | I am documented GADTSyntaxC2 :: String -> GADTSyntax m String GADTSyntaxC3 :: IOE :> es => Bool -> GADTSyntax (Eff es) a