[commit: haddock] T9858: Account for Typeable changes (289ef81)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : T9858
Link       : http://git.haskell.org/haddock.git/commitdiff/289ef817aad02c341beb6d4c28ba0495872f5a0f

>---------------------------------------------------------------

commit 289ef817aad02c341beb6d4c28ba0495872f5a0f
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Wed Sep 23 18:43:18 2015 +0200

    Account for Typeable changes
    
    The treatment of type families changed.


>---------------------------------------------------------------

289ef817aad02c341beb6d4c28ba0495872f5a0f
 haddock-api/src/Haddock/Convert.hs | 69 ++++++++++++++++++--------------------
 1 file changed, 32 insertions(+), 37 deletions(-)

diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 3fd783a..44a97d4 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -140,7 +140,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
 
 -- | Turn type constructors into type class declarations
 synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> Either ErrMsg (TyClDecl Name)
-synifyTyCon coax tc
+synifyTyCon _coax tc
   | isFunTyCon tc || isPrimTyCon tc
   = return $
     DataDecl { tcdLName = synifyName tc
@@ -163,42 +163,37 @@ synifyTyCon coax tc
                                       , dd_derivs = Nothing }
            , tcdFVs = placeHolderNamesTc }
 
-  | isTypeFamilyTyCon tc
-  = case famTyConFlav_maybe tc of
-      Just rhs ->
-        let resultVar = famTcResVar tc
-            info = case rhs of
-              OpenSynFamilyTyCon -> return OpenTypeFamily
-              ClosedSynFamilyTyCon mb -> case mb of
-                  Just (CoAxiom { co_ax_branches = branches })
-                          -> return $ ClosedTypeFamily $ Just $
-                               map (noLoc . synifyAxBranch tc) (fromBranches branches)
-                  Nothing -> return $ ClosedTypeFamily $ Just []
-              BuiltInSynFamTyCon {}
-                -> return $ ClosedTypeFamily $ Just []
-              AbstractClosedSynFamilyTyCon {}
-                -> return $ ClosedTypeFamily Nothing
-        in info >>= \i ->
-           return (FamDecl (FamilyDecl { fdInfo = i
-                          , fdLName = synifyName tc
-                          , fdTyVars = synifyTyVars (tyConTyVars tc)
-                          , fdResultSig =
-                              synifyFamilyResultSig resultVar (tyConResKind tc)
-                          , fdInjectivityAnn =
-                              synifyInjectivityAnn  resultVar (tyConTyVars tc)
-                                               (familyTyConInjectivityInfo tc)
-                          }))
-      Nothing -> Left "synifyTyCon: impossible open type synonym?"
-
-  | isDataFamilyTyCon tc
-  = --(why no "isOpenAlgTyCon"?)
-    case algTyConRhs tc of
-        DataFamilyTyCon -> return $
-          FamDecl (FamilyDecl DataFamily (synifyName tc)
-                              (synifyTyVars (tyConTyVars tc))
-                              (noLoc NoSig) -- always kind '*'
-                              Nothing)      -- no injectivity
-        _ -> Left "synifyTyCon: impossible open data type?"
+synifyTyCon _coax tc
+  | Just flav <- famTyConFlav_maybe tc
+  = case flav of
+      -- Type families
+      OpenSynFamilyTyCon -> mkFamDecl OpenTypeFamily
+      ClosedSynFamilyTyCon mb
+        | Just (CoAxiom { co_ax_branches = branches }) <- mb
+          -> mkFamDecl $ ClosedTypeFamily $ Just
+            $ map (noLoc . synifyAxBranch tc) (fromBranches branches)
+        | otherwise
+          -> mkFamDecl $ ClosedTypeFamily $ Just []
+      BuiltInSynFamTyCon {}
+        -> mkFamDecl $ ClosedTypeFamily $ Just []
+      AbstractClosedSynFamilyTyCon {}
+        -> mkFamDecl $ ClosedTypeFamily Nothing
+      DataFamilyTyCon {}
+        -> mkFamDecl DataFamily
+  where
+    resultVar = famTcResVar tc
+    mkFamDecl i = return $ FamDecl $
+      FamilyDecl { fdInfo = i
+                 , fdLName = synifyName tc
+                 , fdTyVars = synifyTyVars (tyConTyVars tc)
+                 , fdResultSig =
+                       synifyFamilyResultSig resultVar (tyConResKind tc)
+                 , fdInjectivityAnn =
+                       synifyInjectivityAnn  resultVar (tyConTyVars tc)
+                                       (familyTyConInjectivityInfo tc)
+                 }
+
+synifyTyCon coax tc
   | Just ty <- synTyConRhs_maybe tc
   = return $ SynDecl { tcdLName = synifyName tc
                      , tcdTyVars = synifyTyVars (tyConTyVars tc)