aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2014-09-09 01:03:27 -0500
committerAustin Seipp <aseipp@pobox.com>2015-01-23 07:17:19 -0600
commit89fc5605c865d0e0ce5ed7e396102e678426533b (patch)
tree873726ccbc276f413a793e537c015e8445951e5b /haddock-api/src/Haddock/Interface
parentdf0239b587e2a25531962f5b46f715ebb9b09685 (diff)
Follow API changes in D538
Signed-off-by: Austin Seipp <aseipp@pobox.com> (cherry picked from commit d61bbc75890e4eb0ad508b9c2a27b91f691213e6)
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs18
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs18
2 files changed, 18 insertions, 18 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 98a715a9..9ef3d1b1 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -194,8 +194,8 @@ moduleWarning dflags gre (WarnAll w) = Just $ parseWarning dflags gre w
parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> Doc Name
parseWarning dflags gre w = force $ case w of
- DeprecatedTxt msg -> format "Deprecated: " (concatFS $ map unLoc msg)
- WarningTxt msg -> format "Warning: " (concatFS $ map unLoc msg)
+ DeprecatedTxt _ msg -> format "Deprecated: " (concatFS $ map unLoc msg)
+ WarningTxt _ msg -> format "Warning: " (concatFS $ map unLoc msg)
where
format x xs = DocWarning . DocParagraph . DocAppend (DocString x)
. processDocString dflags gre $ HsDocString xs
@@ -335,7 +335,7 @@ subordinates instMap decl = case decl of
| c <- cons, cname <- con_names c ]
fields = [ (unL n, maybeToList $ fmap unL doc, M.empty)
| RecCon flds <- map con_details cons
- , L _ (ConDeclField ns _ doc) <- flds
+ , L _ (ConDeclField ns _ doc) <- (unLoc flds)
, n <- ns ]
-- | Extract function argument docs from inside types.
@@ -496,7 +496,7 @@ mkExportItems
Just exports -> liftM concat $ mapM lookupExport exports
where
lookupExport (IEVar (L _ x)) = declWith x
- lookupExport (IEThingAbs t) = declWith t
+ lookupExport (IEThingAbs (L _ t)) = declWith t
lookupExport (IEThingAll (L _ t)) = declWith t
lookupExport (IEThingWith (L _ t) _) = declWith t
lookupExport (IEModuleContents (L _ m)) =
@@ -553,7 +553,7 @@ mkExportItems
L loc (TyClD cl@ClassDecl{}) -> do
mdef <- liftGhcToErrMsgGhc $ minimalDef t
- let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
return [ mkExportDecl t
(L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
@@ -745,7 +745,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
mdef <- liftGhcToErrMsgGhc $ minimalDef name
- let sig = maybeToList $ fmap (noLoc . MinimalSig . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
mkExportItem decl@(L l d)
| name:_ <- getMainDeclBinder d = expDecl decl l name
@@ -785,7 +785,7 @@ extractDecl name mdl decl
InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
let matches = [ d | L _ d <- insts
, L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
- , ConDeclField { cd_fld_names = ns } <- map unLoc rec
+ , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
, L _ n <- ns
, n == name
]
@@ -818,13 +818,13 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm mdl t tvs (L _ con : rest) =
case con_details con of
- RecCon fields | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
+ RecCon (L _ fields) | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))) [])
_ -> extractRecSel nm mdl t tvs rest
where
matching_fields flds = [ (n,f) | f@(L _ (ConDeclField ns _ _)) <- flds, n <- ns, unLoc n == nm ]
data_ty
- | ResTyGADT ty <- con_res con = ty
+ | ResTyGADT _ ty <- con_res con = ty
| otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 7f69b91e..ee9f8fc4 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -250,10 +250,10 @@ renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
renameLTyVarBndr (L loc (UserTyVar n))
= do { n' <- rename n
; return (L loc (UserTyVar n')) }
-renameLTyVarBndr (L loc (KindedTyVar n kind))
+renameLTyVarBndr (L loc (KindedTyVar (L lv n) kind))
= do { n' <- rename n
; kind' <- renameLKind kind
- ; return (L loc (KindedTyVar n' kind')) }
+ ; return (L loc (KindedTyVar (L lv n') kind')) }
renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
renameLContext (L loc context) = do
@@ -330,9 +330,9 @@ renameTyClD d = case d of
where
renameLFunDep (L loc (xs, ys)) = do
- xs' <- mapM rename xs
- ys' <- mapM rename ys
- return (L loc (xs', ys'))
+ xs' <- mapM rename (map unLoc xs)
+ ys' <- mapM rename (map unLoc ys)
+ return (L loc (map noLoc xs', map noLoc ys'))
renameLSig (L loc sig) = return . L loc =<< renameSig sig
@@ -377,9 +377,9 @@ renameCon decl@(ConDecl { con_names = lnames, con_qvars = ltyvars
, con_details = details', con_res = restype', con_doc = mbldoc' })
where
- renameDetails (RecCon fields) = do
+ renameDetails (RecCon (L l fields)) = do
fields' <- mapM renameConDeclFieldField fields
- return (RecCon fields')
+ return (RecCon (L l fields'))
renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
renameDetails (InfixCon a b) = do
a' <- renameLType a
@@ -387,7 +387,7 @@ renameCon decl@(ConDecl { con_names = lnames, con_qvars = ltyvars
return (InfixCon a' b')
renameResType (ResTyH98) = return ResTyH98
- renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
+ renameResType (ResTyGADT l t) = return . ResTyGADT l =<< renameLType t
renameConDeclFieldField :: LConDeclField Name -> RnM (LConDeclField DocName)
@@ -414,7 +414,7 @@ renameSig sig = case sig of
FixSig (FixitySig lnames fixity) -> do
lnames' <- mapM renameL lnames
return $ FixSig (FixitySig lnames' fixity)
- MinimalSig s -> MinimalSig <$> traverse renameL s
+ MinimalSig src s -> MinimalSig src <$> traverse renameL s
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"