X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fparser%2FHaddockUtils.hs;h=ea73911c996516b394730a57432abc9626974398;hp=70375d71bcccb7ad8685acb7e214702995d914d8;hb=432b9c9322181a3644083e3c19b7e240d90659e7;hpb=f292786b85e14c5fe5be34c9f11dc384f6bb8add

diff --git a/compiler/parser/HaddockUtils.hs b/compiler/parser/HaddockUtils.hs
index 70375d7..ea73911 100644
--- a/compiler/parser/HaddockUtils.hs
+++ b/compiler/parser/HaddockUtils.hs
@@ -19,45 +19,45 @@ import Data.Either
 -- NB.  The headers must be given in the order Module, Description,
 -- Copyright, License, Maintainer, Stability, Portability, except that
 -- any or all may be omitted.
-parseModuleHeader :: String -> Either String (String, HaddockModInfo RdrName)                                
-parseModuleHeader str0 =                                                                        
-   let                                                                                          
-      getKey :: String -> String -> (Maybe String,String)                                       
-      getKey key str = case parseKey key str of                                                 
-         Nothing -> (Nothing,str)                                                               
-         Just (value,rest) -> (Just value,rest)                                                 
-                                                                                                
-      (_moduleOpt,str1) = getKey "Module" str0                                                   
-      (descriptionOpt,str2) = getKey "Description" str1                                         
-      (_copyrightOpt,str3) = getKey "Copyright" str2                                             
-      (_licenseOpt,str4) = getKey "License" str3                                                 
-      (_licenceOpt,str5) = getKey "Licence" str4                                                 
-      (maintainerOpt,str6) = getKey "Maintainer" str5                                           
-      (stabilityOpt,str7) = getKey "Stability" str6                                             
-      (portabilityOpt,str8) = getKey "Portability" str7                                         
-                                                                                                
-      description1 :: Either String (Maybe (HsDoc RdrName))                                                 
-      description1 = case descriptionOpt of                                                     
-         Nothing -> Right Nothing                                                               
-         Just description -> case parseHaddockString . tokenise $ description of                       
-
-            MyLeft mess -> Left ("Cannot parse Description: " ++ mess)                            
-            MyRight doc -> Right (Just doc)                                                       
-   in                                                                                           
-      case description1 of                                                                      
-         Left mess -> Left mess                                                                 
-         Right docOpt -> Right (str8,HaddockModInfo {                                               
-            hmi_description = docOpt,                                                               
-            hmi_portability = portabilityOpt,                                                       
-            hmi_stability = stabilityOpt,                                                           
-            hmi_maintainer = maintainerOpt                                                          
+parseModuleHeader :: String -> Either String (String, HaddockModInfo RdrName)
+parseModuleHeader str0 =
+   let
+      getKey :: String -> String -> (Maybe String,String)
+      getKey key str = case parseKey key str of
+         Nothing -> (Nothing,str)
+         Just (value,rest) -> (Just value,rest)
+
+      (_moduleOpt,str1) = getKey "Module" str0
+      (descriptionOpt,str2) = getKey "Description" str1
+      (_copyrightOpt,str3) = getKey "Copyright" str2
+      (_licenseOpt,str4) = getKey "License" str3
+      (_licenceOpt,str5) = getKey "Licence" str4
+      (maintainerOpt,str6) = getKey "Maintainer" str5
+      (stabilityOpt,str7) = getKey "Stability" str6
+      (portabilityOpt,str8) = getKey "Portability" str7
+
+      description1 :: Either String (Maybe (HsDoc RdrName))
+      description1 = case descriptionOpt of
+         Nothing -> Right Nothing
+         Just description -> case parseHaddockString . tokenise $ description of
+
+            MyLeft mess -> Left ("Cannot parse Description: " ++ mess)
+            MyRight doc -> Right (Just doc)
+   in
+      case description1 of
+         Left mess -> Left mess
+         Right docOpt -> Right (str8,HaddockModInfo {
+            hmi_description = docOpt,
+            hmi_portability = portabilityOpt,
+            hmi_stability = stabilityOpt,
+            hmi_maintainer = maintainerOpt
             })
 
 -- | This function is how we read keys.
 --
 -- all fields in the header are optional and have the form
 --
--- [spaces1][field name][spaces] ":" 
+-- [spaces1][field name][spaces] ":"
 --    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
 -- where each [spaces2] should have [spaces1] as a prefix.
 --
@@ -69,7 +69,7 @@ parseModuleHeader str0 =
 -- >    description
 -- >
 -- > The module comment starts here
--- 
+--
 -- the value will be "this is a .. description" and the rest will begin
 -- at "The module comment".
 parseKey :: String -> String -> Maybe (String,String)
@@ -106,12 +106,12 @@ parseKey key toParse0 =
                (_,[]) -> True
                _ -> False
          in
-            if accept 
+            if accept
                then
                   let
                      (scanned1,rest2) = scanKey False indentation rest1
 
-                     scanned2 = case scanned1 of 
+                     scanned2 = case scanned1 of
                         "" -> if allSpaces then "" else nextLine
                         _ -> nextLine ++ "\n" ++ scanned1
                   in
@@ -121,8 +121,8 @@ parseKey key toParse0 =
 
       extractLeadingSpaces :: String -> (String,String)
       extractLeadingSpaces [] = ([],[])
-      extractLeadingSpaces (s@(c:cs)) 
-         | isSpace c = 
+      extractLeadingSpaces (s@(c:cs))
+         | isSpace c =
             let
                (spaces1,cs1) = extractLeadingSpaces cs
             in
@@ -131,7 +131,7 @@ parseKey key toParse0 =
 
       extractNextLine :: String -> (String,String)
       extractNextLine [] = ([],[])
-      extractNextLine (c:cs) 
+      extractNextLine (c:cs)
          | c == '\n' =
             ([],cs)
          | True =
@@ -139,7 +139,7 @@ parseKey key toParse0 =
                (line,rest) = extractNextLine cs
             in
                (c:line,rest)
-         
+
       -- comparison is case-insensitive.
       extractPrefix :: String -> String -> Maybe String
       extractPrefix [] s = Just s
@@ -151,17 +151,16 @@ parseKey key toParse0 =
 -- -----------------------------------------------------------------------------
 -- Adding documentation to record fields (used in parsing).
 
-type Field a = ([Located a], LBangType a, Maybe (LHsDoc a))
-
-addFieldDoc :: Field a -> Maybe (LHsDoc a) -> Field a
-addFieldDoc (a, b, c) doc = (a, b, c `mplus` doc)
+addFieldDoc :: ConDeclField a -> Maybe (LHsDoc a) -> ConDeclField a
+addFieldDoc fld doc = fld { cd_fld_doc = cd_fld_doc fld `mplus` doc }
 
-addFieldDocs :: [Field a] -> Maybe (LHsDoc a) -> [Field a]
+addFieldDocs :: [ConDeclField a] -> Maybe (LHsDoc a) -> [ConDeclField a]
 addFieldDocs [] _ = []
 addFieldDocs (x:xs) doc = addFieldDoc x doc : xs
 
 addConDoc :: LConDecl a -> Maybe (LHsDoc a) -> LConDecl a
-addConDoc (L p c) doc = L p ( c { con_doc = con_doc c `mplus` doc } )
+addConDoc decl    Nothing = decl
+addConDoc (L p c) doc     = L p ( c { con_doc = con_doc c `mplus` doc } )
 
 addConDocs :: [LConDecl a] -> Maybe (LHsDoc a) -> [LConDecl a]
 addConDocs [] _ = []