diff --git a/haskell-docs.cabal b/haskell-docs.cabal --- a/haskell-docs.cabal +++ b/haskell-docs.cabal @@ -1,5 +1,5 @@ name: haskell-docs -version: 4.2.5 +version: 4.2.6 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. @@ -85,13 +85,16 @@ , cryptohash , directory , filepath - , ghc >= 7.2 && < 7.9 + , ghc >= 7.2 && < 7.11 , ghc-paths , monad-loops , process , text , text , unordered-containers + if impl(ghc==7.10.*) + build-depends: haddock-api==2.16.* + , haddock-library if impl(ghc==7.8.4) build-depends: haddock-api==2.15.* if impl(ghc==7.8.3) diff --git a/src/Haskell/Docs.hs b/src/Haskell/Docs.hs --- a/src/Haskell/Docs.hs +++ b/src/Haskell/Docs.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} -- | Lookup the documentation of a name in a module (and in a specific -- package in the case of ambiguity). @@ -10,23 +10,22 @@ ,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 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 hiding (PackageName) import Control.Exception import Control.Monad import qualified Data.HashMap.Strict as M 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 qualified Data.Text as T +import qualified Data.Text.IO as T +import GHC hiding (verbosity) import MonadUtils -- -- | Print the documentation of a name in the given module. @@ -38,9 +37,9 @@ -> Maybe ModuleName -- ^ Module name. -> Identifier -- ^ Identifier. -> Ghc () -searchAndPrintDoc flags ms ss pname mname ident = +searchAndPrintDoc flags _ms ss _pname _mname ident = do result <- liftIO (lookupIdent flags - (pack (unIdentifier ident))) + (T.pack (unIdentifier ident))) case result of Nothing -> throw NoFindModule Just pkgModuleMap -> @@ -50,7 +49,7 @@ (searchResult pkgs)) if ss then printSexp docs - else mapM_ (\(i,doc') -> + else mapM_ (\(_,doc') -> printIdentDoc False True True doc') (zip [0 :: Int ..] (nub docs)) @@ -58,8 +57,8 @@ case find (matchingPkg pkgName) pkgs of Nothing -> return [] Just pkg -> searchPkg pkg modName - where matchingPkg pkgName = (== pkgName) . T.pack . showPackageName . - sourcePackageId + where matchingPkg pkgNm = (== pkgNm) . T.pack . showPackageName . + getIdentifier searchPkg pkg modName = do result <- searchWithPackage pkg @@ -72,7 +71,7 @@ -- | Search only for identifiers and print out all modules associated. searchAndPrintModules :: [String] -> Identifier -> IO () searchAndPrintModules flags ident = - do result <- lookupIdent flags (pack (unIdentifier ident)) + do result <- lookupIdent flags (T.pack (unIdentifier ident)) case result of Nothing -> throw NoFindModule diff --git a/src/Haskell/Docs/Cabal.hs b/src/Haskell/Docs/Cabal.hs --- a/src/Haskell/Docs/Cabal.hs +++ b/src/Haskell/Docs/Cabal.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE RecordWildCards #-} -- | Cabal. @@ -7,7 +6,7 @@ import Haskell.Docs.Ghc -import Data.Char (isSpace) +import Data.Char (isSpace) import Data.List import Data.Maybe import Distribution.InstalledPackageInfo @@ -17,7 +16,12 @@ import DynFlags import GHC import Module + +#if __GLASGOW_HASKELL__ >= 710 +import PackageConfig hiding (InstalledPackageInfo (..)) +#else import PackageConfig +#endif -- * Cabal @@ -29,22 +33,16 @@ -- | Get all installed packages, filtering out the given package. getAllPackages :: [String] -> Ghc [PackageConfig.PackageConfig] -getAllPackages gs = +getAllPackages _gs = 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. +#if MIN_VERSION_Cabal (1,22,0) +packagesByName :: InstalledPackageIndex -> [[InstalledPackageInfo]] +#else packagesByName :: PackageIndex -> [[InstalledPackageInfo]] +#endif #if MIN_VERSION_Cabal(1,16,0) packagesByName = map snd . allPackagesByName #else @@ -56,9 +54,3 @@ -- | 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 } diff --git a/src/Haskell/Docs/Formatting.hs b/src/Haskell/Docs/Formatting.hs --- a/src/Haskell/Docs/Formatting.hs +++ b/src/Haskell/Docs/Formatting.hs @@ -4,17 +4,15 @@ module Haskell.Docs.Formatting where -import Haskell.Docs.Types import Haskell.Docs.Ghc import Haskell.Docs.HaddockDoc +import Haskell.Docs.Types import Control.Monad -import Data.Char import Data.List import Documentation.Haddock import GHC hiding (verbosity) import GhcMonad (liftIO) -import Name -- * Formatting diff --git a/src/Haskell/Docs/Ghc.hs b/src/Haskell/Docs/Ghc.hs --- a/src/Haskell/Docs/Ghc.hs +++ b/src/Haskell/Docs/Ghc.hs @@ -1,17 +1,17 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE CPP #-} {-# OPTIONS -Wall -fno-warn-missing-signatures #-} -- | Ghc compatibility layer. module Haskell.Docs.Ghc where -import Haskell.Docs.Types +import Haskell.Docs.Types import Control.Exception (SomeException) -import GHC hiding (verbosity) -import GHC.Paths (libdir) -import GhcMonad (liftIO) +import GHC hiding (verbosity) +import GHC.Paths (libdir) +import GhcMonad (liftIO) import Module import Name import Outputable @@ -19,9 +19,9 @@ import qualified SrcLoc #if __GLASGOW_HASKELL__ < 706 -import DynFlags (defaultLogAction) +import DynFlags (defaultLogAction) #else -import DynFlags (defaultFlushOut, defaultFatalMessager) +import DynFlags (defaultFatalMessager, defaultFlushOut) #endif -- * GHC actions @@ -81,6 +81,9 @@ #if __GLASGOW_HASKELL__ == 708 showSDocForUser = Outputable.showSDocForUser #endif +#if __GLASGOW_HASKELL__ == 710 +showSDocForUser = Outputable.showSDocForUser +#endif -- | Set the import context. setImportContext :: ModuleName -> Ghc () @@ -91,5 +94,10 @@ #endif -- | Show the package name e.g. base. +#if __GLASGOW_HASKELL__ >= 710 +showPackageName :: PackageKey -> String +showPackageName = packageKeyString +#else showPackageName :: PackageIdentifier -> String showPackageName = packageIdString . mkPackageId +#endif diff --git a/src/Haskell/Docs/Haddock.hs b/src/Haskell/Docs/Haddock.hs --- a/src/Haskell/Docs/Haddock.hs +++ b/src/Haskell/Docs/Haddock.hs @@ -1,30 +1,26 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# 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.Cabal -import Haskell.Docs.HaddockDoc -import Haskell.Docs.Ghc -import Haskell.Docs.Types +import Haskell.Docs.Cabal +import Haskell.Docs.Ghc +import Haskell.Docs.HaddockDoc +import Haskell.Docs.Types as T import Control.Arrow -import Control.Exception (try,IOException) +import Control.Exception (IOException, try) import Control.Monad import Data.Either import Data.Function import Data.List -import Data.Map (Map) -import qualified Data.Map as M +import qualified Data.Map as M import Documentation.Haddock -import GHC hiding (verbosity) -import GhcMonad (liftIO) +import GHC +import GhcMonad (liftIO) import Name import PackageConfig import Packages @@ -64,7 +60,7 @@ -- | Search a name in the given module from the given package. searchPackageModuleIdent :: Maybe PackageConfig - -> PackageName + -> T.PackageName -> ModuleName -> Identifier -> Ghc (Either DocsException [IdentDoc]) @@ -73,12 +69,20 @@ case result of [] -> return (Left NoFindModule) packages -> - case find ((== pname) . PackageName . showPackageName . sourcePackageId) packages of + case find ((== pname) . T.PackageName . showPackageName . getIdentifier) packages of Nothing -> return (Left NoModulePackageCombo) Just package -> searchWithPackage package (Just mname) name +-- | Obtain the current notion of a package identifier. +getIdentifier :: PackageConfig -> PkgID +#if __GLASGOW_HASKELL__ >= 710 +getIdentifier = packageKey +#else +getIdentifier = sourcePackageId +#endif + excludePrevious exclude = filter (maybe (const True) (on (/=) sourcePackageId) @@ -143,7 +147,7 @@ margs <- lookupArgsDocs interface name return (Right - [IdentDoc (sourcePackageId package) + [IdentDoc (getIdentifier package) name (moduleName (instMod interface)) d @@ -163,11 +167,17 @@ -- | Search for a module's package, returning suggestions if not -- found. Filters out the given value. getPackagesByModule :: ModuleName -> Ghc [PackageConfig] +#if __GLASGOW_HASKELL__ >= 710 getPackagesByModule m = do df <- getSessionDynFlags + return . map snd $ lookupModuleInAllPackages df m +#else +getPackagesByModule m = + do df <- getSessionDynFlags return (either (const []) (map fst) (lookupModuleWithSuggestions df m)) +#endif -- | Get the Haddock interfaces of the given package. getHaddockInterfacesByPackage :: PackageConfig -> IO [Either DocsException InterfaceFile] @@ -186,5 +196,5 @@ -- 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 +descendSearch _package name qname = searchModuleIdent Nothing (moduleName (nameModule qname)) name diff --git a/src/Haskell/Docs/Index.hs b/src/Haskell/Docs/Index.hs --- a/src/Haskell/Docs/Index.hs +++ b/src/Haskell/Docs/Index.hs @@ -1,47 +1,49 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE ViewPatterns #-} -- | Make an index from identifiers to modules. module Haskell.Docs.Index where -import Haskell.Docs.Ghc -import Haskell.Docs.Haddock +import Haskell.Docs.Ghc +import Haskell.Docs.Haddock -import Control.Exception as E +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 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 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.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 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 GHC hiding (verbosity) import Name -import PackageConfig -import Prelude import System.Directory import System.Environment import System.FilePath import System.IO -import System.Process +import System.Process (readProcess) +#if !(MIN_VERSION_base(4,8,0)) +import Data.Monoid (mappend, mempty) +#endif + -- * Looking up identifiers -- | Lookup an identifier. Automatically creates an index if none @@ -81,8 +83,8 @@ generateFlatFile flags = do packages <- withInitializedPackages flags - (do flags <- getSessionDynFlags - return (fromMaybe [] (pkgDatabase flags))) + (do df <- getSessionDynFlags + return (fromMaybe [] (pkgDatabase df))) fmap (concat . map explode . concat) (forM packages (\package -> @@ -90,7 +92,7 @@ return (concat (map (map (\iface -> - (sourcePackageId package + (getIdentifier package ,instMod iface ,instVisibleExports iface)) . ifInstalledIfaces) diff --git a/src/Haskell/Docs/Types.hs b/src/Haskell/Docs/Types.hs --- a/src/Haskell/Docs/Types.hs +++ b/src/Haskell/Docs/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE CPP #-} -- | All types. @@ -6,17 +7,27 @@ (IdentDoc(..) ,DocsException(..) ,Identifier(..) - ,PackageName(..)) + ,PackageName(..) + ,PkgID) where import Control.Exception (Exception) import Data.Text (Text) import Data.Typeable (Typeable) import Documentation.Haddock (Doc) -import GHC (Id) +import GHC (Id) import Module (ModuleName) + +#if __GLASGOW_HASKELL__ >= 710 +import Module (PackageKey) + +type PkgID = PackageKey +#else import PackageConfig (PackageIdentifier) +type PkgID = PackageIdentifier +#endif + -- | An identifier. newtype Identifier = Identifier {unIdentifier :: String} deriving (Show,Eq) @@ -27,7 +38,7 @@ -- | Identier documentation along with argument docs and identifiers. data IdentDoc = IdentDoc - { identDocPackageName :: !PackageIdentifier + { identDocPackageName :: !PkgID , identDocIdentifier :: !Identifier , identDocModuleName :: !ModuleName , identDocDocs :: !(Doc String) diff --git a/src/haddock-api/Haskell/Docs/HaddockDoc.hs b/src/haddock-api/Haskell/Docs/HaddockDoc.hs --- a/src/haddock-api/Haskell/Docs/HaddockDoc.hs +++ b/src/haddock-api/Haskell/Docs/HaddockDoc.hs @@ -5,31 +5,15 @@ 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 +import Data.Map (Map) +import qualified Data.Map as M +import Documentation.Haddock (Doc, DocH (..), Example (..), + Hyperlink (..), + InstalledInterface (..)) +import Documentation.Haddock.Types (_doc) +import GHC (Name, moduleNameString) +import Name (getOccString, occNameString) -- | Render the doc. doc :: Doc String -> String @@ -47,58 +31,44 @@ 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))) +interfaceNameMap = M.fromList + . map ( getOccString + *** +#if MIN_VERSION_haddock_api(2,16,0) + _doc . #endif + fmap getOccString + ) + . M.toList + . instDocMap -- | 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))) +interfaceArgMap = M.fromList +#if MIN_VERSION_haddock_api(2,16,0) + . map (getOccString *** fmap _doc) #else -interfaceArgMap iface = M.fromList (map (second (const M.empty) . first getOccString) - (M.toList (instDocMap iface))) + . map (first getOccString) #endif + . M.toList + . instArgMap -- | Strip redundant whitespace. normalize :: [Char] -> [Char] diff --git a/src/haddock/Haskell/Docs/HaddockDoc.hs b/src/haddock/Haskell/Docs/HaddockDoc.hs --- a/src/haddock/Haskell/Docs/HaddockDoc.hs +++ b/src/haddock/Haskell/Docs/HaddockDoc.hs @@ -4,31 +4,12 @@ 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 Data.Char (isSpace) +import Data.Map (Map) +import qualified Data.Map as M 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 GHC hiding (verbosity) import Name -import PackageConfig -import Packages -- | Render the doc. doc :: Doc String -> String @@ -78,26 +59,30 @@ -- | 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))) +interfaceNameMap = M.fromList + . map (getOccString + *** + fmap getOccString +#if !(MIN_VERSION_haddock(2,10,0)) + . maybe DocEmpty id . fst #endif + ) + . M.toList + . instDocMap -- | 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))) +interfaceArgMap = M.fromList + . map ( +#if !(MIN_VERSION_haddock(2,10,0)) + first getOccString #else -interfaceArgMap iface = M.fromList (map (second (const M.empty) . first getOccString) - (M.toList (instDocMap iface))) + getOccString *** const M.empty #endif + ) + . M.toList + . instDocMap -- | Strip redundant whitespace. normalize :: [Char] -> [Char]