packages feed

haskell-docs 3.0.0 → 3.0.2

raw patch · 3 files changed

+122/−56 lines, 3 filesdep +optparse-applicativedep ~haddockPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: optparse-applicative

Dependency ranges changed: haddock

API changes (from Hackage documentation)

+ Documentation.Haddock.Docs: printType :: GhcMonad m => DynFlags -> ModuleName -> t -> String -> m ()
+ Documentation.Haddock.Docs: sdoc :: DynFlags -> SDoc -> String
+ Documentation.Haddock.Docs: showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
+ Documentation.Haddock.Docs: showppr :: Outputable a => DynFlags -> a -> String
- Documentation.Haddock.Docs: descendSearch :: DynFlags -> String -> Name -> PackageConfig -> IO Bool
+ Documentation.Haddock.Docs: descendSearch :: DynFlags -> String -> Name -> PackageConfig -> Ghc Bool
- Documentation.Haddock.Docs: printArgs :: InstalledInterface -> String -> IO ()
+ Documentation.Haddock.Docs: printArgs :: InstalledInterface -> String -> Ghc ()
- Documentation.Haddock.Docs: printDocumentation :: DynFlags -> String -> ModuleName -> Maybe String -> Maybe PackageConfig -> IO Bool
+ Documentation.Haddock.Docs: printDocumentation :: DynFlags -> String -> ModuleName -> Maybe String -> Maybe PackageConfig -> Ghc Bool
- Documentation.Haddock.Docs: printDocumentationInitialized :: String -> ModuleName -> Maybe String -> IO Bool
+ Documentation.Haddock.Docs: printDocumentationInitialized :: String -> ModuleName -> Maybe String -> [String] -> IO Bool
- Documentation.Haddock.Docs: printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> InstalledInterface -> IO Bool
+ Documentation.Haddock.Docs: printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> ModuleName -> InstalledInterface -> Ghc Bool
- Documentation.Haddock.Docs: printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> IO Bool
+ Documentation.Haddock.Docs: printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> Ghc Bool
- Documentation.Haddock.Docs: withInitializedPackages :: (DynFlags -> IO a) -> IO a
+ Documentation.Haddock.Docs: withInitializedPackages :: [String] -> (DynFlags -> Ghc a) -> IO a

Files

haskell-docs.cabal view
@@ -1,5 +1,5 @@ name:                haskell-docs-version:             3.0.0+version:             3.0.2 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@@ -57,16 +57,30 @@   build-depends:       base > 4 && < 5,                        ghc > 7.2 && < 7.9,                        ghc-paths,-                       haddock >= 2.9 && < 2.15,                        containers,-                       monad-loops+                       monad-loops,+                       optparse-applicative+  if impl(ghc==7.8.*)+    build-depends: haddock==2.14.*+  if impl(ghc==7.6.*)+    build-depends: haddock==2.13.*+  if impl(ghc==7.4.*)+    build-depends: haddock==2.11.*+  if impl(ghc==7.2.*)+    build-depends: haddock==2.9.* +  if impl(ghc>=7.8)+    build-depends: haddock+  if impl(ghc<7.2)+    build-depends: haddock+ executable haskell-docs   hs-source-dirs:      src/main   main-is:             Main.hs   build-depends:       base > 4 && < 5,                        ghc > 7.2 && < 7.9,-                       haskell-docs+                       haskell-docs,+                       optparse-applicative  source-repository head   type:        git
src/Documentation/Haddock/Docs.hs view
@@ -1,6 +1,7 @@-{-# OPTIONS -Wall #-}+{-# 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).@@ -18,10 +19,13 @@ 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)@@ -30,24 +34,24 @@ #endif  -- | Print documentation with an initialized package set.-printDocumentationInitialized :: String -> ModuleName -> Maybe String -> IO Bool-printDocumentationInitialized x y z =-  withInitializedPackages $ \d ->+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 -> IO Bool+printDocumentation :: DynFlags -> String -> ModuleName -> Maybe String -> Maybe PackageConfig -> Ghc Bool printDocumentation d name mname mpname previous = do-  result <- getPackagesByModule d mname+  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-          putStrLn $ "Ambiguous module, belongs to more than one package: " ++-                     unwords (map (showPackageName . sourcePackageId) packages) ++-                     "\nContinuing anyway... "+          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@@ -61,9 +65,9 @@ showPackageName = packageIdString . mkPackageId  -- | Print the documentation with the given package.-printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> IO Bool+printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> Ghc Bool printWithPackage d printPackage name mname package = do-  interfaceFiles <- getHaddockInterfacesByPackage package+  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@@ -71,39 +75,59 @@       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) interfaces+          interfaces -> anyM (printWithInterface d printPackage package name mname) interfaces  -- | Print the documentation from the given interface.-printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> InstalledInterface-                   -> IO Bool-printWithInterface df printPackage package name interface = do-  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-        _ -> do-          putStrLn $ "Couldn't find name ``" ++ name ++ "'' in Haddock interface: " ++-                     moduleNameString (moduleName (instMod interface))-          return False-    Just d -> do when printPackage $-                   putStrLn $ "Package: " ++ showPackageName (sourcePackageId package)-                 putStrLn (formatDoc d)-                 printArgs interface name-                 return True+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 qname ->+      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 qname 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 +printType d mname _qname name =+  do _graph <- depanal [] False+     _loaded <- load LoadAllTargets+#if __GLASGOW_HASKELL__ == 702+#else+     setContext [IIDecl (simpleImportDecl mname)]+#endif+     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.")+ -- | Print the documentation of the arguments.-printArgs :: InstalledInterface -> String -> IO ()+printArgs :: InstalledInterface -> String -> Ghc () printArgs interface name = do   case M.lookup name (interfaceArgMap interface) of     Nothing -> return ()     Just argMap ->-      putStr $ unlines-            $ map (\(i,x) -> formatArg i x)-                  (map (second (fmap getOccString)) (M.toList 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)@@ -117,7 +141,7 @@ -- | 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 -> IO Bool+descendSearch :: DynFlags -> String -> Name -> PackageConfig -> Ghc Bool descendSearch d name qname package = do   printDocumentation d name (moduleName (nameModule qname)) Nothing (Just package) @@ -221,16 +245,18 @@  -- | Get the Haddock interfaces of the given package. getHaddockInterfacesByPackage :: PackageConfig -> IO [Either String InterfaceFile]-getHaddockInterfacesByPackage = mapM (readInterfaceFile freshNameCache) . haddockInterfaces+getHaddockInterfacesByPackage =+  mapM (readInterfaceFile freshNameCache) . haddockInterfaces  -- | Run an action with an initialized GHC package set.-withInitializedPackages :: (DynFlags -> IO a) -> IO a-withInitializedPackages cont = do-  dflags <- run (do dflags <- getSessionDynFlags-                    _ <- setSessionDynFlags dflags-                    return dflags)-  (dflags',_packageids) <- initPackages dflags-  cont dflags'+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@@ -238,4 +264,24 @@ #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
src/main/Main.hs view
@@ -5,15 +5,21 @@ import Control.Monad import Documentation.Haddock.Docs import GHC (mkModuleName)-import System.Environment+import Options.Applicative --- | Main entry point. main :: IO () main = do-  args <- getArgs-  case args of-    [mname,name,pname] -> withInitializedPackages $ \d -> void $-                            printDocumentation d name (mkModuleName mname) (Just pname) Nothing-    [mname,name] -> withInitializedPackages $ \d -> void $-                      printDocumentation d name (mkModuleName mname) Nothing Nothing-    _ -> error "arguments: <modulename> <name> [<package name>]"+  (mname, name, pname, ghcopts) <- execParser opts+  withInitializedPackages ghcopts $ \d -> void $+      printDocumentation d name (mkModuleName mname) pname Nothing+ where+   opts = info (helper <*> p) fullDesc+   p = (\a b c d -> (a, b, c, d))+       <$> pModuleName+       <*> pName+       <*> (optional pPackageName)+       <*> pGhcOptions+   pModuleName  = argument str (metavar "<modulename>")+   pName        = argument str (metavar "<name>")+   pPackageName = argument str (metavar "<package name>")+   pGhcOptions  = many $ strOption (long "ghc-options" `mappend` short 'g')