From ca0fb976d773c8bb1b4710ff1e32bb3363b6c4f0 Mon Sep 17 00:00:00 2001
From: David Waern <david.waern@gmail.com>
Date: Sun, 6 Sep 2009 18:57:45 +0000
Subject: Move toHsInstHead to Haddock.Convert and call it synifyInstHead

---
 src/Haddock/Convert.hs                   |  9 ++++++++-
 src/Haddock/Interface/AttachInstances.hs | 11 +----------
 src/Haddock/Interface/Create.hs          |  2 +-
 3 files changed, 10 insertions(+), 12 deletions(-)

(limited to 'src')

diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index e1f9493a..277b42a4 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -20,7 +20,7 @@ import BasicTypes
 import TysPrim ( alphaTyVars )
 import TysWiredIn ( listTyConName )
 import Bag ( emptyBag )
-import SrcLoc ( Located, noLoc )
+import SrcLoc ( Located, noLoc, unLoc )
 
 -- the main function here! yay!
 tyThingToLHsDecl :: TyThing -> LHsDecl Name
@@ -275,3 +275,10 @@ synifyType s forallty@(ForAllTy _tv _ty) =
      in noLoc $
            HsForAllTy forallPlicitness sTvs sCtx sTau
 
+synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
+                  ([HsPred Name], Name, [HsType Name])
+synifyInstHead (_, preds, cls, ts) =
+  ( map (unLoc . synifyPred) preds
+  , getName cls
+  , map (unLoc . synifyType WithinType) ts
+  )
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 9b163fb8..b996f278 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -51,7 +51,7 @@ attachInstances = mapM attach
        mb_info <- getAllInfo (unLoc (tcdLName d))
        return $ export { expItemInstances = case mb_info of
          Just (_, _, instances) ->
-           map toHsInstHead . sortImage instHead . map instanceHead $ instances
+           map synifyInstHead . sortImage instHead . map instanceHead $ instances
          Nothing ->
            []
         }
@@ -108,12 +108,3 @@ funTyConName = mkWiredInName gHC_PRIM
                         funTyConKey
                         (ATyCon funTyCon)       -- Relevant TyCon
                         BuiltInSyntax
-
-
-toHsInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
-toHsInstHead (_, preds, cls, ts) =
-        ( map (unLoc . synifyPred) preds
-        , getName cls
-        , map (unLoc . synifyType WithinType) ts
-        )
-
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 512c4e9e..298f96ac 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -514,7 +514,7 @@ mkExportItems modMap this_mod gre exported_names decls declMap
               -- Aren't the .hi files always present?
               return [ ExportNoDecl t [] ]
             Just tyThing -> do
-              let hsdecl = tyThingToHsSynSig tyThing
+              let hsdecl = tyThingToLHsDecl tyThing
               -- This is not the ideal way to implement haddockumentation
               -- for functions/values without explicit type signatures.
               --
-- 
cgit v1.2.3