haskell-docs 4.1.5 → 4.2.0

raw patch · 9 files changed

+257/−75 lines, 9 filesdep +aesondep +bytestringdep +directoryPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, bytestring, directory, filepath, text, unordered-containers

API changes (from Hackage documentation)

Files

• haskell-docs.cabal +14/−5
• src/Haskell/Docs.hs +40/−12
• src/Haskell/Docs/Cabal.hs +0/−2
• src/Haskell/Docs/Ghc.hs +7/−7
• src/Haskell/Docs/Haddock.hs +2/−3
• src/Haskell/Docs/Index.hs +132/−0
• src/Haskell/Docs/Types.hs +2/−0
• src/main/Main.hs +33/−25
• src/test/Main.hs +27/−21

@@ -1,5 +1,5 @@ name:                haskell-docs-version:             4.1.5+version:             4.2.0 synopsis:            A program to find and display the docs and type of a name description:         Given a module name and a name, or just a name, it will find and display                      the documentation of that name.@@ -60,13 +60,21 @@                        Haskell.Docs.Cabal,                        Haskell.Docs.Formatting,                        Haskell.Docs.Haddock,-                       Haskell.Docs.Types-  build-depends:       base > 4 && < 5,+                       Haskell.Docs.Types,+                       Haskell.Docs.Index+  build-depends:       text,+                       base > 4 && < 5,                        ghc >= 7.2 && < 7.9,                        Cabal,                        ghc-paths,                        containers,-                       monad-loops+                       monad-loops,+                       aeson,+                       filepath,+                       directory,+                       text,+                       unordered-containers,+                       bytestring   if impl(ghc==7.8.*)     build-depends: haddock==2.14.*   if impl(ghc==7.6.*)@@ -84,7 +92,8 @@ executable haskell-docs   hs-source-dirs:      src/main   main-is:             Main.hs-  build-depends:       base > 4 && < 5,+  build-depends:       text,+                       base > 4 && < 5,                        haskell-docs,                        ghc 

@@ -10,26 +10,35 @@   ,PackageName(..))   where -import Haskell.Docs.Formatting-import Haskell.Docs.Haddock-import Haskell.Docs.Types+import           Haskell.Docs.Formatting+import           Haskell.Docs.Haddock+import           Haskell.Docs.Ghc+import           Haskell.Docs.Index+import           Haskell.Docs.Types -import Control.Exception-import Control.Monad-import Data.List-import Data.Ord-import GHC hiding (verbosity)-import GhcMonad (liftIO)+import           Control.Arrow+import           Control.Exception+import           Control.Monad+import qualified Data.HashMap.Strict as M+import           Data.List+import           Data.Ord+import qualified Data.Text.IO as T+import           Data.Text (pack,unpack)+import           GHC hiding (verbosity)+import           GhcMonad (liftIO)+import           Module+import           Packages  -- -- | Print the documentation of a name in the given module.-searchAndPrintDoc-  :: Bool              -- ^ Print modules only.+searchAndPrintDoc'+  :: PackageConfigMap  -- ^ Package map.+  -> Bool              -- ^ Print modules only.   -> Bool              -- ^ S-expression format.   -> Maybe PackageName -- ^ Package.   -> Maybe ModuleName  -- ^ Module name.   -> Identifier        -- ^ Identifier.   -> Ghc ()-searchAndPrintDoc ms ss pname mname ident =+searchAndPrintDoc' pkgs ms ss pname mname ident =   do (result,printPkg,printModule) <- search      case result of        Left err ->@@ -47,3 +56,22 @@             (Just p,Just m) -> fmap (,False,False) (searchPackageModuleIdent Nothing p m ident)             (Nothing,Just m) -> fmap (,True,False) (searchModuleIdent Nothing m ident)             _ -> fmap (,True,True) (searchIdent Nothing ident)++searchAndPrintDoc+  :: PackageConfigMap  -- ^ Package map.+  -> Bool              -- ^ Print modules only.+  -> Bool              -- ^ S-expression format.+  -> Maybe PackageName -- ^ Package.+  -> Maybe ModuleName  -- ^ Module name.+  -> Identifier        -- ^ Identifier.+  -> Ghc ()+searchAndPrintDoc packagemap ms ss pname mname ident =+  do result <- liftIO (lookupIdent (pack (unIdentifier ident)))+     case result of+       Nothing ->+         throw NoFindModule+       Just packages ->+         if ms+            then forM_ (concat (map snd (M.toList packages)))+                       (\modu -> liftIO (T.putStrLn modu))+            else searchAndPrintDoc' packagemap ms ss pname mname ident

@@ -5,13 +5,11 @@  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

@@ -6,17 +6,17 @@  module Haskell.Docs.Ghc where -import           Control.Exception (SomeException) import           Haskell.Docs.Types +import           Control.Exception (SomeException) import           GHC hiding (verbosity) import           GHC.Paths (libdir) import           GhcMonad (liftIO)+import           Module+import           Name import           Outputable import           Packages import qualified SrcLoc-import           Name-import           Module  #if __GLASGOW_HASKELL__ < 706 import           DynFlags (defaultLogAction)@@ -27,14 +27,14 @@ -- * GHC actions  -- | Run an action with an initialized GHC package set.-withInitializedPackages :: [String] -> Ghc a -> IO a+withInitializedPackages :: [String] -> (PackageConfigMap -> 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)+                                           , ghcLink = LinkInMemory })+          (dflags'',_packageids) <- liftIO (initPackages dflags')+          m (pkgIdMap (pkgState dflags'')))  -- | Get the type of the given identifier from the given module. findIdentifier :: ModuleName -> Identifier -> Ghc (Maybe Id)

@@ -100,7 +100,7 @@   -> Identifier   -> Ghc (Either DocsException [IdentDoc]) searchWithPackage package mname name =-  do interfaceFiles <- getHaddockInterfacesByPackage package+  do interfaceFiles <- liftIO (getHaddockInterfacesByPackage package)      case (lefts interfaceFiles,rights interfaceFiles) of        ([],[])        ->          return (Left NoInterfaceFiles)@@ -194,9 +194,8 @@                     (lookupModuleWithSuggestions df m))  -- | Get the Haddock interfaces of the given package.-getHaddockInterfacesByPackage :: PackageConfig -> Ghc [Either DocsException InterfaceFile]+getHaddockInterfacesByPackage :: PackageConfig -> IO [Either DocsException InterfaceFile] getHaddockInterfacesByPackage =-  liftIO .   mapM (fmap (either (Left . NoReadInterfaceFile) Right) . safelyReadFile freshNameCache) .   haddockInterfaces   where safelyReadFile cache p =

@@ -0,0 +1,132 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++-- | Make an index from identifiers to modules.++module Haskell.Docs.Index where++import           Control.Exception as E+import           Control.Monad+import           Data.ByteString (ByteString)+import qualified Data.ByteString as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Lazy as L+import           Data.Char+import           Data.Either+import           Data.Function+import           Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as M+import           Data.List+import           Data.Maybe+import           Data.Monoid+import           Data.Text (Text,pack)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import           Documentation.Haddock+import           GHC hiding (verbosity)+import           Haskell.Docs.Cabal+import           Haskell.Docs.Ghc+import           Haskell.Docs.Haddock+import           Name+import           PackageConfig+import           System.Directory+import           System.FilePath+import           System.IO++-- * Looking up identifiers++-- | Lookup an identifier. Automatically creates an index if none+-- exists.+lookupIdent :: Text+            -> IO (Maybe (HashMap Text [Text]))+lookupIdent ident =+  do d <- getTemporaryDirectory+     exists <- doesFileExist (d </> indexFilename)+     if exists+        then lookupInIndex ident+        else do generateIndex >>= saveIndex+                lookupInIndex ident++-- * Internally generating indexes++-- | An identifier index.+type Index = HashMap Text Text++-- | Generate an identifier index.+generateIndex :: IO Index+generateIndex =+  do flatfile <- generateFlatFile+     evaluate+       (foldl' (\m (pkg,modu,name) ->+                  M.insertWith (\x y -> x <> " " <> y)+                               (pack name)+                               (pack pkg <> ":" <> pack modu) m)+               M.empty+               flatfile)+  where (<>) = mappend++-- | Generate a flat file of all package, module, name combinations.+generateFlatFile :: IO [(String, String, String)]+generateFlatFile =+  do packages <- getAllPackages+     fmap (concat . map explode . concat)+          (forM packages+                (\package ->+                   do files <- getHaddockInterfacesByPackage package+                      return+                        (concat+                           (map (map (\iface ->+                                        (sourcePackageId package,instMod iface,instExports iface)) .+                                 ifInstalledIfaces)+                                (rights files)))))+  where explode (pkg,modu,names) =+          map (showPackageName pkg+              ,moduleNameString (moduleName modu)+              ,)+              (map getOccString names)++-- | Save the index to file.+saveIndex :: Index -> IO ()+saveIndex i =+  do d <- getTemporaryDirectory+     L.writeFile (d </> indexFilename) mempty+     h <- openFile (d </> indexFilename) AppendMode+     forM_ (M.toList i)+           (\(ident,modules) -> T.hPutStrLn h (ident <> " " <> modules))+     hClose h+  where (<>) = mappend++-- | Filename to read/write index to.+indexFilename :: FilePath+indexFilename = "haskell-docs-indents.index"++-- * Internally looking up inside indexes++-- | Lookup an entry in the index by identifier.+lookupInIndex+  :: Text+  -> IO (Maybe (HashMap Text [Text]))+lookupInIndex (T.encodeUtf8 -> ident) =+  do d <- getTemporaryDirectory+     h <- openFile (d </> indexFilename) ReadMode+     E.catch+         (fix (\loop ->+                 do line <- S.hGetLine h+                    if S.takeWhile (/= space) line == ident+                       then do hClose h+                               return (Just (extractModules (S.drop 1 (S.dropWhile (/= space) line))))+                       else loop))+         (\(_ :: IOException) -> return Nothing)+  where space = S.c2w ' '++-- | Extract the \"package:Module package:Module\" string into a map from package to modules.+extractModules :: ByteString -> HashMap Text [Text]+extractModules = foldl' ins mempty . mapMaybe unpair . chunks . T.decodeUtf8+  where chunks = T.split isSpace+        unpair t = case T.split (==':') t of+                     [package,modu] -> Just (package,modu)+                     _ -> Nothing+        ins m (pkg,modu) = M.insertWith (++) pkg [modu] m

@@ -10,6 +10,7 @@   where  import Control.Exception (Exception)+import Data.Text (Text) import Data.Typeable (Typeable) import Documentation.Haddock (Doc) import GHC (Id)@@ -40,6 +41,7 @@ -- | An exception when doing lookups. data DocsException   = NoFindModule+  | PackageLookupFailed !Text   | NoModulePackageCombo   | NoInterfaceFiles   | NoParseInterfaceFiles [DocsException]

@@ -11,6 +11,8 @@ import           Control.Exception import           Control.Exception (IOException) import qualified Control.Exception as E+import           Data.Monoid+import           Data.Text (unpack) import           Data.Typeable import           GHC import           GhcMonad@@ -29,31 +31,35 @@ app (extract -> x@(gs,ms,as,ss)) =   withInitializedPackages     gs-    (catchErrors-       (case as of-          [name] ->-            searchAndPrintDoc ms-                              ss-                              Nothing-                              Nothing-                              (Identifier name)-          [mname,name,pname] ->-            searchAndPrintDoc ms-                              ss-                              (Just (PackageName pname))-                              (Just (makeModuleName mname))-                              (Identifier name)-          [mname,name] ->-            searchAndPrintDoc ms-                              ss-                              Nothing-                              (Just (makeModuleName mname))-                              (Identifier name)-          _ -> bail "<module-name> <ident> [<package-name>] | <ident>\n\-                    \\n\-                    \Options: --g <ghc option> Specify GHC options.\n\-                    \         --sexp           Output s-expressions.\n\-                    \         --modules        Only output modules."))+    (\packages ->+       catchErrors+         (case as of+            [name] ->+              searchAndPrintDoc packages+                                ms+                                ss+                                Nothing+                                Nothing+                                (Identifier name)+            [mname,name,pname] ->+              searchAndPrintDoc packages+                                ms+                                ss+                                (Just (PackageName pname))+                                (Just (makeModuleName mname))+                                (Identifier name)+            [mname,name] ->+              searchAndPrintDoc packages+                                ms+                                ss+                                Nothing+                                (Just (makeModuleName mname))+                                (Identifier name)+            _ -> bail "<module-name> <ident> [<package-name>] | <ident>\n\+                      \\n\+                      \Options: --g <ghc option> Specify GHC options.\n\+                      \         --sexp           Output s-expressions.\n\+                      \         --modules        Only output modules."))  -- | Extract arguments. extract :: [String] -> ([String],Bool,[String],Bool)@@ -88,6 +94,7 @@ printEx e =   case e of     NoFindModule -> "Couldn't find any packages with that module."+    PackageLookupFailed t -> "Couldn't lookup the right package: " <> unpack t     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?"@@ -96,3 +103,4 @@     NoFindNameInExports -> "Couldn't find that name in an export list."     NoFindNameInInterface -> "Couldn't find name in interface."     NoReadInterfaceFile _ -> "Couldn't read the interface file."+  where (<>) = mappend

@@ -26,7 +26,7 @@ initialization :: IO () initialization =   do it "withInitializedPackages"-        (withInitializedPackages [] (return ()))+        (withInitializedPackages [] (const (return ())))  -- | Test GHC docs. docs :: IO ()@@ -34,21 +34,25 @@   do it "printDocumentation"         (withInitializedPackages            []-           (void (searchAndPrintDoc-                    False-                    False-                    Nothing-                    (Just (makeModuleName "System.IO"))-                    (Identifier "hSetBuffering"))))+           (\pkgs ->+              void (searchAndPrintDoc+                      pkgs+                      False+                      False+                      Nothing+                      (Just (makeModuleName "System.IO"))+                      (Identifier "hSetBuffering"))))      it "justIdentifier"         (withInitializedPackages            []-           (void (searchAndPrintDoc-                    False-                    False-                    Nothing-                    Nothing-                    (Identifier "hSetBuffering"))))+           (\pkgs ->+              void (searchAndPrintDoc+                      pkgs+                      False+                      False+                      Nothing+                      Nothing+                      (Identifier "hSetBuffering"))))  -- | Test GHC types. types :: IO ()@@ -56,14 +60,16 @@   do it "getType"         (withInitializedPackages            []-           (do void (searchAndPrintDoc-                      False-                      False-                      Nothing-                      (Just (makeModuleName "System.IO"))-                      (Identifier "hSetBuffering"))-               void (findIdentifier (makeModuleName "System.IO")-                                    (Identifier "hSetBuffering"))))+           (\pkgs ->+              do void (searchAndPrintDoc+                        pkgs+                        False+                        False+                        Nothing+                        (Just (makeModuleName "System.IO"))+                        (Identifier "hSetBuffering"))+                 void (findIdentifier (makeModuleName "System.IO")+                                      (Identifier "hSetBuffering"))))  -- | Describe a test spec. describe :: String -> IO () -> IO ()