-\begin{code}
-findSplice :: [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
-findSplice ds = addl emptyRdrGroup ds
-
-mkGroup :: [LHsDecl a] -> HsGroup a
-mkGroup ds = addImpDecls emptyRdrGroup ds
-
-addImpDecls :: HsGroup a -> [LHsDecl a] -> HsGroup a
--- The decls are imported, and should not have a splice
-addImpDecls group decls = case addl group decls of
- (group', Nothing) -> group'
- other -> panic "addImpDecls"
-
-addl :: HsGroup a -> [LHsDecl a] -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
- -- This stuff reverses the declarations (again) but it doesn't matter
-
--- Base cases
-addl gp [] = (gp, Nothing)
-addl gp (L l d : ds) = add gp l d ds
-
-
-add :: HsGroup a -> SrcSpan -> HsDecl a -> [LHsDecl a]
- -> (HsGroup a, Maybe (SpliceDecl a, [LHsDecl a]))
-
-add gp l (SpliceD e) ds = (gp, Just (e, ds))
-
--- Class declarations: pull out the fixity signatures to the top
-add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs, hs_docs = docs})
- l decl@(TyClD d) ds
- | isClassDecl d =
- let fsigs = [ L l f | L l (FixSig f) <- tcdSigs d ] in
- addl (gp { hs_tyclds = L l d : ts,
- hs_fixds = fsigs ++ fs,
- hs_docs = add_doc decl docs}) ds
- | isIdxTyDecl d =
- addl (gp { hs_tyclds = L l d : ts }) ds
- | otherwise =
- addl (gp { hs_tyclds = L l d : ts,
- hs_docs = add_doc decl docs }) ds
-
--- Signatures: fixity sigs go a different place than all others
-add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig f)) ds
- = addl (gp {hs_fixds = L l f : ts}) ds
-add gp@(HsGroup {hs_valds = ts, hs_docs = docs}) l x@(SigD d) ds
- = addl (gp {hs_valds = add_sig (L l d) ts, hs_docs = add_doc x docs}) ds
-
--- Value declarations: use add_bind
-add gp@(HsGroup {hs_valds = ts, hs_docs = docs}) l x@(ValD d) ds
- = addl (gp { hs_valds = add_bind (L l d) ts, hs_docs = add_doc x docs }) ds
-
--- The rest are routine
-add gp@(HsGroup {hs_instds = ts}) l (InstD d) ds
- = addl (gp { hs_instds = L l d : ts }) ds
-add gp@(HsGroup {hs_derivds = ts}) l (DerivD d) ds
- = addl (gp { hs_derivds = L l d : ts }) ds
-add gp@(HsGroup {hs_defds = ts}) l (DefD d) ds
- = addl (gp { hs_defds = L l d : ts }) ds
-add gp@(HsGroup {hs_fords = ts, hs_docs = docs}) l x@(ForD d) ds
- = addl (gp { hs_fords = L l d : ts, hs_docs = add_doc x docs }) ds
-add gp@(HsGroup {hs_depds = ts}) l (DeprecD d) ds
- = addl (gp { hs_depds = L l d : ts }) ds
-add gp@(HsGroup {hs_ruleds = ts}) l (RuleD d) ds
- = addl (gp { hs_ruleds = L l d : ts }) ds
-
-add gp l (DocD d) ds
- = addl (gp { hs_docs = DocEntity d : (hs_docs gp) }) ds
-
-add_doc decl docs = case getMainDeclBinder decl of
- Just name -> DeclEntity name : docs
- Nothing -> docs
-
-add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` b) sigs
-add_sig s (ValBindsIn bs sigs) = ValBindsIn bs (s:sigs)
-\end{code}
-