diff options
Diffstat (limited to 'haddock-api')
| -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  | 
