haskell-docs 4.0.0 → 4.1.0

raw patch · 9 files changed

+256/−95 lines, 9 filesdep +Cabaldep −optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: Cabal

Dependencies removed: optparse-applicative

API changes (from Hackage documentation)

Files

• haskell-docs.cabal +6/−5
• src/Haskell/Docs.hs +17/−5
• src/Haskell/Docs/Cabal.hs +57/−0
• src/Haskell/Docs/Formatting.hs +13/−3
• src/Haskell/Docs/Ghc.hs +11/−8
• src/Haskell/Docs/Haddock.hs +97/−48
• src/Haskell/Docs/Types.hs +4/−0
• src/main/Main.hs +38/−20
• src/test/Main.hs +13/−6

@@ -1,5 +1,5 @@ name:                haskell-docs-version:             4.0.0+version:             4.1.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@@ -53,18 +53,20 @@ Bug-Reports:         http://github.com/chrisdone/haskell-docs/issues  library+  ghc-options:         -O2 -Wall   hs-source-dirs:      src   exposed-modules:     Haskell.Docs,                        Haskell.Docs.Ghc,+                       Haskell.Docs.Cabal,                        Haskell.Docs.Formatting,                        Haskell.Docs.Haddock,                        Haskell.Docs.Types   build-depends:       base > 4 && < 5,                        ghc >= 7.2 && < 7.9,+                       Cabal,                        ghc-paths,                        containers,-                       monad-loops,-                       optparse-applicative+                       monad-loops   if impl(ghc==7.8.*)     build-depends: haddock==2.14.*   if impl(ghc==7.6.*)@@ -83,8 +85,7 @@   hs-source-dirs:      src/main   main-is:             Main.hs   build-depends:       base > 4 && < 5,-                       haskell-docs,-                       optparse-applicative+                       haskell-docs  test-suite test     type: exitcode-stdio-1.0

@@ -1,3 +1,4 @@+{-# LANGUAGE TupleSections #-} -- | Lookup the documentation of a name in a module (and in a specific -- package in the case of ambiguity). @@ -7,6 +8,8 @@   ,PackageName(..))   where +import Control.Monad+import Data.List import Haskell.Docs.Formatting import Haskell.Docs.Haddock import Haskell.Docs.Types@@ -16,15 +19,24 @@ import System.IO  -- -- | Print the documentation of a name in the given module.-printDocForIdentInModule+searchAndPrintDoc   :: Maybe PackageName -- ^ Package.-  -> ModuleName        -- ^ Module name.+  -> Maybe ModuleName  -- ^ Module name.   -> Identifier        -- ^ Identifier.   -> Ghc ()-printDocForIdentInModule pname mname name =-  do result <- search Nothing pname mname name+searchAndPrintDoc pname mname ident =+  do (result,printPkg,printModule) <- search      case result of        Left err ->          error (show err)        Right docs ->-         mapM_ printIdentDoc docs+         mapM_ (\(i,doc) -> do when (i > 0)+                                    (liftIO (putStrLn ""))+                               printIdentDoc printPkg printModule doc)+               (zip [0..] (nub docs))+  where search =+          case (pname,mname) of+            (Just p,Just m) -> fmap (,False,False) (searchPackageModuleIdent Nothing p m ident)+            (Nothing,Just m) -> fmap (,True,False) (searchModuleIdent Nothing m ident)+            (Nothing,Nothing) -> fmap (,True,True) (searchIdent Nothing ident)+            _ -> error "arguments: <ident> | <module-name> <ident> [<package-name>]"

@@ -0,0 +1,57 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RecordWildCards #-}++-- | Cabal.++module Haskell.Docs.Cabal where++import Data.Function+import Haskell.Docs.Ghc++import Data.List+import Distribution.InstalledPackageInfo+import Distribution.ModuleName+import Distribution.Package+import Distribution.Simple.Compiler+import Distribution.Simple.GHC+import Distribution.Simple.PackageIndex+import Distribution.Simple.Program+import Distribution.Verbosity+import Module+import PackageConfig++-- * Cabal++-- | Get all installed packages, filtering out the given package.+getAllPackages :: IO [PackageConfig]+getAllPackages =+  do config <- configureAllKnownPrograms+                 normal+                 (addKnownPrograms [ghcProgram,ghcPkgProgram]+                                   emptyProgramConfiguration)+     index <- getInstalledPackages+                normal+                [GlobalPackageDB,UserPackageDB]+                config+     return (map (imap convModule)+                 (concat (packagesByName index)))++-- | Version-portable version of allPackagesByName.+packagesByName :: PackageIndex -> [[InstalledPackageInfo]]+#if MIN_VERSION_Cabal(1,16,0)+packagesByName = map snd . allPackagesByName+#else+packagesByName = allPackagesByName+#endif++-- * Internal modules++-- | Convert a Cabal module name to a GHC module name.+convModule :: Distribution.ModuleName.ModuleName -> Module.ModuleName+convModule = makeModuleName . intercalate "." . components++-- | Because no Functor instance is available.+imap :: (a -> m) -> InstalledPackageInfo_ a -> InstalledPackageInfo_ m+imap f i@(InstalledPackageInfo{..}) =+  i { exposedModules = map f exposedModules+    , hiddenModules = map f hiddenModules }

@@ -7,6 +7,7 @@ import Haskell.Docs.Types import Haskell.Docs.Ghc +import Control.Monad import Data.Char import Data.List import Documentation.Haddock@@ -17,10 +18,19 @@ -- * Formatting  -- | Print an identifier' documentation.-printIdentDoc :: IdentDoc -> Ghc ()-printIdentDoc idoc =+printIdentDoc :: Bool -- ^ Print package?+              -> Bool -- ^ Print module?+              -> IdentDoc+              -> Ghc ()+printIdentDoc printPkg printModule idoc =   do d <- getSessionDynFlags-     liftIO (putStrLn ("Package: " ++ showPackageName (identDocPackageName idoc)))+     when printPkg+          (liftIO (putStrLn ("Package: " ++ showPackageName (identDocPackageName idoc))))+     when printModule+          (maybe (return ())+                 (\i -> liftIO (putStrLn ("Module: " +++                                          showppr d (moduleName (nameModule (getName i))))))+                 (identDocIdent idoc))      case identDocIdent idoc of        Nothing -> return ()        Just i -> liftIO (putStrLn (showppr d i ++ " :: " ++ showppr d (idType i)))

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} {-# OPTIONS -Wall -fno-warn-missing-signatures #-} @@ -5,6 +6,7 @@  module Haskell.Docs.Ghc where +import           Control.Exception (SomeException) import           Haskell.Docs.Types  import           GHC hiding (verbosity)@@ -37,14 +39,15 @@ -- | 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+  gcatch (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)+         (\(_ :: SomeException) -> return Nothing)  -- | Make a module name. makeModuleName :: String -> ModuleName

@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}@@ -8,12 +9,15 @@  module Haskell.Docs.Haddock where +import           Haskell.Docs.Cabal import           Haskell.Docs.Ghc import           Haskell.Docs.Types  import           Control.Arrow+import           Control.Exception (try,IOException) import           Control.Monad import           Data.Either+import           Data.Function import           Data.List import           Data.Map (Map) import qualified Data.Map as M@@ -27,61 +31,99 @@ -- * 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+searchIdent+  :: Maybe PackageConfig+  -> Identifier+  -> Ghc (Either DocsException [IdentDoc])+searchIdent mprevious name =+  do packages <- fmap (filterPrevious mprevious) (liftIO getAllPackages)+     searchInPackages packages+                      Nothing+                      name +-- | Search a name in the given module.+searchModuleIdent+  :: Maybe PackageConfig+  -> ModuleName+  -> Identifier+  -> Ghc (Either DocsException [IdentDoc])+searchModuleIdent mprevious mname name =+  do result <- fmap (filterPrevious mprevious) (getPackagesByModule mname)+     case result of+       [] ->+         return (Left NoFindModule)+       [package] ->+         searchWithPackage package (Just mname) name+       packages ->+         searchInPackages packages+                          (Just mname)+                          name++-- | Search a name in the given module from the given package.+searchPackageModuleIdent+  :: Maybe PackageConfig+  -> PackageName+  -> ModuleName+  -> Identifier+  -> Ghc (Either DocsException [IdentDoc])+searchPackageModuleIdent mprevious pname mname name =+  do result <- fmap (filterPrevious mprevious) (getPackagesByModule mname)+     case result of+       [] -> return (Left NoFindModule)+       packages ->+         case find ((== pname) . PackageName . showPackageName . sourcePackageId) packages of+           Nothing ->+             return (Left NoModulePackageCombo)+           Just package ->+             searchWithPackage package (Just mname) name++filterPrevious exclude =+  filter (maybe (const True)+                (on (/=) sourcePackageId)+                exclude)++-- | Search for the identifier in a module in any of the given packages.+searchInPackages+  :: [PackageConfig]+  -> Maybe ModuleName+  -> Identifier+  -> Ghc (Either a [IdentDoc])+searchInPackages packages mname name =+  fmap (Right . concat . rights)+       (mapM (\package -> searchWithPackage package mname name)+             packages)+ -- | Search for the given identifier in the given package. searchWithPackage   :: PackageConfig-  -> ModuleName+  -> Maybe 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)))))+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 name)+                                   (filter (maybe (const True)+                                                  (\n -> (==n) . moduleName . instMod)+                                                  mname)+                                           (ifInstalledIfaces interfaceFile)))))  -- | Search for the given identifier in the interface. searchWithInterface   :: PackageConfig-  -> ModuleName   -> Identifier   -> InstalledInterface   -> Ghc (Either DocsException [IdentDoc])-searchWithInterface package mname name interface =+searchWithInterface package name interface =   case find ((==name) . Identifier . getOccString) (instExports interface) of     Nothing ->       return (Left NoFindNameInExports)@@ -95,7 +137,7 @@             _ ->               return (Left NoFindNameInInterface)         Just d ->-          do mi <- findIdentifier mname name+          do mi <- findIdentifier (moduleName (instMod interface)) name              margs <- lookupArgsDocs interface name              return                (Right@@ -141,18 +183,25 @@ -- * Querying for packages and interfaces  -- | Search for a module's package, returning suggestions if not--- found.-getPackagesByModule :: ModuleName -> Ghc (Either [Module] [PackageConfig])+-- found. Filters out the given value.+getPackagesByModule :: ModuleName -> Ghc [PackageConfig] getPackagesByModule m =   do df <- getSessionDynFlags-     return (fmap (map fst) (lookupModuleWithSuggestions df m))+     return (either (const [])+                    (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) .+  mapM (fmap (either (Left . NoReadInterfaceFile) Right) . safelyReadFile freshNameCache) .   haddockInterfaces+  where safelyReadFile cache p =+          do result <- try (readInterfaceFile cache p)+             case result of+               Left (_::IOException) -> return (Left "Couldn't read file.")+               Right r -> return r  -- * Internal functions @@ -161,4 +210,4 @@ -- 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+  searchModuleIdent (Just package) (moduleName (nameModule qname)) name

@@ -13,6 +13,7 @@ import Data.Typeable (Typeable) import Documentation.Haddock (Doc) import GHC (Id)+import Module (ModuleName) import PackageConfig (PackageIdentifier)  -- | An identifier.@@ -30,6 +31,9 @@   , identDocIdent       :: !(Maybe Id)   , identDocArgDocs     :: !(Maybe [(Int, Doc String)])   }++instance Eq IdentDoc where+  a == b = identDocIdent a == identDocIdent b  -- | An exception when doing lookups. data DocsException

@@ -1,31 +1,49 @@-{-# OPTIONS -Wall #-}- -- | Main command-line interface.  module Main where  import Haskell.Docs+import Haskell.Docs.Types import Haskell.Docs.Ghc -import Options.Applicative+import qualified Control.Exception as E+import System.Environment  -- | Main entry point. main :: IO () 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))-       <$> 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')+  do args <- getArgs+     E.catch+       (app args)+       (error . printEx)++-- | Do the printing.+app :: [String] -> IO ()+app args =+  withInitializedPackages+    []+    (case args of+       [name] ->+         searchAndPrintDoc Nothing Nothing (Identifier name)+       [mname,name,pname] ->+         searchAndPrintDoc (Just (PackageName pname))+                           (Just (makeModuleName mname))+                           (Identifier name)+       [mname,name] ->+         searchAndPrintDoc Nothing+                           (Just (makeModuleName mname))+                           (Identifier name)+       _ -> error "<module-name> <ident> [<package-name>] | <ident>")++-- | Print an exception for humans.+printEx :: DocsException -> String+printEx e =+  case e of+    NoFindModule -> "Couldn't find any packages with that module."+    NoModulePackageCombo -> "Couldn't match a module with that package."+    NoInterfaceFiles -> "No interface files to search through! Maybe you need to generate documentation for the package?"+    NoParseInterfaceFiles reasons -> "Couldn't parse interface files: " +++                                     unlines (map printEx reasons)+    NoFindNameInExports -> "Couldn't find that name in an export list."+    NoFindNameInInterface -> "Couldn't find name in interface."+    NoReadInterfaceFile _ -> "Couldn't read the interface file."

@@ -34,10 +34,17 @@   do it "printDocumentation"         (withInitializedPackages            []-           (void (printDocForIdentInModule-                   Nothing-                   (makeModuleName "System.IO")-                   (Identifier "hSetBuffering"))))+           (void (searchAndPrintDoc+                    Nothing+                    (Just (makeModuleName "System.IO"))+                    (Identifier "hSetBuffering"))))+     it "justIdentifier"+        (withInitializedPackages+           []+           (void (searchAndPrintDoc+                    Nothing+                    Nothing+                    (Identifier "hSetBuffering"))))  -- | Test GHC types. types :: IO ()@@ -45,9 +52,9 @@   do it "getType"         (withInitializedPackages            []-           (do void (printDocForIdentInModule+           (do void (searchAndPrintDoc                       Nothing-                      (makeModuleName "System.IO")+                      (Just (makeModuleName "System.IO"))                       (Identifier "hSetBuffering"))                void (findIdentifier (makeModuleName "System.IO")                                     (Identifier "hSetBuffering"))))