[commit: haddock] wip/api-ann-hstylit-4, wip/api-ann-hstylit-5: Make RecCon payload Located (5f87fee)

[git at git.haskell.org]

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

On branches: wip/api-ann-hstylit-4,wip/api-ann-hstylit-5
Link       : http://git.haskell.org/haddock.git/commitdiff/5f87fee8d4e11e87062d60ac1b467ae25a02b9bf

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

commit 5f87fee8d4e11e87062d60ac1b467ae25a02b9bf
Author: Alan Zimmerman <alan.zimm at gmail.com>
Date:   Wed Dec 10 23:22:50 2014 +0200

    Make RecCon payload Located


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

5f87fee8d4e11e87062d60ac1b467ae25a02b9bf
 src/Haddock/Backends/Hoogle.hs     | 2 +-
 src/Haddock/Backends/LaTeX.hs      | 4 ++--
 src/Haddock/Backends/Xhtml/Decl.hs | 6 +++---
 src/Haddock/Convert.hs             | 2 +-
 src/Haddock/GhcUtils.hs            | 2 +-
 src/Haddock/Interface/Create.hs    | 6 +++---
 src/Haddock/Interface/Rename.hs    | 4 ++--
 src/Haddock/Utils.hs               | 4 ++--
 8 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index a0f3036..1e34331 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -189,7 +189,7 @@ ppCtor dflags dat subdocs con
     where
         f (PrefixCon args) = [typeSig name $ args ++ [resType]]
         f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
-        f (RecCon recs) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
+        f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
                           [(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++
                            [out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
                           | r <- map unLoc recs]
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 021af8e..bf64c74 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -636,7 +636,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
                  map (ppLParendType unicode) args))
       <-> rDoc mbDoc <+> nl
 
-    RecCon fields ->
+    RecCon (L _ fields) ->
       (decltt (header_ unicode <+> ppOcc)
         <-> rDoc mbDoc <+> nl)
       $$
@@ -652,7 +652,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
     -- prefix & infix could also use hsConDeclArgTys if it seemed to
     -- simplify the code.
     PrefixCon args -> doGADTCon args resTy
-    cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
+    cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
                                      doRecordFields fields
     InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
 
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index cf2338c..bf1e4d8 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -601,7 +601,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
     PrefixCon args ->
       (header_ unicode qual +++ hsep (ppOcc
             : map (ppLParendType unicode qual) args), noHtml, noHtml)
-    RecCon fields ->
+    RecCon (L _ fields) ->
       (header_ unicode qual +++ ppOcc <+> char '{',
        doRecordFields fields,
        char '}')
@@ -618,7 +618,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
     -- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
     -- (except each field gets its own line in docs, to match
     -- non-GADT records)
-    RecCon fields -> (ppOcc <+> dcolon unicode <+>
+    RecCon (L _ fields) -> (ppOcc <+> dcolon unicode <+>
                             ppForAll forall_ ltvs lcontext unicode qual <+> char '{',
                             doRecordFields fields,
                             char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
@@ -691,7 +691,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
         InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
 
     fieldPart = case con_details con of
-        RecCon fields -> [doRecordFields fields]
+        RecCon (L _ fields) -> [doRecordFields fields]
         _ -> []
 
     doRecordFields fields = subFields qual
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 8afe4a2..47ec777 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -259,7 +259,7 @@ synifyDataCon use_gadt_syntax dc = noLoc $
                 (dataConFieldLabels dc) linear_tys
   hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
           (True,True) -> error "synifyDataCon: contradiction!"
-          (True,False) -> RecCon field_tys
+          (True,False) -> RecCon (noLoc field_tys)
           (False,False) -> PrefixCon linear_tys
           (False,True) -> case linear_tys of
                            [a,b] -> InfixCon a b
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index cbf554a..9f9b269 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -210,7 +210,7 @@ class Parent a where
 instance Parent (ConDecl Name) where
   children con =
     case con_details con of
-      RecCon fields -> map unL $ concatMap (cd_fld_names . unL) fields
+      RecCon fields -> map unL $ concatMap (cd_fld_names . unL) (unL fields)
       _             -> []
 
 instance Parent (TyClDecl Name) where
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index a9c6fb8..5420ef0 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -332,7 +332,7 @@ subordinates instMap decl = case decl of
                   | c <- cons, cname <- con_names c ]
         fields  = [ (unL n, maybeToList $ fmap unL doc, M.empty)
                   | RecCon flds <- map con_details cons
-                  , L _ (ConDeclField ns _ doc) <- flds
+                  , L _ (ConDeclField ns _ doc) <- (unLoc flds)
                   , n <- ns ]
 
 -- | Extract function argument docs from inside types.
@@ -774,7 +774,7 @@ extractDecl name mdl decl
       InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
         let matches = [ d | L _ d <- insts
                           , L _ ConDecl { con_details = RecCon rec } <- dd_cons (dfid_defn d)
-                          , ConDeclField { cd_fld_names = ns } <- map unLoc rec
+                          , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
                           , L _ n <- ns
                           , n == name
                       ]
@@ -807,7 +807,7 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
 
 extractRecSel nm mdl t tvs (L _ con : rest) =
   case con_details con of
-    RecCon fields | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
+    RecCon (L _ fields) | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
       L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))) [])
     _ -> extractRecSel nm mdl t tvs rest
  where
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 64357e8..3f324f4 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -379,9 +379,9 @@ renameCon decl@(ConDecl { con_names = lnames, con_qvars = ltyvars
                    , con_details = details', con_res = restype', con_doc = mbldoc' })
 
   where
-    renameDetails (RecCon fields) = do
+    renameDetails (RecCon (L l fields)) = do
       fields' <- mapM renameConDeclFieldField fields
-      return (RecCon fields')
+      return (RecCon (L l fields'))
     renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
     renameDetails (InfixCon a b) = do
       a' <- renameLType a
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index ecf58b3..95ee045 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -150,8 +150,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
       case con_details d of
         PrefixCon _ -> Just d
         RecCon fields
-          | all field_avail fields -> Just d
-          | otherwise -> Just (d { con_details = PrefixCon (field_types (map unL fields)) })
+          | all field_avail (unL fields) -> Just d
+          | otherwise -> Just (d { con_details = PrefixCon (field_types (map unL (unL fields))) })
           -- if we have *all* the field names available, then
           -- keep the record declaration.  Otherwise degrade to
           -- a constructor declaration.  This isn't quite right, but