[commit: haddock] 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, mpickering/import, pr-filter-maps, pr/cabal-desc, travis, v2.17, v2.17.3, v2.18, wip-located-module-as, wip/D2418, wip/T11019, wip/T11028, wip/T11028-2, wip/T11028-3, 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/import2, wip/new-tree-one-param, wip/rae, wip/rae-nokinds, wip/remove-frames, wip/remove-frames1, wip/revert-ttg-2017-11-20, wip/spj-wildcard-refactor, wip/spj-wildcard-refactor2, 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: Account for Typeable changes (174f236)

git at git.haskell.org git at git.haskell.org
Tue Nov 28 11:40:04 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,mpickering/import,pr-filter-maps,pr/cabal-desc,travis,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11019,wip/T11028,wip/T11028-2,wip/T11028-3,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/import2,wip/new-tree-one-param,wip/rae,wip/rae-nokinds,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/spj-wildcard-refactor,wip/spj-wildcard-refactor2,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/174f23631a0a8de7dc0f3cd67c393a5ca88c4a2b

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

commit 174f23631a0a8de7dc0f3cd67c393a5ca88c4a2b
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.


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

174f23631a0a8de7dc0f3cd67c393a5ca88c4a2b
 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 6f0684d..4cb4259 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)



More information about the ghc-commits mailing list