aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
authorCale Gibbard <cgibbard@gmail.com>2020-07-30 14:00:19 -0400
committerRichard Eisenberg <rae@richarde.dev>2020-11-25 23:18:35 -0500
commitacf235d607879eb9542127eb0ddb42a250b5b850 (patch)
treeab41b4f5840cd6a7631e4f2b2c94da010e88e614 /haddock-api
parent8d260690b53f2fb6b54ba78bd13d1400d9ebd395 (diff)
Add type arguments to PrefixCon
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs6
-rw-r--r--haddock-api/src/Haddock/Convert.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs2
-rw-r--r--haddock-api/src/Haddock/Utils.hs4
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