...
 
Commits (31)
......@@ -145,7 +145,7 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
where
addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
addContext (MinimalSig sig) = MinimalSig sig
addContext (MinimalSig src sig) = MinimalSig src sig
addContext _ = error "expected TypeSig"
f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d
......@@ -189,7 +189,7 @@ ppCtor dflags dat subdocs con
where
f (PrefixCon args) = [typeSig name $ args ++ [resType]]
f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
f (RecCon recs) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
[(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++
[out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
| r <- map unLoc recs]
......@@ -203,7 +203,7 @@ ppCtor dflags dat subdocs con
resType = case con_res con of
ResTyH98 -> apps $ map (reL . HsTyVar) $
(tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
ResTyGADT x -> x
ResTyGADT _ x -> x
---------------------------------------------------------------------
......
......@@ -477,7 +477,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
-> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Bool -> LaTeX
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
......@@ -486,13 +486,13 @@ ppClassHdr summ lctxt n tvs fds unicode =
<+> ppFds fds unicode
ppFds :: [Located ([DocName], [DocName])] -> Bool -> LaTeX
ppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds fds unicode =
if null fds then empty else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> arrow unicode <+>
hsep (map ppDocName vars2)
fundep (vars1,vars2) = hsep (map (ppDocName . unLoc) vars1) <+> arrow unicode <+>
hsep (map (ppDocName . unLoc) vars2)
ppClassDecl :: [DocInstance DocName] -> SrcSpan
......@@ -598,8 +598,8 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
(whereBit, leaders)
| null cons = (empty,[])
| otherwise = case resTy of
ResTyGADT _ -> (decltt (keyword "where"), repeat empty)
_ -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
ResTyGADT _ _ -> (decltt (keyword "where"), repeat empty)
_ -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
constrBit
| null cons = Nothing
......@@ -636,7 +636,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
map (ppLParendType unicode) args))
<-> rDoc mbDoc <+> nl
RecCon fields ->
RecCon (L _ fields) ->
(decltt (header_ unicode <+> ppOcc)
<-> rDoc mbDoc <+> nl)
$$
......@@ -648,11 +648,11 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
ppLParendType unicode arg2 ])
<-> rDoc mbDoc <+> nl
ResTyGADT resTy -> case con_details con of
ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> doGADTCon args resTy
cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
doRecordFields fields
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
......@@ -948,8 +948,8 @@ ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
ppr_tylit :: HsTyLit -> Bool -> LaTeX
ppr_tylit (HsNumTy n) _ = integer n
ppr_tylit (HsStrTy s) _ = text (show s)
ppr_tylit (HsNumTy _ n) _ = integer n
ppr_tylit (HsStrTy _ s) _ = text (show s)
-- XXX: Ok in verbatim, but not otherwise
-- XXX: Do something with Unicode parameter?
......
......@@ -146,7 +146,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
ppForAll :: LHsTyVarBndrs DocName -> Unicode -> Qualification -> Html
ppForAll tvs unicode qual =
case [ppKTv n k | L _ (KindedTyVar n k) <- hsQTvBndrs tvs] of
case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- hsQTvBndrs tvs] of
[] -> noHtml
ts -> forallSymbol unicode <+> hsep ts +++ dot
where ppKTv n k = parens $
......@@ -381,7 +381,7 @@ ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
-> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
-> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Unicode -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
......@@ -390,13 +390,13 @@ ppClassHdr summ lctxt n tvs fds unicode qual =
<+> ppFds fds unicode qual
ppFds :: [Located ([DocName], [DocName])] -> Unicode -> Qualification -> Html
ppFds :: [Located ([Located DocName], [Located DocName])] -> Unicode -> Qualification -> Html
ppFds fds unicode qual =
if null fds then noHtml else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
ppVars = hsep . map (ppDocName qual Prefix True)
ppVars = hsep . map ((ppDocName qual Prefix True) . unLoc)
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-> [(DocName, DocForDecl DocName)]
......@@ -470,7 +470,7 @@ ppClassDecl summary links instances fixities loc d subdocs
-- there are different subdocs for different names in a single
-- type signature?
minimalBit = case [ s | L _ (MinimalSig s) <- lsigs ] of
minimalBit = case [ s | L _ (MinimalSig _ s) <- lsigs ] of
-- Miminal complete definition = every shown method
And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
sort [getName n | L _ (TypeSig ns _ _) <- lsigs, L _ n <- ns]
......@@ -572,7 +572,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
whereBit
| null cons = noHtml
| otherwise = case resTy of
ResTyGADT _ -> keyword "where"
ResTyGADT _ _ -> keyword "where"
_ -> noHtml
constrBit = subConstructors qual
......@@ -600,7 +600,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
PrefixCon args ->
(header_ unicode qual +++ hsep (ppOcc
: map (ppLParendType unicode qual) args), noHtml, noHtml)
RecCon fields ->
RecCon (L _ fields) ->
(header_ unicode qual +++ ppOcc <+> char '{',
doRecordFields fields,
char '}')
......@@ -609,7 +609,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
ppOccInfix, ppLParendType unicode qual arg2],
noHtml, noHtml)
ResTyGADT resTy -> case con_details con of
ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
......@@ -617,7 +617,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
-- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
-- (except each field gets its own line in docs, to match
-- non-GADT records)
RecCon fields -> (ppOcc <+> dcolon unicode <+>
RecCon (L _ fields) -> (ppOcc <+> dcolon unicode <+>
ppForAllCon forall_ ltvs lcontext unicode qual <+> char '{',
doRecordFields fields,
char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
......@@ -682,7 +682,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
ppLParendType unicode qual arg2]
<+> fixity
ResTyGADT resTy -> case con_details con of
ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> doGADTCon args resTy
......@@ -690,7 +690,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
fieldPart = case con_details con of
RecCon fields -> [doRecordFields fields]
RecCon (L _ fields) -> [doRecordFields fields]
_ -> []
doRecordFields fields = subFields qual
......@@ -907,8 +907,8 @@ ppr_mono_ty _ (HsNamedWildcardTy name) _ q = ppDocName q Prefix True name
ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
ppr_tylit :: HsTyLit -> Html
ppr_tylit (HsNumTy n) = toHtml (show n)
ppr_tylit (HsStrTy s) = toHtml (show s)
ppr_tylit (HsNumTy _ n) = toHtml (show n)
ppr_tylit (HsStrTy _ s) = toHtml (show s)
ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html
......
......@@ -32,7 +32,7 @@ import Kind ( splitKindFunTys, synTyConResKind, isKind )
import Name
import PatSyn
import PrelNames (ipClassName)
import SrcLoc ( Located, noLoc, unLoc )
import SrcLoc ( Located, noLoc, unLoc, noSrcSpan )
import TcType ( tcSplitSigmaTy )
import TyCon
import Type (isStrLitTy, mkFunTys)
......@@ -75,9 +75,9 @@ tyThingToLHsDecl t = case t of
, tcdLName = synifyName cl
, tcdTyVars = synifyTyVars (classTyVars cl)
, tcdFDs = map (\ (l,r) -> noLoc
(map getName l, map getName r) ) $
(map (noLoc . getName) l, map (noLoc . getName) r) ) $
snd $ classTvsFds cl
, tcdSigs = noLoc (MinimalSig . fmap noLoc $ classMinimalDef cl) :
, tcdSigs = noLoc (MinimalSig mempty . fmap noLoc $ classMinimalDef cl) :
map (noLoc . synifyIdSig DeleteTopLevelQuantification)
(classMethods cl)
, tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
......@@ -146,7 +146,7 @@ synifyTyCon coax tc
DataDecl { tcdLName = synifyName tc
, tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up:
let mk_hs_tv realKind fakeTyVar
= noLoc $ KindedTyVar (getName fakeTyVar)
= noLoc $ KindedTyVar (noLoc (getName fakeTyVar))
(synifyKindSig realKind)
in HsQTvs { hsq_kvs = [] -- No kind polymorphism
, hsq_tvs = zipWith mk_hs_tv (fst (splitKindFunTys (tyConKind tc)))
......@@ -265,27 +265,27 @@ synifyDataCon use_gadt_syntax dc =
linear_tys = zipWith (\ty bang ->
let tySyn = synifyType WithinType ty
src_bang = case bang of
HsUnpack {} -> HsUserBang (Just True) True
HsStrict -> HsUserBang (Just False) True
HsUnpack {} -> HsSrcBang Nothing (Just True) True
HsStrict -> HsSrcBang Nothing (Just False) True
_ -> bang
in case src_bang of
HsNoBang -> tySyn
_ -> noLoc $ HsBangTy bang tySyn
-- HsNoBang never appears, it's implied instead.
)
arg_tys (dataConStrictMarks dc)
arg_tys (dataConSrcBangs dc)
field_tys = zipWith (\field synTy -> noLoc $ ConDeclField
[synifyName field] synTy Nothing)
(dataConFieldLabels dc) linear_tys
hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
(True,True) -> Left "synifyDataCon: contradiction!"
(True,False) -> return $ RecCon field_tys
(True,False) -> return $ RecCon (noLoc field_tys)
(False,False) -> return $ PrefixCon linear_tys
(False,True) -> case linear_tys of
[a,b] -> return $ InfixCon a b
_ -> Left "synifyDataCon: infix with non-2 args?"
hs_res_ty = if use_gadt_syntax
then ResTyGADT (synifyType WithinType res_ty)
then ResTyGADT noSrcSpan (synifyType WithinType res_ty)
else ResTyH98
-- finally we get synifyDataCon's result!
in hs_arg_tys >>=
......@@ -313,7 +313,7 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs
(kvs, tvs) = partition isKindVar ktvs
synifyTyVar tv
| isLiftedTypeKind kind = noLoc (UserTyVar name)
| otherwise = noLoc (KindedTyVar name (synifyKindSig kind))
| otherwise = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind))
where
kind = tyVarKind tv
name = getName tv
......@@ -384,8 +384,8 @@ synifyType s forallty@(ForAllTy _tv _ty) =
synifyType _ (LitTy t) = noLoc $ HsTyLit $ synifyTyLit t
synifyTyLit :: TyLit -> HsTyLit
synifyTyLit (NumTyLit n) = HsNumTy n
synifyTyLit (StrTyLit s) = HsStrTy s
synifyTyLit (NumTyLit n) = HsNumTy mempty n
synifyTyLit (StrTyLit s) = HsStrTy mempty s
synifyKindSig :: Kind -> LHsKind Name
synifyKindSig k = synifyType WithinType k
......
......@@ -104,8 +104,8 @@ filterSigNames p (FixSig (FixitySig ns ty)) =
case filter (p . unLoc) ns of
[] -> Nothing
filtered -> Just (FixSig (FixitySig filtered ty))
filterSigNames _ orig@(MinimalSig _) = Just orig
filterSigNames p (TypeSig ns ty nwcs) =
filterSigNames _ orig@(MinimalSig _ _) = Just orig
filterSigNames p (TypeSig ns ty nwcs) =
case filter (p . unLoc) ns of
[] -> Nothing
filtered -> Just (TypeSig filtered ty nwcs)
......@@ -182,14 +182,6 @@ before :: Located a -> Located a -> Bool
before = (<) `on` getLoc
instance Foldable (GenLocated l) where
foldMap f (L _ x) = f x
instance Traversable (GenLocated l) where
mapM f (L l x) = (return . L l) =<< f x
traverse f (L l x) = L l <$> f x
-------------------------------------------------------------------------------
-- * NamedThing instances
-------------------------------------------------------------------------------
......@@ -210,7 +202,7 @@ class Parent a where
instance Parent (ConDecl Name) where
children con =
case con_details con of
RecCon fields -> map unL $ concatMap (cd_fld_names . unL) fields
RecCon fields -> map unL $ concatMap (cd_fld_names . unL) (unL fields)
_ -> []
instance Parent (TyClDecl Name) where
......
......@@ -239,6 +239,6 @@ buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces)
--------------------------------------------------------------------------------
withTempDir :: (ExceptionMonad m, MonadIO m) => FilePath -> m a -> m a
withTempDir :: (ExceptionMonad m) => FilePath -> m a -> m a
withTempDir dir = gbracket_ (liftIO $ createDirectory dir)
(liftIO $ removeDirectoryRecursive dir)
......@@ -80,7 +80,7 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
, let opaque = isTypeHidden expInfo (fi_rhs i)
]
cls_insts = [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap)
| let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
| let is = [ (instanceSig i, getName i) | i <- cls_instances ]
, (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
, not $ isInstanceHidden expInfo cls tys
]
......@@ -117,20 +117,6 @@ instLookup f name iface ifaceMap instIfaceMap =
iface' <- Map.lookup (nameModule name) ifaceMaps
Map.lookup name (f iface')
-- | Like GHC's 'instanceHead' but drops "silent" arguments.
instanceHead' :: ClsInst -> ([TyVar], ThetaType, Class, [Type])
instanceHead' ispec = (tvs, dropSilentArgs dfun theta, cls, tys)
where
dfun = is_dfun ispec
(tvs, cls, tys) = instanceHead ispec
(_, theta, _) = tcSplitSigmaTy (idType dfun)
-- | Drop "silent" arguments. See GHC Note [Silent superclass
-- arguments].
dropSilentArgs :: DFunId -> ThetaType -> ThetaType
dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta
-- | Like GHC's getInfo but doesn't cut things out depending on the
-- interative context, which we don't set sufficiently anyway.
getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst]))
......
......@@ -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
......
......@@ -251,10 +251,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
......@@ -331,9 +331,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
......@@ -378,9 +378,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
......@@ -388,7 +388,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)
......@@ -415,7 +415,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"
......
......@@ -76,7 +76,7 @@ binaryInterfaceMagic = 0xD0Cface
-- (2) set `binaryInterfaceVersionCompatibility` to [binaryInterfaceVersion]
--
binaryInterfaceVersion :: Word16
#if (__GLASGOW_HASKELL__ >= 709) && (__GLASGOW_HASKELL__ < 711)
#if (__GLASGOW_HASKELL__ >= 711) && (__GLASGOW_HASKELL__ < 713)
binaryInterfaceVersion = 27
binaryInterfaceVersionCompatibility :: [Word16]
......
......@@ -154,8 +154,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
case con_details d of
PrefixCon _ -> Just d
RecCon fields
| all field_avail fields -> Just d
| otherwise -> Just (d { con_details = PrefixCon (field_types (map unL fields)) })
| all field_avail (unL fields) -> Just d
| otherwise -> Just (d { con_details = PrefixCon (field_types (map unL (unL 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
......
......@@ -57,7 +57,7 @@ executable haddock
array,
xhtml >= 3000.2 && < 3000.3,
Cabal >= 1.10,
ghc >= 7.9 && < 7.11,
ghc >= 7.11 && < 7.13,
bytestring,
transformers
......