diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2014-09-09 01:03:27 -0500 |
|---|---|---|
| committer | Austin Seipp <aseipp@pobox.com> | 2015-01-23 07:17:19 -0600 |
| commit | 89fc5605c865d0e0ce5ed7e396102e678426533b (patch) | |
| tree | 873726ccbc276f413a793e537c015e8445951e5b /haddock-api/src/Haddock/Convert.hs | |
| parent | df0239b587e2a25531962f5b46f715ebb9b09685 (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/Convert.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index ac7f8bd8..5cbf5f97 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -31,7 +31,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) @@ -74,9 +74,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 @@ -145,7 +145,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))) @@ -264,8 +264,8 @@ synifyDataCon use_gadt_syntax dc = linear_tys = zipWith (\ty bang -> let tySyn = synifyType WithinType ty src_bang = case bang of - HsUnpack {} -> HsSrcBang (Just True) True - HsStrict -> HsSrcBang (Just False) True + HsUnpack {} -> HsSrcBang Nothing (Just True) True + HsStrict -> HsSrcBang Nothing (Just False) True _ -> bang in case src_bang of HsNoBang -> tySyn @@ -278,13 +278,13 @@ synifyDataCon use_gadt_syntax dc = (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 >>= @@ -312,7 +312,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 @@ -383,8 +383,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 |