haskell-docs 3.0.3 → 4.0.0

raw patch · 9 files changed

+469/−350 lines, 9 filesdep ~ghcPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• haskell-docs.cabal +7/−4
• src/Documentation/Haddock/Docs.hs +0/−320
• src/Haskell/Docs.hs +30/−0
• src/Haskell/Docs/Formatting.hs +107/−0
• src/Haskell/Docs/Ghc.hs +91/−0
• src/Haskell/Docs/Haddock.hs +164/−0
• src/Haskell/Docs/Types.hs +44/−0
• src/main/Main.hs +13/−7
• src/test/Main.hs +13/−19

@@ -1,5 +1,5 @@ name:                haskell-docs-version:             3.0.3+version:             4.0.0 synopsis:            A program to find and display the docs of a name from a                      given module. description:         Given a module name and a name, it will find and display@@ -54,9 +54,13 @@  library   hs-source-dirs:      src-  exposed-modules:     Documentation.Haddock.Docs+  exposed-modules:     Haskell.Docs,+                       Haskell.Docs.Ghc,+                       Haskell.Docs.Formatting,+                       Haskell.Docs.Haddock,+                       Haskell.Docs.Types   build-depends:       base > 4 && < 5,-                       ghc > 7.2 && < 7.9,+                       ghc >= 7.2 && < 7.9,                        ghc-paths,                        containers,                        monad-loops,@@ -79,7 +83,6 @@   hs-source-dirs:      src/main   main-is:             Main.hs   build-depends:       base > 4 && < 5,-                       ghc > 7.2 && < 7.9,                        haskell-docs,                        optparse-applicative 

@@ -1,320 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# OPTIONS -Wall -fno-warn-missing-signatures #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE StandaloneDeriving #-}---- | Lookup the documentation of a name in a module (and in a specific--- package in the case of ambiguity).--module Documentation.Haddock.Docs-  (withInitializedPackages-  ,printDocumentation-  ,mkModuleName-  ,getType)-  where--import           Control.Arrow-import           Control.Exception-import           Control.Monad-import           Control.Monad.Loops-import           Data.Char-import           Data.Either-import           Data.List-import           Data.Map (Map)-import qualified Data.Map as M-import           Data.Typeable-import           Documentation.Haddock-import           GHC hiding (verbosity)-import           GHC.Paths (libdir)-import           GhcMonad (liftIO)-import           Module-import           Name-import           Outputable-import           PackageConfig-import           Packages-import qualified SrcLoc--#if __GLASGOW_HASKELL__ < 706-import           DynFlags (defaultLogAction)-#else-import           DynFlags (defaultFlushOut, defaultFatalMessager)-#endif--data DocsException-  = Couldn'tFindModule-  deriving (Typeable,Show)-instance Exception DocsException---- | Print documentation with an initialized package set.-printDocumentationInitialized :: String -> ModuleName -> Maybe String -> [String] -> IO Bool-printDocumentationInitialized x y z ghcopts =-  withInitializedPackages ghcopts $ \d ->-    printDocumentation d x y z Nothing---- | Print the documentation of a name in the given module.-printDocumentation :: DynFlags -> String -> ModuleName -> Maybe String -> Maybe PackageConfig -> Ghc Bool-printDocumentation d name mname mpname previous = do-  result <- liftIO (getPackagesByModule d mname)-  case result of-    Left _suggestions -> error "Couldn't find that module. Suggestions are forthcoming."-    Right [package]   -> printWithPackage d False name mname package-    Right packages    ->-      case mpname of-        Nothing -> do-          liftIO (putStrLn $ "Ambiguous module, belongs to more than one package: " ++-                             unwords (map (showPackageName . sourcePackageId) packages) ++-                             "\nContinuing anyway... ")-          anyM (printWithPackage d True name mname) (filter (not . isPrevious) packages)-        Just pname -> do-          case find ((== pname) . showPackageName . sourcePackageId) packages of-            Nothing -> error "Unable to find that module/package combination."-            Just package -> printWithPackage d False name mname package--  where isPrevious m = Just (sourcePackageId m) == fmap sourcePackageId previous---- | Show the package name e.g. base.-showPackageName :: PackageIdentifier -> String-showPackageName = packageIdString . mkPackageId---- | Print the documentation with the given package.-printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> Ghc Bool-printWithPackage d printPackage name mname package = do-  interfaceFiles <- liftIO (getHaddockInterfacesByPackage package)-  case (lefts interfaceFiles,rights interfaceFiles) of-    ([],[])        -> error "Found no interface files."-    (errs@(_:_),_) -> error $ "Couldn't parse interface file(s): " ++ unlines errs-    (_,files)      ->-      flip anyM files $ \interfaceFile ->-        case filter ((==mname) . moduleName . instMod) (ifInstalledIfaces interfaceFile) of-          [] -> error "Couldn't find an interface for that module in the package description."-          interfaces -> anyM (printWithInterface d printPackage package name mname) interfaces---- | Print the documentation from the given interface.-printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> ModuleName -> InstalledInterface-                   -> Ghc Bool-printWithInterface df printPackage package name mname interface = do-  case find ((==name).getOccString) (instExports interface) of-    Nothing -> bail-    Just{} ->-      case M.lookup name docMap of-        Nothing -> do-          case lookup name (map (getOccString &&& id) (instExports interface)) of-            Just subname-              | moduleName (nameModule subname) /= moduleName (instMod interface) ->-                descendSearch df name subname package-            _ -> bail-        Just d ->-          do liftIO (when printPackage $-                       putStrLn $ "Package: " ++ showPackageName (sourcePackageId package))-             printType df mname name-             liftIO (putStrLn (formatDoc d))-             printArgs interface name-             return True--  where docMap = interfaceNameMap interface-        bail = do-          liftIO (putStrLn $ "Couldn't find name ``" ++ name ++ "'' in Haddock interface: " ++-                             moduleNameString (moduleName (instMod interface)))-          return False---- | Print the type of the given identifier from the given module.-printType :: DynFlags -> ModuleName -> String -> Ghc ()-printType d mname name =-  do _ <- depanal [] False-     _ <- load LoadAllTargets-     portableSetContext mname-     names <- getNamesInScope-     mty <- lookupName (head (filter ((==name).getOccString) names))-     case mty of-       Just (AnId i) -> liftIO (do putStr (showppr d i ++ " :: ")-                                   putStrLn (showppr d (idType i)))-       _ -> liftIO (putStrLn "Unable to find type for identifier.")----- | Get the type of the given identifier from the given module.-getType :: DynFlags -> ModuleName -> String -> Ghc String-getType d mname name =-  do _ <- depanal [] False-     _ <- load LoadAllTargets-     portableSetContext mname-     names <- getNamesInScope-     mty <- lookupName (head (filter ((==name).getOccString) names))-     case mty of-       Just (AnId i) -> return (showppr d (idType i))-       _ -> error "Unable to find type for identifier."---- | Set the import context.-portableSetContext :: ModuleName -> Ghc ()-#if __GLASGOW_HASKELL__ == 702-portableSetContext mname = setContext [] [simpleImportDecl mname]-#else-portableSetContext mname = setContext [IIDecl (simpleImportDecl mname)]-#endif---- | Print the documentation of the arguments.-printArgs :: InstalledInterface -> String -> Ghc ()-printArgs interface name = do-  case M.lookup name (interfaceArgMap interface) of-    Nothing -> return ()-    Just argMap ->-      liftIO (putStr $ unlines-                     $ map (\(i,x) -> formatArg i x)-                           (map (second (fmap getOccString)) (M.toList argMap)))--  where formatArg i x = prefix ++-                        indentAfter (length prefix) (formatDoc x)-          where prefix = show i ++ ": "---- | Indent after the first line.-indentAfter :: Int -> String -> String-indentAfter i xs = intercalate "\n" (take 1 l ++ map (replicate (i-1) ' ' ++) (drop 1 l))-  where l = lines xs---- | The module symbol doesn't actually exist in the module we--- intended, so we descend into the module that it does exist in and--- restart our search process.-descendSearch :: DynFlags -> String -> Name -> PackageConfig -> Ghc Bool-descendSearch d name qname package = do-  printDocumentation d name (moduleName (nameModule qname)) Nothing (Just package)------------------------------------------------------------------------------------- Printing documentation---- | Format some documentation to plain text.-formatDoc :: Doc String -> String-formatDoc = trim . doc where---- | Render the doc.-doc :: Doc String -> String-doc DocEmpty = ""-doc (DocAppend a b) = doc a ++ doc b-doc (DocString str) = normalize str-doc (DocParagraph p) = doc p ++ "\n"-doc (DocModule m) = m-doc (DocEmphasis e) = "*" ++ doc e ++ "*"-doc (DocMonospaced e) = "`" ++ doc e ++ "`"-doc (DocUnorderedList i) = unlines (map (("* " ++) . doc) i)-doc (DocOrderedList i) = unlines (zipWith (\j x -> show j ++ ". " ++ doc x) [1 :: Int ..] i)-doc (DocDefList xs) = unlines (map (\(i,x) -> doc i ++ ". " ++ doc x) xs)-doc (DocCodeBlock block) = unlines (map ("    " ++) (lines (doc block))) ++ "\n"-doc (DocAName name) = name-doc (DocExamples exs) = unlines (map formatExample exs)--#if MIN_VERSION_haddock(2,10,0)--- The header type is unexported, so this constructor is useless.-doc (DocIdentifier i) = i-doc (DocWarning d) = "Warning: " ++ doc d-#else-doc (DocPic pic) = pic-doc (DocIdentifier i) = intercalate "." i-#endif--#if MIN_VERSION_haddock(2,11,0)-doc (DocIdentifierUnchecked (mname,occname)) =-  moduleNameString mname ++ "." ++ occNameString occname-doc (DocPic pic) = show pic-#endif--#if MIN_VERSION_haddock(2,13,0)-doc (DocHyperlink (Hyperlink url label)) = maybe url (\l -> l ++ "[" ++ url ++ "]") label-doc (DocProperty p) = "Property: " ++ p-#else-doc (DocURL url) = url-#endif--#if MIN_VERSION_haddock(2,14,0)-doc (DocBold d) = "**" ++ doc d ++ "**"-doc (DocHeader _) = ""-#endif--normalize :: [Char] -> [Char]-normalize = go where-  go (' ':' ':cs) = go (' ':cs)-  go (c:cs)       = c : go cs-  go []           = []---- | Trim either side of a string.-trim :: [Char] -> [Char]-trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace---- | Format an example to plain text.-formatExample :: Example -> String-formatExample (Example expression result) =-  "    > " ++ expression ++-  unlines (map ("    " ++) result)------------------------------------------------------------------------------------- Package querying functions---- | Get a mapping from names to doc string of that name from a--- Haddock interface.-interfaceNameMap :: InstalledInterface -> Map String (Doc String)-#if MIN_VERSION_haddock(2,10,0)-interfaceNameMap iface =-  M.fromList (map (second (fmap getOccString) . first getOccString)-             (M.toList (instDocMap iface)))-#else-interfaceNameMap iface =-  M.fromList (map (second (fmap getOccString . maybe DocEmpty id . fst) . first getOccString)-             (M.toList (instDocMap iface)))-#endif---- | Get a mapping from names to doc string of that name from a--- Haddock interface.-interfaceArgMap :: InstalledInterface -> Map String (Map Int (Doc Name))-#if MIN_VERSION_haddock(2,10,0)-interfaceArgMap iface =-  M.fromList (map (first getOccString) (M.toList (instArgMap iface)))-#else-interfaceArgMap iface = M.fromList (map (second (const M.empty) . first getOccString)-                                        (M.toList (instDocMap iface)))-#endif--- | Search for a module's package, returning suggestions if not--- found.-getPackagesByModule :: DynFlags -> ModuleName -> IO (Either [Module] [PackageConfig])-getPackagesByModule d m =-  return (fmap (map fst) (lookupModuleWithSuggestions d m))---- | Get the Haddock interfaces of the given package.-getHaddockInterfacesByPackage :: PackageConfig -> IO [Either String InterfaceFile]-getHaddockInterfacesByPackage =-  mapM (readInterfaceFile freshNameCache) . haddockInterfaces---- | Run an action with an initialized GHC package set.-withInitializedPackages :: [String] -> (DynFlags -> Ghc a) -> IO a-withInitializedPackages ghcopts cont =-  run (do dflags <- getSessionDynFlags-          (dflags', _, _) <- parseDynamicFlags dflags (map SrcLoc.noLoc ghcopts)-          _ <- setSessionDynFlags (dflags' { hscTarget = HscInterpreted-                                            , ghcLink = LinkInMemory })-          (dflags'',_packageids) <- liftIO (initPackages dflags')-          cont dflags'')--#if __GLASGOW_HASKELL__ < 706-run :: Ghc a -> IO a-run = defaultErrorHandler defaultLogAction . runGhc (Just libdir)-#else-run :: Ghc a -> IO a-run = defaultErrorHandler defaultFatalMessager defaultFlushOut . runGhc (Just libdir)-#endif--showppr :: Outputable a => DynFlags -> a -> String-showppr dflags = Documentation.Haddock.Docs.showSDocForUser dflags neverQualify . ppr--sdoc :: DynFlags -> SDoc -> String-sdoc dflags = Documentation.Haddock.Docs.showSDocForUser dflags neverQualify---- | Wraps 'Outputable.showSDocForUser'.-#if __GLASGOW_HASKELL__ == 702-showSDocForUser _ = Outputable.showSDocForUser-#endif-#if __GLASGOW_HASKELL__ == 704-showSDocForUser _ = Outputable.showSDocForUser-#endif-#if __GLASGOW_HASKELL__ == 706-showSDocForUser = Outputable.showSDocForUser-#endif-#if __GLASGOW_HASKELL__ == 708-showSDocForUser = Outputable.showSDocForUser-#endif

@@ -0,0 +1,30 @@+-- | Lookup the documentation of a name in a module (and in a specific+-- package in the case of ambiguity).++module Haskell.Docs+  (module Haskell.Docs+  ,Identifier(..)+  ,PackageName(..))+  where++import Haskell.Docs.Formatting+import Haskell.Docs.Haddock+import Haskell.Docs.Types++import GHC hiding (verbosity)+import GhcMonad (liftIO)+import System.IO++-- -- | Print the documentation of a name in the given module.+printDocForIdentInModule+  :: Maybe PackageName -- ^ Package.+  -> ModuleName        -- ^ Module name.+  -> Identifier        -- ^ Identifier.+  -> Ghc ()+printDocForIdentInModule pname mname name =+  do result <- search Nothing pname mname name+     case result of+       Left err ->+         error (show err)+       Right docs ->+         mapM_ printIdentDoc docs

@@ -0,0 +1,107 @@+{-# LANGUAGE CPP #-}++-- | Formatting of Haddock documentation.++module Haskell.Docs.Formatting where++import Haskell.Docs.Types+import Haskell.Docs.Ghc++import Data.Char+import Data.List+import Documentation.Haddock+import GHC hiding (verbosity)+import GhcMonad (liftIO)+import Name++-- * Formatting++-- | Print an identifier' documentation.+printIdentDoc :: IdentDoc -> Ghc ()+printIdentDoc idoc =+  do d <- getSessionDynFlags+     liftIO (putStrLn ("Package: " ++ showPackageName (identDocPackageName idoc)))+     case identDocIdent idoc of+       Nothing -> return ()+       Just i -> liftIO (putStrLn (showppr d i ++ " :: " ++ showppr d (idType i)))+     liftIO (putStrLn (formatDoc (identDocDocs idoc)))+     case identDocArgDocs idoc of+       Nothing -> return ()+       Just args -> liftIO (putStr (unlines (map (\(i,x) -> formatArg i x) args)))++-- | Format some documentation to plain text.+formatDoc :: Doc String -> String+formatDoc = trim . doc where++-- * Internal functions++-- | Render the doc.+doc :: Doc String -> String+doc DocEmpty = ""+doc (DocAppend a b) = doc a ++ doc b+doc (DocString str) = normalize str+doc (DocParagraph p) = doc p ++ "\n"+doc (DocModule m) = m+doc (DocEmphasis e) = "*" ++ doc e ++ "*"+doc (DocMonospaced e) = "`" ++ doc e ++ "`"+doc (DocUnorderedList i) = unlines (map (("* " ++) . doc) i)+doc (DocOrderedList i) = unlines (zipWith (\j x -> show j ++ ". " ++ doc x) [1 :: Int ..] i)+doc (DocDefList xs) = unlines (map (\(i,x) -> doc i ++ ". " ++ doc x) xs)+doc (DocCodeBlock bl) = unlines (map ("    " ++) (lines (doc bl))) ++ "\n"+doc (DocAName name) = name+doc (DocExamples exs) = unlines (map formatExample exs)++#if MIN_VERSION_haddock(2,10,0)+-- The header type is unexported, so this constructor is useless.+doc (DocIdentifier i) = i+doc (DocWarning d) = "Warning: " ++ doc d+#else+doc (DocPic pic) = pic+doc (DocIdentifier i) = intercalate "." i+#endif++#if MIN_VERSION_haddock(2,11,0)+doc (DocIdentifierUnchecked (mname,occname)) =+  moduleNameString mname ++ "." ++ occNameString occname+doc (DocPic pic) = show pic+#endif++#if MIN_VERSION_haddock(2,13,0)+doc (DocHyperlink (Hyperlink url label)) = maybe url (\l -> l ++ "[" ++ url ++ "]") label+doc (DocProperty p) = "Property: " ++ p+#else+doc (DocURL url) = url+#endif++#if MIN_VERSION_haddock(2,14,0)+doc (DocBold d) = "**" ++ doc d ++ "**"+doc (DocHeader _) = ""+#endif++-- | Strip redundant whitespace.+normalize :: [Char] -> [Char]+normalize = go where+  go (' ':' ':cs) = go (' ':cs)+  go (c:cs)       = c : go cs+  go []           = []++-- | Trim either side of a string.+trim :: [Char] -> [Char]+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace++-- | Format an example to plain text.+formatExample :: Example -> String+formatExample (Example expression result) =+  "    > " ++ expression +++  unlines (map ("    " ++) result)++-- | Format an argument.+formatArg :: Show a => a -> Doc String -> String+formatArg i x = prefix +++                indentAfter (length prefix) (formatDoc x)+  where prefix = show i ++ ": "++-- | Indent after the first line.+indentAfter :: Int -> String -> String+indentAfter i xs = intercalate "\n" (take 1 l ++ map (replicate (i-1) ' ' ++) (drop 1 l))+  where l = lines xs

@@ -0,0 +1,91 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS -Wall -fno-warn-missing-signatures #-}++-- | Ghc compatibility layer.++module Haskell.Docs.Ghc where++import           Haskell.Docs.Types++import           GHC hiding (verbosity)+import           GHC.Paths (libdir)+import           GhcMonad (liftIO)+import           Outputable+import           Packages+import qualified SrcLoc+import           Name+import           Module++#if __GLASGOW_HASKELL__ < 706+import           DynFlags (defaultLogAction)+#else+import           DynFlags (defaultFlushOut, defaultFatalMessager)+#endif++-- * GHC actions++-- | Run an action with an initialized GHC package set.+withInitializedPackages :: [String] -> Ghc a -> IO a+withInitializedPackages ghcopts m =+  run (do dflags <- getSessionDynFlags+          (dflags', _, _) <- parseDynamicFlags dflags (map SrcLoc.noLoc ghcopts)+          _ <- setSessionDynFlags (dflags' { hscTarget = HscInterpreted+                                            , ghcLink = LinkInMemory })+          (_dflags'',_packageids) <- liftIO (initPackages dflags')+          m)++-- | Get the type of the given identifier from the given module.+findIdentifier :: ModuleName -> Identifier -> Ghc (Maybe Id)+findIdentifier mname name =+  do _ <- depanal [] False+     _ <- load LoadAllTargets+     setImportContext mname+     names <- getNamesInScope+     mty <- lookupName (head (filter ((==unIdentifier name).getOccString) names))+     case mty of+       Just (AnId i) -> return (Just i)+       _ -> return Nothing++-- | Make a module name.+makeModuleName :: String -> ModuleName+makeModuleName = mkModuleName++-- * Internal functions++-- | Run the given GHC action.+#if __GLASGOW_HASKELL__ < 706+run :: Ghc a -> IO a+run = defaultErrorHandler defaultLogAction . runGhc (Just libdir)+#else+run :: Ghc a -> IO a+run = defaultErrorHandler defaultFatalMessager defaultFlushOut . runGhc (Just libdir)+#endif++-- | Pretty print something to string.+showppr dflags = Haskell.Docs.Ghc.showSDocForUser dflags neverQualify . ppr++-- | Wraps 'Outputable.showSDocForUser'.+#if __GLASGOW_HASKELL__ == 702+showSDocForUser _ = Outputable.showSDocForUser+#endif+#if __GLASGOW_HASKELL__ == 704+showSDocForUser _ = Outputable.showSDocForUser+#endif+#if __GLASGOW_HASKELL__ == 706+showSDocForUser = Outputable.showSDocForUser+#endif+#if __GLASGOW_HASKELL__ == 708+showSDocForUser = Outputable.showSDocForUser+#endif++-- | Set the import context.+setImportContext :: ModuleName -> Ghc ()+#if __GLASGOW_HASKELL__ == 702+setImportContext mname = setContext [] [simpleImportDecl mname]+#else+setImportContext mname = setContext [IIDecl (simpleImportDecl mname)]+#endif++-- | Show the package name e.g. base.+showPackageName :: PackageIdentifier -> String+showPackageName = packageIdString . mkPackageId

@@ -0,0 +1,164 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS -Wall -fno-warn-missing-signatures #-}++-- | Haddock compatibilty layer and query functions.++module Haskell.Docs.Haddock where++import           Haskell.Docs.Ghc+import           Haskell.Docs.Types++import           Control.Arrow+import           Control.Monad+import           Data.Either+import           Data.List+import           Data.Map (Map)+import qualified Data.Map as M+import           Documentation.Haddock+import           GHC hiding (verbosity)+import           GhcMonad (liftIO)+import           Name+import           PackageConfig+import           Packages++-- * Searching for ident docs++-- | Search a name in the given module.+search :: Maybe PackageConfig+       -> Maybe PackageName+       -> ModuleName+       -> Identifier+       -> Ghc (Either DocsException [IdentDoc])+search mprevious mpname mname name = do+  result <- getPackagesByModule mname+  case result of+    Left{} ->+      return (Left NoFindModule)+    Right [package]   ->+      searchWithPackage package mname name+    Right packages  ->+      case mpname of+        Nothing -> do+          fmap (Right . concat . rights)+               (mapM (\package -> searchWithPackage package mname name)+                     (filter (not . isPrevious) packages))+        Just pname -> do+          case find ((== pname) . PackageName . showPackageName . sourcePackageId) packages of+            Nothing ->+              return (Left NoModulePackageCombo)+            Just package ->+              searchWithPackage package mname name+  where isPrevious m =+          Just (sourcePackageId m) == fmap sourcePackageId mprevious++-- | Search for the given identifier in the given package.+searchWithPackage+  :: PackageConfig+  -> ModuleName+  -> Identifier+  -> Ghc (Either DocsException [IdentDoc])+searchWithPackage package mname name = do+  interfaceFiles <- getHaddockInterfacesByPackage package+  case (lefts interfaceFiles,rights interfaceFiles) of+    ([],[])        -> return (Left NoInterfaceFiles)+    (errs@(_:_),_) -> return (Left (NoParseInterfaceFiles errs))+    (_,files)      ->+      fmap (Right . concat)+           (forM files+                 (\interfaceFile ->+                    fmap (concat . rights)+                         (mapM (searchWithInterface package mname name)+                               (filter ((==mname) . moduleName . instMod)+                                       (ifInstalledIfaces interfaceFile)))))++-- | Search for the given identifier in the interface.+searchWithInterface+  :: PackageConfig+  -> ModuleName+  -> Identifier+  -> InstalledInterface+  -> Ghc (Either DocsException [IdentDoc])+searchWithInterface package mname name interface =+  case find ((==name) . Identifier . getOccString) (instExports interface) of+    Nothing ->+      return (Left NoFindNameInExports)+    Just{} ->+      case M.lookup (unIdentifier name) (interfaceNameMap interface) of+        Nothing ->+          case lookup (unIdentifier name) (map (getOccString &&& id) (instExports interface)) of+            Just subname+              | moduleName (nameModule subname) /= moduleName (instMod interface) ->+                descendSearch package name subname+            _ ->+              return (Left NoFindNameInInterface)+        Just d ->+          do mi <- findIdentifier mname name+             margs <- lookupArgsDocs interface name+             return+               (Right+                  [IdentDoc (sourcePackageId package)+                            d+                            mi+                            margs])++-- * Get documentation of parts of things++-- | Get a mapping from names to doc string of that name from a+-- Haddock interface.+interfaceNameMap :: InstalledInterface -> Map String (Doc String)+#if MIN_VERSION_haddock(2,10,0)+interfaceNameMap iface =+  M.fromList (map (second (fmap getOccString) . first getOccString)+             (M.toList (instDocMap iface)))+#else+interfaceNameMap iface =+  M.fromList (map (second (fmap getOccString . maybe DocEmpty id . fst) . first getOccString)+             (M.toList (instDocMap iface)))+#endif++-- | Get a mapping from names to doc string of that name from a+-- Haddock interface.+interfaceArgMap :: InstalledInterface -> Map String (Map Int (Doc Name))+#if MIN_VERSION_haddock(2,10,0)+interfaceArgMap iface =+  M.fromList (map (first getOccString) (M.toList (instArgMap iface)))+#else+interfaceArgMap iface = M.fromList (map (second (const M.empty) . first getOccString)+                                        (M.toList (instDocMap iface)))+#endif++-- | Find arguments documentation for the identifier.+lookupArgsDocs :: InstalledInterface -> Identifier -> Ghc (Maybe [(Int, Doc String)])+lookupArgsDocs interface name = do+  case M.lookup (unIdentifier name) (interfaceArgMap interface) of+    Nothing -> return Nothing+    Just argMap ->+      return (Just (map (second (fmap getOccString)) (M.toList argMap)))++-- * Querying for packages and interfaces++-- | Search for a module's package, returning suggestions if not+-- found.+getPackagesByModule :: ModuleName -> Ghc (Either [Module] [PackageConfig])+getPackagesByModule m =+  do df <- getSessionDynFlags+     return (fmap (map fst) (lookupModuleWithSuggestions df m))++-- | Get the Haddock interfaces of the given package.+getHaddockInterfacesByPackage :: PackageConfig -> Ghc [Either DocsException InterfaceFile]+getHaddockInterfacesByPackage =+  liftIO .+  mapM (fmap (either (Left . NoReadInterfaceFile) Right) . readInterfaceFile freshNameCache) .+  haddockInterfaces++-- * Internal functions++-- | The module symbol doesn't actually exist in the module we+-- intended, so we descend into the module that it does exist in and+-- restart our search process.+descendSearch :: PackageConfig -> Identifier -> Name -> Ghc (Either DocsException [IdentDoc])+descendSearch package name qname = do+  search (Just package) Nothing (moduleName (nameModule qname)) name

@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | All types.++module Haskell.Docs.Types+  (IdentDoc(..)+  ,DocsException(..)+  ,Identifier(..)+  ,PackageName(..))+  where++import Control.Exception (Exception)+import Data.Typeable (Typeable)+import Documentation.Haddock (Doc)+import GHC (Id)+import PackageConfig (PackageIdentifier)++-- | An identifier.+newtype Identifier = Identifier {unIdentifier :: String}+  deriving (Show,Eq)++-- | An package name.+newtype PackageName = PackageName String+  deriving (Show,Eq)++-- | Identier documentation along with argument docs and identifiers.+data IdentDoc = IdentDoc+  { identDocPackageName :: !PackageIdentifier+  , identDocDocs        :: !(Doc String)+  , identDocIdent       :: !(Maybe Id)+  , identDocArgDocs     :: !(Maybe [(Int, Doc String)])+  }++-- | An exception when doing lookups.+data DocsException+  = NoFindModule+  | NoModulePackageCombo+  | NoInterfaceFiles+  | NoParseInterfaceFiles [DocsException]+  | NoFindNameInExports+  | NoFindNameInInterface+  | NoReadInterfaceFile String+  deriving (Typeable,Show)+instance Exception DocsException

@@ -1,17 +1,23 @@ {-# OPTIONS -Wall #-} +-- | Main command-line interface.+ module Main where -import Control.Monad-import Documentation.Haddock.Docs-import GHC (mkModuleName)+import Haskell.Docs+import Haskell.Docs.Ghc+ import Options.Applicative +-- | Main entry point. main :: IO ()-main = do-  (mname, name, pname, ghcopts) <- execParser opts-  withInitializedPackages ghcopts $ \d -> void $-      printDocumentation d name (mkModuleName mname) pname Nothing+main =+  do (mname, name, pname, ghcopts) <- execParser opts+     withInitializedPackages+       ghcopts+       (printDocForIdentInModule (fmap PackageName pname)+                                 (makeModuleName mname)+                                 (Identifier name))  where    opts = info (helper <*> p) fullDesc    p = (\a b c d -> (a, b, c, d))

@@ -4,7 +4,8 @@  import qualified Control.Exception as E import           Control.Monad-import           Documentation.Haddock.Docs+import           Haskell.Docs+import           Haskell.Docs.Ghc import           System.Exit import           System.IO @@ -25,7 +26,7 @@ initialization :: IO () initialization =   do it "withInitializedPackages"-        (withInitializedPackages [] (\dflags -> return ()))+        (withInitializedPackages [] (return ()))  -- | Test GHC docs. docs :: IO ()@@ -33,13 +34,10 @@   do it "printDocumentation"         (withInitializedPackages            []-           (\d ->-              void (printDocumentation-                     d-                     "hSetBuffering"-                     (mkModuleName "System.IO")-                     Nothing-                     Nothing)))+           (void (printDocForIdentInModule+                   Nothing+                   (makeModuleName "System.IO")+                   (Identifier "hSetBuffering"))))  -- | Test GHC types. types :: IO ()@@ -47,16 +45,12 @@   do it "getType"         (withInitializedPackages            []-           (\d ->-              do void (printDocumentation-                        d-                        "hSetBuffering"-                        (mkModuleName "System.IO")-                        Nothing-                        Nothing)-                 void (getType d-                               (mkModuleName "System.IO")-                               "hSetBuffering")))+           (do void (printDocForIdentInModule+                      Nothing+                      (makeModuleName "System.IO")+                      (Identifier "hSetBuffering"))+               void (findIdentifier (makeModuleName "System.IO")+                                    (Identifier "hSetBuffering"))))  -- | Describe a test spec. describe :: String -> IO () -> IO ()