diff options
Diffstat (limited to 'haddock-api/src/Haddock/GhcUtils.hs')
-rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index c8e5ea8b..16c589f0 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -46,7 +46,7 @@ isConSym :: OccName -> Bool isConSym = isLexConSym . occNameFS -getMainDeclBinder :: HsDecl name -> [name] +getMainDeclBinder :: HsDecl name -> [IdP name] getMainDeclBinder (TyClD d) = [tcdName d] getMainDeclBinder (ValD d) = case collectHsBindBinders d of @@ -73,10 +73,10 @@ getInstLoc (TyFamInstD (TyFamInstDecl -- foo, bar :: Types.. -- but only one of the names is exported and we have to change the -- type signature to only include the exported names. -filterLSigNames :: (name -> Bool) -> LSig name -> Maybe (LSig name) +filterLSigNames :: (IdP name -> Bool) -> LSig name -> Maybe (LSig name) filterLSigNames p (L loc sig) = L loc <$> (filterSigNames p sig) -filterSigNames :: (name -> Bool) -> Sig name -> Maybe (Sig name) +filterSigNames :: (IdP name -> Bool) -> Sig name -> Maybe (Sig name) filterSigNames p orig@(SpecSig n _ _) = ifTrueJust (p $ unLoc n) orig filterSigNames p orig@(InlineSig n _) = ifTrueJust (p $ unLoc n) orig filterSigNames p (FixSig (FixitySig ns ty)) = @@ -98,10 +98,10 @@ ifTrueJust :: Bool -> name -> Maybe name ifTrueJust True = Just ifTrueJust False = const Nothing -sigName :: LSig name -> [name] +sigName :: LSig name -> [IdP name] sigName (L _ sig) = sigNameNoLoc sig -sigNameNoLoc :: Sig name -> [name] +sigNameNoLoc :: Sig name -> [IdP name] sigNameNoLoc (TypeSig ns _) = map unLoc ns sigNameNoLoc (ClassOpSig _ ns _) = map unLoc ns sigNameNoLoc (PatSynSig ns _) = map unLoc ns @@ -126,7 +126,7 @@ isValD (ValD _) = True isValD _ = False -declATs :: HsDecl a -> [a] +declATs :: HsDecl a -> [IdP a] declATs (TyClD d) | isClassDecl d = map (unL . fdLName . unL) $ tcdATs d declATs _ = [] @@ -151,7 +151,7 @@ reL = L undefined ------------------------------------------------------------------------------- -instance NamedThing (TyClDecl Name) where +instance NamedThing (TyClDecl GHCR) where getName = tcdName ------------------------------------------------------------------------------- @@ -163,14 +163,14 @@ class Parent a where children :: a -> [Name] -instance Parent (ConDecl Name) where +instance Parent (ConDecl GHCR) where children con = case getConDetails con of RecCon fields -> map (selectorFieldOcc . unL) $ concatMap (cd_fld_names . unL) (unL fields) _ -> [] -instance Parent (TyClDecl Name) where +instance Parent (TyClDecl GHCR) where children d | isDataDecl d = map unL $ concatMap (getConNames . unL) $ (dd_cons . tcdDataDefn) $ d @@ -185,12 +185,12 @@ family :: (NamedThing a, Parent a) => a -> (Name, [Name]) family = getName &&& children -familyConDecl :: ConDecl Name -> [(Name, [Name])] +familyConDecl :: ConDecl GHC.GHCR -> [(IdP GHCR, [IdP GHCR])] familyConDecl d = zip (map unL (getConNames d)) (repeat $ children d) -- | A mapping from the parent (main-binder) to its children and from each -- child to its grand-children, recursively. -families :: TyClDecl Name -> [(Name, [Name])] +families :: TyClDecl GHCR -> [(IdP GHCR, [IdP GHCR])] families d | isDataDecl d = family d : concatMap (familyConDecl . unL) (dd_cons (tcdDataDefn d)) | isClassDecl d = [family d] @@ -198,12 +198,12 @@ families d -- | A mapping from child to parent -parentMap :: TyClDecl Name -> [(Name, Name)] +parentMap :: TyClDecl GHCR -> [(IdP GHCR, IdP GHCR)] parentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ] -- | The parents of a subordinate in a declaration -parents :: Name -> HsDecl Name -> [Name] +parents :: IdP GHCR -> HsDecl GHCR -> [IdP GHCR] parents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ] parents _ _ = [] |