More progress -- still on phase1

1 files changed, 1 insertions, 150 deletions

diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 1d4eb29b..92d81ff6 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -9,7 +9,7 @@ module HaddockUtil (
 
   -- * Misc utilities
   nameOfQName, collectNames, declBinders, declMainBinder, declSubBinders, 
-  splitTyConApp, restrictTo, declDoc, parseModuleHeader, freeTyCons, unbang,
+  splitTyConApp, restrictTo, declDoc, freeTyCons, unbang,
   addFieldDoc, addFieldDocs, addConDoc, addConDocs,toDescription, unQual,
 
   -- * Filename utilities
@@ -26,8 +26,6 @@ module HaddockUtil (
  ) where
 
 import Binary2
-import HaddockLex2
-import HaddockParse2
 import HaddockTypes
 import HsSyn2
 import Map ( Map )
@@ -229,153 +227,6 @@ declDoc (HsForeignImport _ _ _ _ _ _ d) = d
 declDoc _ = Nothing
 
 -- -----------------------------------------------------------------------------
--- Parsing module headers
-
--- 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,ModuleInfo)
-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 Doc)
-      description1 = case descriptionOpt of
-         Nothing -> Right Nothing
-         Just description -> case parseString . tokenise $ description of
-            Left mess -> Left ("Cannot parse Description: " ++ mess)
-            Right doc -> Right (Just doc)
-   in
-      case description1 of
-         Left mess -> Left mess
-         Right docOpt -> Right (str8,ModuleInfo {
-            description = docOpt,
-            portability = portabilityOpt,
-            stability = stabilityOpt,
-            maintainer = maintainerOpt
-            })
-   
-
--- | This function is how we read keys.
---
--- all fields in the header are optional and have the form
---
--- [spaces1][field name][spaces] ":" 
---    [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
--- where each [spaces2] should have [spaces1] as a prefix.
---
--- Thus for the key "Description",
---
--- > Description : this is a
--- >    rather long
--- >
--- >    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)
-parseKey key toParse0 =
-   do
-      let
-         (spaces0,toParse1) = extractLeadingSpaces toParse0
-
-         indentation = spaces0
-      afterKey0 <- extractPrefix key toParse1
-      let
-         afterKey1 = extractLeadingSpaces afterKey0
-      afterColon0 <- case snd afterKey1 of
-         ':':afterColon -> return afterColon
-         _ -> Nothing
-      let
-         (_,afterColon1) = extractLeadingSpaces afterColon0
-
-      return (scanKey True indentation afterColon1)
-   where
-      scanKey :: Bool -> String -> String -> (String,String)
-      scanKey isFirst indentation [] = ([],[])
-      scanKey isFirst indentation str =
-         let
-            (nextLine,rest1) = extractNextLine str
-
-            accept = isFirst || sufficientIndentation || allSpaces
-
-            sufficientIndentation = case extractPrefix indentation nextLine of
-               Just (c:_) | isSpace c -> True
-               _ -> False
-
-            allSpaces = case extractLeadingSpaces nextLine of
-               (_,[]) -> True
-               _ -> False
-         in
-            if accept 
-               then
-                  let
-                     (scanned1,rest2) = scanKey False indentation rest1
-
-                     scanned2 = case scanned1 of 
-                        "" -> if allSpaces then "" else nextLine
-                        _ -> nextLine ++ "\n" ++ scanned1
-                  in
-                     (scanned2,rest2)
-               else
-                  ([],str)
-
-      extractLeadingSpaces :: String -> (String,String)
-      extractLeadingSpaces [] = ([],[])
-      extractLeadingSpaces (s@(c:cs)) 
-         | isSpace c = 
-            let
-               (spaces1,cs1) = extractLeadingSpaces cs
-            in
-               (c:spaces1,cs1)
-         | True = ([],s)
-
-      extractNextLine :: String -> (String,String)
-      extractNextLine [] = ([],[])
-      extractNextLine (c:cs) 
-         | c == '\n' =
-            ([],cs)
-         | True =
-            let
-               (line,rest) = extractNextLine cs
-            in
-               (c:line,rest)
-         
-
-      -- indentation returns characters after last newline.
-      indentation :: String -> String
-      indentation s = fromMaybe s (indentation0 s)
-         where
-            indentation0 :: String -> Maybe String
-            indentation0 [] = Nothing
-            indentation0 (c:cs) =
-               case indentation0 cs of
-                  Nothing -> if c == '\n' then Just cs else Nothing
-                  in0 -> in0
-               
-      -- comparison is case-insensitive.
-      extractPrefix :: String -> String -> Maybe String
-      extractPrefix [] s = Just s
-      extractPrefix s [] = Nothing
-      extractPrefix (c1:cs1) (c2:cs2)
-         | toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
-         | True = Nothing
-
--- -----------------------------------------------------------------------------
 -- Filename mangling functions stolen from GHC's main/DriverUtil.lhs.
 
 type Suffix = String