Remove DocOption, use the GHC type

1 files changed, 20 insertions, 50 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 05b32662..1ff2ca01 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -427,7 +427,7 @@ run flags modules extEnv = do
   mapM_ putStrLn messages'
 
   let 
-    visibleMods = [ m | m <- haddockMods'', OptHide `notElem` (hmod_options m) ]
+    visibleMods = [ m | m <- haddockMods'', DocOptHide `notElem` (hmod_options m) ]
     packageName = (Just . packageIdString . modulePackageId . 
                    hmod_mod . head) visibleMods
  
@@ -482,7 +482,7 @@ type FullyCheckedMod = (ParsedSource,
 data ModuleDataGHC = ModuleDataGHC {
    ghcModule         :: Module,
    ghcFilename       :: FilePath,
-   ghcMbDocOpts      :: Maybe String,
+   ghcDocOpts        :: [DocOption],
    ghcHaddockModInfo :: HaddockModInfo Name,
    ghcMbDoc          :: Maybe (HsDoc Name),
    ghcGroup          :: HsGroup Name,
@@ -497,7 +497,7 @@ moduleDataGHC :: CheckedMod -> ModuleDataGHC
 moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
   ghcModule         = mod,
   ghcFilename       = file,
-  ghcMbDocOpts      = mbOpts,
+  ghcDocOpts        = opts,
   ghcHaddockModInfo = info,
   ghcMbDoc          = mbDoc,
   ghcGroup          = group,
@@ -507,8 +507,8 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
   ghcInstances      = modInfoInstances modInfo
 }
   where
-    HsModule _ _ _ _ _ mbOpts _ _      = unLoc parsed
-    (group, _, mbExports, mbDoc, info) = renamed
+    HsModule _ _ _ _ _ opts _ _      = unLoc parsed
+    (group, _, mbExports, (mbDoc, info, nodocs)) = renamed
     (parsed, renamed, _, modInfo)      = checkedMod 
 
 -- | Massage the data in ModuleDataGHC to produce something closer to what
@@ -518,11 +518,9 @@ moduleDataGHC (mod, file, checkedMod) = ModuleDataGHC {
 pass1data :: ModuleDataGHC -> [Flag] -> ModuleMap -> ErrMsgM HaddockModule
 pass1data modData flags modMap = do
 
-  let mod = ghcModule modData
-
-  opts <- mkDocOpts (ghcMbDocOpts modData) mod
-
-  let group        = ghcGroup modData
+  let mod          = ghcModule modData
+      opts         = docOpts (ghcDocOpts modData) mod
+      group        = ghcGroup modData
       entities     = (nubBy sameName . collectEntities) group
       exports      = fmap (reverse . map unLoc) (ghcMbExports modData)
       entityNames_ = entityNames entities
@@ -545,7 +543,7 @@ pass1data modData flags modMap = do
   -- documentation, if the 'prune' option is on.
   let 
     prunedExportItems
-      | OptPrune `elem` opts = pruneExportItems exportItems
+      | DocOptPrune `elem` opts = pruneExportItems exportItems
       | otherwise = exportItems
  
   return HM {
@@ -567,14 +565,10 @@ pass1data modData flags modMap = do
     hmod_instances          = ghcInstances modData
   }
   where
-    mkDocOpts mbOpts mod = do
-      opts <- case mbOpts of 
-        Just opts -> processOptions opts
-        Nothing -> return []
-      let opts' = if Flag_HideModule (moduleString mod) `elem` flags 
-            then OptHide : opts
-            else opts      
-      return opts'
+    docOpts opts mod =  
+      if Flag_HideModule (moduleString mod) `elem` flags 
+        then DocOptHide : opts
+        else opts      
 
 -- | Produce a map of HaddockModules with information that is close to 
 -- renderable.  What is lacking after this pass are the renamed export items.
@@ -822,7 +816,7 @@ renameModule renamingEnv mod =
   in do
     -- report things that we couldn't link to. Only do this for non-hidden
     -- modules.
-    when (OptHide `notElem` hmod_options mod && not (null strings)) $
+    when (DocOptHide `notElem` hmod_options mod && not (null strings)) $
 	  tell ["Warning: " ++ show (ppr (hmod_mod mod) defaultUserStyle) ++ 
 		": could not find link destinations for:\n"++
 		"   " ++ concat (map (' ':) strings) ]
@@ -852,7 +846,7 @@ mkExportItems
 
 mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_map entities
               opts maybe_exps ignore_all_exports docMap
-  | isNothing maybe_exps || ignore_all_exports || OptIgnoreExports `elem` opts
+  | isNothing maybe_exps || ignore_all_exports || DocOptIgnoreExports `elem` opts
     = everything_local_exported
   | Just specs <- maybe_exps = do 
       exps <- mapM lookupExport specs
@@ -899,7 +893,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m
 	| otherwise = 
 	   case Map.lookup m mod_map of
 	     Just hmod
-		| OptHide `elem` hmod_options hmod
+		| DocOptHide `elem` hmod_options hmod
 			-> return (hmod_export_items hmod)
 		| otherwise -> return [ ExportModule m ]
 	     Nothing -> return [] -- already emitted a warning in visibleNames
@@ -1004,7 +998,7 @@ mkVisibleNames :: Module
 mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap 
   -- if no export list, just return all local names 
   | Nothing <- maybeExps         = return (filter hasDecl localNames)
-  | OptIgnoreExports `elem` opts = return localNames
+  | DocOptIgnoreExports `elem` opts = return localNames
   | Just expspecs <- maybeExps = do
       visibleNames <- mapM extract expspecs
       return $ filter isNotPackageName (concat visibleNames)
@@ -1029,7 +1023,7 @@ mkVisibleNames mdl modMap localNames scope subMap maybeExps opts declMap
 	| otherwise -> let m' = mkModule (modulePackageId mdl) m in
 	  case Map.lookup m' modMap of
 	    Just mod
-		| OptHide `elem` hmod_options mod ->
+		| DocOptHide `elem` hmod_options mod ->
 		    return (filter (`elem` scope) (hmod_exports mod))
 		| otherwise -> return []
 	    Nothing
@@ -1065,9 +1059,9 @@ buildGlobalDocEnv modules
  = foldl upd Map.empty (reverse modules)
  where
   upd old_env mod
-     | OptHide `elem` hmod_options mod
+     | DocOptHide `elem` hmod_options mod
      = old_env
-     | OptNotHome `elem` hmod_options mod
+     | DocOptNotHome `elem` hmod_options mod
      = foldl' keep_old old_env exported_names
      | otherwise
      = foldl' keep_new old_env exported_names
@@ -1095,30 +1089,6 @@ findNamedDoc name entities = search entities
 		   	| otherwise = search rest
 	      search (_other_decl : rest) = search rest
 
--- -----------------------------------------------------------------------------
--- Haddock options embedded in the source file
-
-processOptions_ str = let (opts, msg) = runWriter (processOptions str) 
-                      in print msg >> return opts 
-
-processOptions :: String -> ErrMsgM [DocOption]
-processOptions str = do
-  case break (== ',') str of
-    (this, ',':rest) -> do
-	opt <- parseOption this
-	opts <- processOptions rest
-	return (maybeToList opt ++ opts)
-    (this, _)
-	| all isSpace this -> return []
-	| otherwise -> do opt <- parseOption this; return (maybeToList opt)
-
-parseOption :: String -> ErrMsgM (Maybe DocOption)
-parseOption "hide" = return (Just OptHide)
-parseOption "prune" = return (Just OptPrune)
-parseOption "ignore-exports" = return (Just OptIgnoreExports)
-parseOption "not-home" = return (Just OptNotHome)
-parseOption other = do tell ["Unrecognised option: " ++ other]; return Nothing
-
 -- simplified type for sorting types, ignoring qualification (not visible
 -- in Haddock output) and unifying special tycons with normal ones.
 data SimpleType = SimpleType Name [SimpleType] deriving (Eq,Ord)