Tue Nov 28 11:41:47 UTC 2017

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

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11258,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/3e6b341a7bc2331a1646760f20f2451932d725d6

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

commit 3e6b341a7bc2331a1646760f20f2451932d725d6
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.


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

3e6b341a7bc2331a1646760f20f2451932d725d6
 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 2458f02..e563ac0 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -141,7 +141,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
@@ -164,42 +164,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)

