diff options
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 8 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 5 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Types.hs | 13 | 
5 files changed, 23 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 59e5af3e..47087911 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -562,7 +562,7 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead  ppInstHead :: Bool -> InstHead DocName -> LaTeX  ppInstHead unicode (InstHead {..}) = case ihdInstType of -    ClassInst ctx -> ppContextNoLocs ctx unicode <+> typ +    ClassInst ctx _ _ -> ppContextNoLocs ctx unicode <+> typ      TypeInst rhs -> keyword "type" <+> typ <+> tibody rhs      DataInst _ -> error "data instances not supported by --latex yet"    where diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 67405915..a894972e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -531,13 +531,13 @@ ppInstHead :: LinksInfo -> Splice -> Unicode -> Qualification             -> Html  ppInstHead links splice unicode qual iid mspec ihead@(InstHead {..}) =      case ihdInstType of -        ClassInst cs | Just spec <- mspec -> +        ClassInst cs _ _ | Just spec <- mspec ->              subClsInstance (nameStr ++ "-" ++ show iid) hdr (mets spec ihead)            where              hdr = ppContextNoLocs cs unicode qual <+> typ              mets = ppInstanceSigs links splice unicode qual              nameStr = occNameString . nameOccName $ getName ihdClsName -        ClassInst cs -> ppContextNoLocs cs unicode qual <+> typ +        ClassInst cs _ _ -> ppContextNoLocs cs unicode qual <+> typ          TypeInst rhs -> keyword "type" <+> typ              <+> maybe noHtml (\t -> equals <+> ppType unicode qual t) rhs          DataInst dd -> keyword "data" <+> typ diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index e51d9df7..3479780a 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -390,11 +390,15 @@ synifyKindSig :: Kind -> LHsKind Name  synifyKindSig k = synifyType WithinType k  synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name -synifyInstHead (_, preds, cls, types) = InstHead +synifyInstHead (tyvars, preds, cls, types) = InstHead    { ihdClsName = getName cls    , ihdKinds = map (unLoc . synifyType WithinType) ks    , ihdTypes = map (unLoc . synifyType WithinType) ts -  , ihdInstType = ClassInst $ map (unLoc . synifyType WithinType) preds +  , ihdInstType = ClassInst +      { clsiCtx = map (unLoc . synifyType WithinType) preds +      , clsiTyVars = synifyTyVars tyvars +      , clsiSigs = map (synifyIdSig WithinType) $ classMethods cls +      }    }    where (ks,ts) = break (not . isKind) types diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 44635318..4e4d3ed9 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -264,7 +264,10 @@ renameInstHead InstHead {..} = do    kinds <- mapM renameType ihdKinds    types <- mapM renameType ihdTypes    itype <- case ihdInstType of -    ClassInst cs -> ClassInst <$> mapM renameType cs +    ClassInst ctx bndrs sigs -> ClassInst +        <$> mapM renameType ctx +        <*> renameLTyVarBndrs bndrs +        <*> mapM renameSig sigs      TypeInst  ts -> TypeInst  <$> traverse renameType ts      DataInst  dd -> DataInst  <$> renameTyClD dd    return InstHead diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index c5ca31c0..0c130cb1 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}  {-# OPTIONS_GHC -fno-warn-orphans #-}  -----------------------------------------------------------------------------  -- | @@ -324,12 +324,19 @@ instance SetName DocName where  -- | The three types of instances  data InstType name -  = ClassInst [HsType name]         -- ^ Context +  = ClassInst +      { clsiCtx :: [HsType name] +      , clsiTyVars :: LHsTyVarBndrs name +      , clsiSigs :: [Sig name] +      }    | TypeInst  (Maybe (HsType name)) -- ^ Body (right-hand side)    | DataInst (TyClDecl name)        -- ^ Data constructors  instance OutputableBndr a => Outputable (InstType a) where -  ppr (ClassInst a) = text "ClassInst" <+> ppr a +  ppr (ClassInst { .. }) = text "ClassInst" +      <+> ppr clsiCtx +      <+> ppr clsiTyVars +      <+> ppr clsiSigs    ppr (TypeInst  a) = text "TypeInst"  <+> ppr a    ppr (DataInst  a) = text "DataInst"  <+> ppr a  | 
