diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 4 |
7 files changed, 13 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 44841bc5..1f55db10 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -244,9 +244,9 @@ 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 con_args' where - f (PrefixCon args) = [typeSig name $ (map hsScaledThing args) ++ [resType]] - f (InfixCon a1 a2) = f $ PrefixCon [a1,a2] - f (RecCon (L _ recs)) = f (PrefixCon $ map (hsLinear . cd_fld_type . unLoc) recs) ++ concat + f (PrefixCon _ args) = [typeSig name $ (map hsScaledThing args) ++ [resType]] + f (InfixCon a1 a2) = f $ PrefixCon [] [a1,a2] + f (RecCon (L _ recs)) = f (PrefixCon [] $ map (hsLinear . cd_fld_type . unLoc) recs) ++ concat [(concatMap (lookupCon dflags subdocs . noLoc . extFieldOcc . unLoc) (cd_fld_names r)) ++ [out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] | r <- map unLoc recs] diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 3a774ace..f9480a47 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -784,7 +784,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = header_ = ppConstrHdr forall_ tyVars context unicode in case det of -- Prefix constructor, e.g. 'Just a' - PrefixCon args + PrefixCon _ args | hasArgDocs -> header_ <+> ppOcc | otherwise -> hsep [ header_ , ppOcc @@ -823,7 +823,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = -- H98 record declarations RecCon (L _ fields) -> doRecordFields fields -- H98 prefix data constructors - PrefixCon args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args) + PrefixCon _ args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args) -- H98 infix data constructor InfixCon arg1 arg2 | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2]) _ -> empty diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 8b9739f1..e9806471 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -845,7 +845,7 @@ ppShortConstrParts summary dataInst con unicode qual in case det of -- Prefix constructor, e.g. 'Just a' - PrefixCon args -> + PrefixCon _ args -> ( header_ +++ hsep (ppOcc : map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args) , noHtml @@ -918,7 +918,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) header_ = ppConstrHdr forall_ tyVars context unicode qual in case det of -- Prefix constructor, e.g. 'Just a' - PrefixCon args + PrefixCon _ args | hasArgDocs -> header_ +++ ppOcc <+> fixity | otherwise -> hsep [ header_ +++ ppOcc , hsep (map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args) @@ -959,7 +959,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) -- H98 record declarations RecCon (L _ fields) -> [ doRecordFields fields ] -- H98 prefix data constructors - PrefixCon args | hasArgDocs -> [ doConstrArgsWithDocs args ] + PrefixCon _ args | hasArgDocs -> [ doConstrArgsWithDocs args ] -- H98 infix data constructor InfixCon arg1 arg2 | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ] _ -> [] diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 5f9940fc..b59602b6 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -398,7 +398,7 @@ synifyDataCon use_gadt_syntax dc = mk_h98_arg_tys = case (use_named_field_syntax, use_infix_syntax) of (True,True) -> Left "synifyDataCon: contradiction!" (True,False) -> return $ RecCon (noLoc field_tys) - (False,False) -> return $ PrefixCon (map hsUnrestricted linear_tys) + (False,False) -> return $ PrefixCon noTypeArgs (map hsUnrestricted linear_tys) (False,True) -> case linear_tys of [a,b] -> return $ InfixCon (hsUnrestricted a) (hsUnrestricted b) _ -> Left "synifyDataCon: infix with non-2 args?" diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a0e56f07..8bc8d306 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -948,7 +948,7 @@ extractPatternSyn nm t tvs cons = let args = case con of ConDeclH98 { con_args = con_args' } -> case con_args' of - PrefixCon args' -> map hsScaledThing args' + PrefixCon _ args' -> map hsScaledThing args' RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields InfixCon arg1 arg2 -> map hsScaledThing [arg1, arg2] ConDeclGADT { con_g_args = con_args' } -> case con_args' of diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index a1e712e0..5d7b4f1a 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -516,7 +516,7 @@ renameH98Details :: HsConDeclH98Details GhcRn renameH98Details (RecCon (L l fields)) = do fields' <- mapM renameConDeclFieldField fields return (RecCon (L l fields')) -renameH98Details (PrefixCon ps) = PrefixCon <$> mapM renameHsScaled ps +renameH98Details (PrefixCon ts ps) = PrefixCon ts <$> mapM renameHsScaled ps renameH98Details (InfixCon a b) = do a' <- renameHsScaled a b' <- renameHsScaled b diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index aec7f9ab..8186e3b7 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -210,10 +210,10 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] ConDeclGADT { con_g_args = args } -> restrict_gadt_args args where restrict_h98_args :: HsConDeclH98Details GhcRn -> Maybe (ConDecl GhcRn) - restrict_h98_args (PrefixCon _) = Just d + restrict_h98_args (PrefixCon _ _) = Just d restrict_h98_args (RecCon (L _ fields)) | all field_avail fields = Just d - | otherwise = Just (d { con_args = PrefixCon (field_types fields) }) + | otherwise = Just (d { con_args = PrefixCon noTypeArgs (field_types fields) }) -- if we have *all* the field names available, then -- keep the record declaration. Otherwise degrade to -- a constructor declaration. This isn't quite right, but |