haskell-docs 4.2.2 → 4.2.3
raw patch · 7 files changed
+226/−144 lines, 7 filesdep +base16-bytestringdep +cryptohashdep +haddock-api
Dependencies added: base16-bytestring, cryptohash, haddock-api, process
Files
- haskell-docs.cabal +28/−19
- src/Haskell/Docs.hs +34/−20
- src/Haskell/Docs/Cabal.hs +16/−14
- src/Haskell/Docs/Formatting.hs +1/−60
- src/Haskell/Docs/Haddock.hs +2/−27
- src/Haskell/Docs/Index.hs +27/−4
- src/haddock-api/Haskell/Docs/HaddockDoc.hs +118/−0
haskell-docs.cabal view
@@ -1,5 +1,5 @@ name: haskell-docs-version: 4.2.2+version: 4.2.3 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.@@ -54,28 +54,37 @@ library ghc-options: -O2 -Wall- hs-source-dirs: src+ if impl(ghc>=7.8.4)+ hs-source-dirs: src, src/haddock-api+ if impl(ghc<7.8.4)+ hs-source-dirs: src, src/haddock exposed-modules: Haskell.Docs, Haskell.Docs.Ghc, Haskell.Docs.Cabal, Haskell.Docs.Formatting, Haskell.Docs.Haddock, Haskell.Docs.Types,- Haskell.Docs.Index- build-depends: text,- base > 4 && < 5,- ghc >= 7.2 && < 7.9,- Cabal,- ghc-paths,- containers,- monad-loops,- aeson,- filepath,- directory,- text,- unordered-containers,- bytestring- if impl(ghc==7.8.*)+ Haskell.Docs.Index,+ Haskell.Docs.HaddockDoc+ build-depends: Cabal+ , aeson+ , base > 4 && < 5+ , base16-bytestring+ , bytestring+ , containers+ , cryptohash+ , directory+ , filepath+ , ghc >= 7.2 && < 7.9+ , ghc-paths+ , monad-loops+ , process+ , text+ , text+ , unordered-containers+ if impl(ghc==7.8.4)+ build-depends: haddock-api==2.15.*+ if impl(ghc==7.8.3) build-depends: haddock==2.14.* if impl(ghc==7.6.*) build-depends: haddock==2.13.*@@ -84,8 +93,8 @@ if impl(ghc==7.2.*) build-depends: haddock==2.9.* - if impl(ghc>=7.8)- build-depends: haddock+ if impl(ghc>=7.8.4)+ build-depends: haddock-api if impl(ghc<7.2) build-depends: haddock
src/Haskell/Docs.hs view
@@ -7,15 +7,16 @@ module Haskell.Docs (module Haskell.Docs ,Identifier(..)- ,PackageName(..)- ,searchAndPrintModules- ,searchAndPrintDoc)+ ,PackageName(..)) where +import Haskell.Docs.Cabal import Haskell.Docs.Formatting+import Haskell.Docs.Ghc import Haskell.Docs.Haddock import Haskell.Docs.Index import Haskell.Docs.Types+import PackageConfig import Control.Exception import Control.Monad@@ -23,6 +24,7 @@ import Data.List import Data.Ord import Data.Text (pack,unpack)+import qualified Data.Text as T import qualified Data.Text.IO as T import GHC hiding (verbosity) import MonadUtils@@ -36,24 +38,36 @@ -> Maybe ModuleName -- ^ Module name. -> Identifier -- ^ Identifier. -> Ghc ()-searchAndPrintDoc gs ms ss pname mname ident =- do (result,printPkg,printModule) <- search+searchAndPrintDoc flags ms ss pname mname ident =+ do result <- liftIO (lookupIdent flags+ (pack (unIdentifier ident))) case result of- Left err ->- throw err- Right (sortBy (comparing identDocPackageName) -> docs) ->- if ss- then printSexp (nub docs)- else mapM_ (\(i,doc') ->- do when (not ms && i > 0)- (liftIO (putStrLn ""))- printIdentDoc ms printPkg printModule doc')- (zip [0::Int ..] (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)- _ -> fmap (,True,True) (searchIdent gs Nothing ident)+ Nothing -> throw NoFindModule+ Just pkgModuleMap ->+ do pkgs <- getAllPackages flags+ docs <- fmap concat+ (forM (M.toList pkgModuleMap)+ (searchResult pkgs))+ if ss+ then printSexp docs+ else mapM_ (\(i,doc') ->+ printIdentDoc False True True doc')+ (zip [0 :: Int ..]+ (nub docs))+ where searchResult pkgs (pkgName,modName) =+ case find (matchingPkg pkgName) pkgs of+ Nothing -> return []+ Just pkg -> searchPkg pkg modName+ where matchingPkg pkgName = (== pkgName) . T.pack . showPackageName .+ sourcePackageId+ searchPkg pkg modName =+ do result <- searchWithPackage+ pkg+ (Just (head (fmap (makeModuleName . T.unpack) modName)))+ ident+ case result of+ Left err -> throw err+ Right (sortBy (comparing identDocPackageName) -> docs) -> return docs -- | Search only for identifiers and print out all modules associated. searchAndPrintModules :: [String] -> Identifier -> IO ()
src/Haskell/Docs/Cabal.hs view
@@ -9,13 +9,13 @@ import Data.Char (isSpace) import Data.List+import Data.Maybe import Distribution.InstalledPackageInfo import Distribution.ModuleName import Distribution.Simple.Compiler-import Distribution.Simple.GHC import Distribution.Simple.PackageIndex-import Distribution.Simple.Program-import Distribution.Verbosity+import DynFlags+import GHC import Module import PackageConfig @@ -28,18 +28,20 @@ trim = (drop 1) . snd . (break isSpace) -- | Get all installed packages, filtering out the given package.-getAllPackages :: [String] -> IO [PackageConfig]+getAllPackages :: [String] -> Ghc [PackageConfig.PackageConfig] getAllPackages gs =- do config <- configureAllKnownPrograms- normal- (addKnownPrograms [ghcProgram,ghcPkgProgram]- emptyProgramConfiguration)- index <- getInstalledPackages- normal- (concat [[GlobalPackageDB,UserPackageDB],getGhcOpsPackageDB gs])- config- return (map (imap convModule)- (concat (packagesByName index)))+ do flags <- getSessionDynFlags+ return (fromMaybe [] (pkgDatabase flags))+ -- do config <- configureAllKnownPrograms+ -- normal+ -- (addKnownPrograms [ghcProgram,ghcPkgProgram]+ -- emptyProgramConfiguration)+ -- index <- getInstalledPackages+ -- normal+ -- (concat [[GlobalPackageDB,UserPackageDB],getGhcOpsPackageDB gs])+ -- config+ -- return (map (imap convModule)+ -- (concat (packagesByName index))) -- | Version-portable version of allPackagesByName. packagesByName :: PackageIndex -> [[InstalledPackageInfo]]
src/Haskell/Docs/Formatting.hs view
@@ -6,6 +6,7 @@ import Haskell.Docs.Types import Haskell.Docs.Ghc+import Haskell.Docs.HaddockDoc import Control.Monad import Data.Char@@ -82,66 +83,6 @@ ,[List [Atom "arguments",List ((map (\(i,x) -> String (formatArg i x)) args))] |Just args <- [identDocArgDocs idoc]] ,[List [Atom "documentation",String (formatDoc (identDocDocs idoc))]]]---- | 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
src/Haskell/Docs/Haddock.hs view
@@ -10,6 +10,7 @@ module Haskell.Docs.Haddock where import Haskell.Docs.Cabal+import Haskell.Docs.HaddockDoc import Haskell.Docs.Ghc import Haskell.Docs.Types @@ -37,7 +38,7 @@ -> Identifier -> Ghc (Either DocsException [IdentDoc]) searchIdent gs mprevious name =- do packages <- fmap (filterPrevious mprevious) (liftIO $ getAllPackages gs)+ do packages <- fmap (filterPrevious mprevious) (getAllPackages gs) searchInPackages packages Nothing name@@ -148,32 +149,6 @@ 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)])
src/Haskell/Docs/Index.hs view
@@ -12,8 +12,11 @@ import Control.Exception as E import Control.Monad+import qualified Crypto.Hash.SHA1 as SHA1 import Data.ByteString (ByteString) import qualified Data.ByteString as S+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Internal as S import qualified Data.ByteString.Lazy as L import Data.Char@@ -34,8 +37,10 @@ import PackageConfig import Prelude import System.Directory+import System.Environment import System.FilePath import System.IO+import System.Process -- * Looking up identifiers @@ -46,7 +51,8 @@ -> IO (Maybe (HashMap Text [Text])) lookupIdent flags ident = do d <- getTemporaryDirectory- exists <- doesFileExist (d </> indexFilename)+ fp <- getIndexFilename+ exists <- doesFileExist (d </> fp) if exists then lookupInIndex ident else do generateIndex flags >>= saveIndex@@ -77,7 +83,6 @@ flags (do flags <- getSessionDynFlags return (fromMaybe [] (pkgDatabase flags)))- {-packages <- getAllPackages-} fmap (concat . map explode . concat) (forM packages (\package ->@@ -100,6 +105,7 @@ saveIndex :: Index -> IO () saveIndex i = do d <- getTemporaryDirectory+ indexFilename <- getIndexFilename L.writeFile (d </> indexFilename) mempty h <- openFile (d </> indexFilename) AppendMode forM_ (M.toList i)@@ -108,8 +114,10 @@ where (<>) = mappend -- | Filename to read/write index to.-indexFilename :: FilePath-indexFilename = "haskell-docs-idents.index"+getIndexFilename :: IO FilePath+getIndexFilename =+ do flags <- getPkgFlags+ return ("haskell-docs-" ++ sha1 flags ++ ".index") -- * Internally looking up inside indexes @@ -119,6 +127,7 @@ -> IO (Maybe (HashMap Text [Text])) lookupInIndex (T.encodeUtf8 -> ident) = do d <- getTemporaryDirectory+ indexFilename <- getIndexFilename h <- openFile (d </> indexFilename) ReadMode E.catch (fix (\loop ->@@ -138,3 +147,17 @@ [package,modu] -> Just (package,modu) _ -> Nothing ins m (pkg,modu) = M.insertWith (++) pkg [modu] m++-- | SHA1 hex-encode a string.+sha1 :: String -> String+sha1 = S8.unpack . B16.encode . SHA1.hash . S8.pack++-- | Get unique package flags string.+getPkgFlags :: IO String+getPkgFlags =+ do env <- getEnvironment+ case lookup "HSENV" env >> lookup "PACKAGE_DB_FOR_GHC" env of+ Just uflags -> return uflags+ Nothing -> case lookup "GHC_PACKAGE_PATH" env of+ Just path -> return ("-no-user-pg-db" ++ "-pkg-db=" ++ path)+ Nothing -> readProcess "ghc-pkg" ["--version"] ""
+ src/haddock-api/Haskell/Docs/HaddockDoc.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP #-}++-- | Post-haddock-api.++module Haskell.Docs.HaddockDoc where++import Control.Arrow+import Control.Exception (try,IOException)+import Control.Monad+import Control.Monad+import Data.Char+import Data.Either+import Data.Function+import Data.List+import Data.List+import Data.Map (Map)+import qualified Data.Map as M+import Documentation.Haddock+import Documentation.Haddock+import GHC hiding (verbosity)+import GHC hiding (verbosity)+import GhcMonad (liftIO)+import GhcMonad (liftIO)+import Haskell.Docs.Cabal+import Haskell.Docs.Ghc+import Haskell.Docs.Ghc+import Haskell.Docs.Types+import Haskell.Docs.Types+import Name+import Name+import PackageConfig+import Packages++-- | 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_api(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_api(2,11,0)+doc (DocIdentifierUnchecked (mname,occname)) =+ moduleNameString mname ++ "." ++ occNameString occname+doc (DocPic pic) = show pic+#endif++#if MIN_VERSION_haddock_api(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_api(2,14,0)+doc (DocBold d) = "**" ++ doc d ++ "**"+doc (DocHeader _) = ""+#endif++-- * 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_api(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_api(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++-- | 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)