[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, pr-filter-maps, pr/cabal-desc, travis, v2.16, 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: Refactor specializer module to be independent from XHTML backend. (f0222ea)

git at git.haskell.org git at git.haskell.org
Tue Nov 28 11:35:56 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.16,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/f0222eaf888dafb9fdb6dbbac0527fc28223588d

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

commit f0222eaf888dafb9fdb6dbbac0527fc28223588d
Author: Ɓukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Wed Jul 29 19:32:32 2015 +0200

    Refactor specializer module to be independent from XHTML backend.


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

f0222eaf888dafb9fdb6dbbac0527fc28223588d
 haddock-api/haddock-api.cabal                          |  2 +-
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs         | 18 +++++++-----------
 haddock-api/src/Haddock/Convert.hs                     |  6 ++++--
 .../{Backends/Xhtml => Interface}/Specialize.hs        | 18 ++++++++++++++++--
 haddock.cabal                                          |  2 +-
 5 files changed, 29 insertions(+), 17 deletions(-)

diff --git a/haddock-api/haddock-api.cabal b/haddock-api/haddock-api.cabal
index 2090c53..b4ceb1a 100644
--- a/haddock-api/haddock-api.cabal
+++ b/haddock-api/haddock-api.cabal
@@ -69,6 +69,7 @@ library
     Haddock.Interface.AttachInstances
     Haddock.Interface.LexParseRn
     Haddock.Interface.ParseModuleHeader
+    Haddock.Interface.Specialize
     Haddock.Parser
     Haddock.Utils
     Haddock.Backends.Xhtml
@@ -76,7 +77,6 @@ library
     Haddock.Backends.Xhtml.DocMarkup
     Haddock.Backends.Xhtml.Layout
     Haddock.Backends.Xhtml.Names
-    Haddock.Backends.Xhtml.Specialize
     Haddock.Backends.Xhtml.Themes
     Haddock.Backends.Xhtml.Types
     Haddock.Backends.Xhtml.Utils
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 7255bf4..7da1f08 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -22,7 +22,6 @@ module Haddock.Backends.Xhtml.Decl (
 import Haddock.Backends.Xhtml.DocMarkup
 import Haddock.Backends.Xhtml.Layout
 import Haddock.Backends.Xhtml.Names
-import Haddock.Backends.Xhtml.Specialize
 import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.GhcUtils
@@ -563,10 +562,8 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) =
             )
           where
             iid = instanceId origin no ihdClsName
-            sigs = ppInstanceSigs links splice unicode qual
-                clsiTyVars ihdTypes clsiSigs
-            ats = ppInstanceAssocTys links splice unicode qual
-                clsiTyVars ihdTypes clsiAssocTys
+            sigs = ppInstanceSigs links splice unicode qual clsiSigs
+            ats = ppInstanceAssocTys links splice unicode qual clsiAssocTys
         TypeInst rhs ->
             (ptype, mdoc, [])
           where
@@ -587,20 +584,19 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) =
 
 
 ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification
-                   -> LHsTyVarBndrs DocName -> [HsType DocName]
                    -> [PseudoFamilyDecl DocName]
                    -> [Html]
-ppInstanceAssocTys links splice unicode qual bndrs tys =
-    map ppFamilyDecl' . map (specializePseudoFamilyDecl bndrs tys)
+ppInstanceAssocTys links splice unicode qual =
+    map ppFamilyDecl'
   where
     ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual
 
 
 ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
-              -> LHsTyVarBndrs DocName -> [HsType DocName] -> [Sig DocName]
+              -> [Sig DocName]
               -> [Html]
-ppInstanceSigs links splice unicode qual bndrs tys sigs = do
-    TypeSig lnames (L loc typ) _ <- map (specializeSig bndrs tys) sigs
+ppInstanceSigs links splice unicode qual sigs = do
+    TypeSig lnames (L loc typ) _ <- sigs
     let names = map unLoc lnames
     return $ ppSimpleSig links splice unicode qual loc names typ
 
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 095bd9e..c966465 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -25,7 +25,6 @@ import Data.Either (lefts, rights)
 import Data.List( partition )
 import DataCon
 import FamInstEnv
-import Haddock.Types
 import HsSyn
 import Kind ( splitKindFunTys, synTyConResKind, isKind )
 import Name
@@ -41,6 +40,9 @@ import TysWiredIn ( listTyConName, eqTyCon )
 import Unique ( getUnique )
 import Var
 
+import Haddock.Types
+import Haddock.Interface.Specialize
+
 
 
 -- the main function here! yay!
@@ -390,7 +392,7 @@ synifyKindSig :: Kind -> LHsKind Name
 synifyKindSig k = synifyType WithinType k
 
 synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
-synifyInstHead (_, preds, cls, types) = InstHead
+synifyInstHead (_, preds, cls, types) = specializeInstHead $ InstHead
     { ihdClsName = getName cls
     , ihdKinds = map (unLoc . synifyType WithinType) ks
     , ihdTypes = map (unLoc . synifyType WithinType) ts
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
similarity index 95%
rename from haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
rename to haddock-api/src/Haddock/Interface/Specialize.hs
index 2295605..df7f63b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -4,8 +4,8 @@
 {-# LANGUAGE RecordWildCards #-}
 
 
-module Haddock.Backends.Xhtml.Specialize
-    ( specializePseudoFamilyDecl, specializeSig
+module Haddock.Interface.Specialize
+    ( specializeInstHead
     ) where
 
 
@@ -88,6 +88,20 @@ specializeSig bndrs typs (TypeSig lnames (L loc typ) prn) =
 specializeSig _ _ sig = sig
 
 
+specializeInstHead :: (Eq name, Typeable name, DataId name, SetName name)
+                   => InstHead name -> InstHead name
+specializeInstHead ihd at InstHead { ihdInstType = clsi at ClassInst { .. }, .. } =
+    ihd { ihdInstType = instType' }
+  where
+    instType' = clsi
+        { clsiSigs = map specializeSig' clsiSigs
+        , clsiAssocTys = map specializeFamilyDecl' clsiAssocTys
+        }
+    specializeSig' = specializeSig clsiTyVars ihdTypes
+    specializeFamilyDecl' = specializePseudoFamilyDecl clsiTyVars ihdTypes
+specializeInstHead ihd = ihd
+
+
 -- | Make given type use tuple and list literals where appropriate.
 --
 -- After applying 'specialize' function some terms may not use idiomatic list
diff --git a/haddock.cabal b/haddock.cabal
index 4ea2a82..71b7834 100644
--- a/haddock.cabal
+++ b/haddock.cabal
@@ -90,6 +90,7 @@ executable haddock
       Haddock.Interface.AttachInstances
       Haddock.Interface.LexParseRn
       Haddock.Interface.ParseModuleHeader
+      Haddock.Interface.Specialize
       Haddock.Parser
       Haddock.Utils
       Haddock.Backends.Xhtml
@@ -97,7 +98,6 @@ executable haddock
       Haddock.Backends.Xhtml.DocMarkup
       Haddock.Backends.Xhtml.Layout
       Haddock.Backends.Xhtml.Names
-      Haddock.Backends.Xhtml.Specialize
       Haddock.Backends.Xhtml.Themes
       Haddock.Backends.Xhtml.Types
       Haddock.Backends.Xhtml.Utils



More information about the ghc-commits mailing list