diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-10-24 10:38:55 -0400 | 
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-10-30 04:53:05 -0400 | 
| commit | 3cce1bdee8c61bb6daa089059e12435178f50770 (patch) | |
| tree | 32cb09fe0afa9753bf82fd90bd7016336439fc7b /haddock-api/src/Haddock/Backends | |
| parent | 87a9f86d1ad7de67ff011311905ecf76578b26e9 (diff) | |
Adapt to HsConDecl{H98,GADT}Details split
Needed for GHC#18844.
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 30 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 30 | 
3 files changed, 34 insertions, 30 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index c9aad6ed..8939664d 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -236,9 +236,9 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of    _ -> []  ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String] -ppCtor dflags dat subdocs con@ConDeclH98 {} +ppCtor dflags dat subdocs con@ConDeclH98 { con_args = con_args' }    -- AZ:TODO get rid of the concatMap -   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f (getConArgs con) +   = concatMap (lookupCon dflags subdocs) [con_name con] ++ f con_args'      where          f (PrefixCon args) = [typeSig name $ (map hsScaledThing args) ++ [resType]]          f (InfixCon a1 a2) = f $ PrefixCon [a1,a2] diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index a90d9a6e..d0528322 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -796,20 +796,22 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =                              , ppLType unicode (getGADTConType con)                              ] -    fieldPart = case (con, getConArgsI con) of -        -- Record style GADTs -        (ConDeclGADT{}, RecCon _)            -> doConstrArgsWithDocs [] - -        -- Regular record declarations -        (_, RecCon (L _ fields))             -> doRecordFields fields - -        -- Any GADT or a regular H98 prefix data constructor -        (_, PrefixCon args)     | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args) - -        -- An infix H98 data constructor -        (_, InfixCon arg1 arg2) | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2]) - -        _ -> empty +    fieldPart = case con of +        ConDeclGADT{con_g_args = con_args'} -> case con_args' of +          -- GADT record declarations +          RecConGADT _                    -> doConstrArgsWithDocs [] +          -- GADT prefix data constructors +          PrefixConGADT args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args) +          _                               -> empty + +        ConDeclH98{con_args = con_args'} -> case con_args' of +          -- H98 record declarations +          RecCon (L _ fields)             -> doRecordFields fields +          -- H98 prefix data constructors +          PrefixCon args | hasArgDocs     -> doConstrArgsWithDocs (map hsScaledThing args) +          -- H98 infix data constructor +          InfixCon arg1 arg2 | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2]) +          _                               -> empty      doRecordFields fields =        vcat [ empty <-> tt (text begin) <+> ppSideBySideField subdocs unicode field <+> nl diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 20e099ee..d80f8e95 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -937,20 +937,22 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)                                , fixity                                ] -    fieldPart = case (con, getConArgsI con) of -        -- Record style GADTs -        (ConDeclGADT{}, RecCon _)            -> [ doConstrArgsWithDocs [] ] - -        -- Regular record declarations -        (_, RecCon (L _ fields))             -> [ doRecordFields fields ] - -        -- Any GADT or a regular H98 prefix data constructor -        (_, PrefixCon args)     | hasArgDocs -> [ doConstrArgsWithDocs args ] - -        -- An infix H98 data constructor -        (_, InfixCon arg1 arg2) | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ] - -        _ -> [] +    fieldPart = case con of +        ConDeclGADT{con_g_args = con_args'} -> case con_args' of +          -- GADT record declarations +          RecConGADT _                    -> [ doConstrArgsWithDocs [] ] +          -- GADT prefix data constructors +          PrefixConGADT args | hasArgDocs -> [ doConstrArgsWithDocs args ] +          _                               -> [] + +        ConDeclH98{con_args = con_args'} -> case con_args' of +          -- H98 record declarations +          RecCon (L _ fields)             -> [ doRecordFields fields ] +          -- H98 prefix data constructors +          PrefixCon args | hasArgDocs     -> [ doConstrArgsWithDocs args ] +          -- H98 infix data constructor +          InfixCon arg1 arg2 | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ] +          _                               -> []      doRecordFields fields = subFields pkg qual        (map (ppSideBySideField subdocs unicode qual) (map unLoc fields))  | 
