packages feed

haskell-docs 0.2.0.0 → 3.0.0

raw patch · 4 files changed

+276/−267 lines, 4 filesdep +haskell-docsdep ~ghcdep ~haddock

Dependencies added: haskell-docs

Dependency ranges changed: ghc, haddock

Files

haskell-docs.cabal view
@@ -1,5 +1,5 @@ name:                haskell-docs-version:             0.2.0.0+version:             3.0.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@@ -21,16 +21,10 @@                      in your .cabal/config so that the necessary                      .haddock files are generated.                      .-                     Haddock is very sensitive to the GHC version, and-                     so too will this program be, to GHC, and to Haddock. I suggest-                     installing like this:-                     .-                     > cabal install haskell-docs --constraint haddock==2.10.0-                     .-                     But replace the 2.10.0 with the version that haddock --version gives you.-                     .-                     I could perhaps instead have a flag for each GHC-                     release back a few versions.+                     Haddock is very sensitive to the GHC version. This program tries not to be. If+                     you cannot install this package due to a version problem, open a Github issue.+                     If the versions match up but the build fails, open a Github issue. Neither+                     case should arise.                      .                      /USING WITH GHCI/                      .@@ -57,16 +51,22 @@ Homepage:            http://github.com/chrisdone/haskell-docs Bug-Reports:         http://github.com/chrisdone/haskell-docs/issues --executable haskell-docs+library   hs-source-dirs:      src-  main-is:             Main.hs+  exposed-modules:     Documentation.Haddock.Docs   build-depends:       base > 4 && < 5,-                       ghc,+                       ghc > 7.2 && < 7.9,                        ghc-paths,-                       haddock,+                       haddock >= 2.9 && < 2.15,                        containers,                        monad-loops++executable haskell-docs+  hs-source-dirs:      src/main+  main-is:             Main.hs+  build-depends:       base > 4 && < 5,+                       ghc > 7.2 && < 7.9,+                       haskell-docs  source-repository head   type:        git
+ src/Documentation/Haddock/Docs.hs view
@@ -0,0 +1,241 @@+{-# OPTIONS -Wall #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}++-- | Lookup the documentation of a name in a module (and in a specific+-- package in the case of ambiguity).++module Documentation.Haddock.Docs where++import           Control.Arrow+import           Control.Monad+import           Control.Monad.Loops+import           Data.Char+import           Data.Either+import           Data.List+import           Data.Map (Map)+import qualified Data.Map as M+import           Documentation.Haddock+import           GHC hiding (verbosity)+import           GHC.Paths (libdir)+import           Module+import           Name+import           PackageConfig+import           Packages++#if __GLASGOW_HASKELL__ < 706+import           DynFlags (defaultLogAction)+#else+import           DynFlags (defaultFlushOut, defaultFatalMessager)+#endif++-- | Print documentation with an initialized package set.+printDocumentationInitialized :: String -> ModuleName -> Maybe String -> IO Bool+printDocumentationInitialized x y z =+  withInitializedPackages $ \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 d name mname mpname previous = do+  result <- 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... "+          anyM (printWithPackage d True name mname) (filter (not . isPrevious) packages)+        Just pname -> do+          case find ((== pname) . showPackageName . sourcePackageId) packages of+            Nothing -> error "Unable to find that module/package combination."+            Just package -> printWithPackage d False name mname package++  where isPrevious m = Just (sourcePackageId m) == fmap sourcePackageId previous++-- | Show the package name e.g. base.+showPackageName :: PackageIdentifier -> String+showPackageName = packageIdString . mkPackageId++-- | Print the documentation with the given package.+printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> IO Bool+printWithPackage d printPackage name mname package = do+  interfaceFiles <- getHaddockInterfacesByPackage package+  case (lefts interfaceFiles,rights interfaceFiles) of+    ([],[])        -> error "Found no interface files."+    (errs@(_:_),_) -> error $ "Couldn't parse interface file(s): " ++ unlines errs+    (_,files)      ->+      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++-- | 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++  where docMap = interfaceNameMap interface++-- | Print the documentation of the arguments.+printArgs :: InstalledInterface -> String -> IO ()+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))++  where formatArg i x = prefix +++                        indentAfter (length prefix) (formatDoc x)+          where prefix = show i ++ ": "++-- | Indent after the first line.+indentAfter :: Int -> String -> String+indentAfter i xs = intercalate "\n" (take 1 l ++ map (replicate (i-1) ' ' ++) (drop 1 l))+  where l = lines xs++-- | 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 d name qname package = do+  printDocumentation d name (moduleName (nameModule qname)) Nothing (Just package)++--------------------------------------------------------------------------------+-- Printing documentation++-- | Format some documentation to plain text.+formatDoc :: Doc String -> String+formatDoc = trim . doc where++-- | 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 block) = unlines (map ("    " ++) (lines (doc block))) ++ "\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++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)++--------------------------------------------------------------------------------+-- Package querying functions++-- | 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+-- | Search for a module's package, returning suggestions if not+-- found.+getPackagesByModule :: DynFlags -> ModuleName -> IO (Either [Module] [PackageConfig])+getPackagesByModule d m =+  return (fmap (map fst) (lookupModuleWithSuggestions d m))++-- | Get the Haddock interfaces of the given package.+getHaddockInterfacesByPackage :: PackageConfig -> IO [Either String InterfaceFile]+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'++#if __GLASGOW_HASKELL__ < 706+run :: Ghc a -> IO a+run = defaultErrorHandler defaultLogAction . runGhc (Just libdir)+#else+run :: Ghc a -> IO a+run = defaultErrorHandler defaultFatalMessager defaultFlushOut . runGhc (Just libdir)+#endif
− src/Main.hs 
@@ -1,251 +0,0 @@-{-# OPTIONS -Wall -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE CPP #-}---- | Lookup the documentation of a name in a module (and in a specific--- package in the case of ambiguity).------ To build:------     $ ghc --make HaskellDocs.hs -package ghc -o haskell-docs------ Example usage:------     $ ./haskell-docs System.IO getContents base---     The “getContents” operation returns all user input as a single string,---      which is read lazily as it is needed---      (same as “hGetContents” “stdin”).------ Using with GHCi------ Move haskell-docs to ~/.cabal/bin. Then run the following in GHCi:------     λ> :def doc \input -> return (":!haskell-docs " ++ input)------     λ> :doc System.IO getContents base---     The “getContents” operation returns all user input as a single string,---      which is read lazily as it is needed---      (same as “hGetContents” “stdin”).------ Add the above :def to your ~/.ghci to have it on start-up.--module Main where--import           Control.Arrow-import           Control.Monad-import Control.Monad.Loops-import           Data.Char-import           Data.Either-import           Data.List-import           Data.Map (Map)-import qualified Data.Map as M-import           Documentation.Haddock-#if __GLASGOW_HASKELL__ < 706-import           DynFlags (defaultLogAction)-#else-import           DynFlags (defaultFlushOut, defaultFatalMessager)-#endif-import           GHC hiding (flags, verbosity)-import           GHC.Paths (libdir)-import           Module-import           Name-import           PackageConfig-import           Packages-import           System.Environment---- | 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>]"---- | Print documentation with an initialized package set.-printDocumentationInitialized :: String -> ModuleName -> Maybe String -> IO Bool-printDocumentationInitialized x y z =-  withInitializedPackages $ \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 d name mname mpname previous = do-  result <- 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... "-          anyM (printWithPackage d True name mname) (filter (not . isPrevious) packages)-        Just pname -> do-          case find ((== pname) . showPackageName . sourcePackageId) packages of-            Nothing -> error "Unable to find that module/package combination."-            Just package -> printWithPackage d False name mname package--  where isPrevious m = Just (sourcePackageId m) == fmap sourcePackageId previous---- | Show the package name e.g. base.-showPackageName :: PackageIdentifier -> String-showPackageName = packageIdString . mkPackageId---- | Print the documentation with the given package.-printWithPackage :: DynFlags -> Bool -> String -> ModuleName -> PackageConfig -> IO Bool-printWithPackage d printPackage name mname package = do-  interfaceFiles <- getHaddockInterfacesByPackage package-  case (lefts interfaceFiles,rights interfaceFiles) of-    ([],[])        -> error "Found no interface files."-    (errs@(_:_),_) -> error $ "Couldn't parse interface file(s): " ++ unlines errs-    (_,files)      ->-      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 mname) interfaces---- | Print the documentation from the given interface.-printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> ModuleName -> InstalledInterface-                   -> IO Bool-printWithInterface d printPackage package name mname 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 d name subname package-        _ -> do-          putStrLn $ "Couldn't find name ``" ++ name ++ "'' in Haddock interface: " ++-                     moduleNameString (moduleName (instMod interface))-          return False-    Just doc -> do when printPackage $-                     putStrLn $ "Package: " ++ showPackageName (sourcePackageId package)-                   putStrLn (formatDoc doc)-                   printArgs interface name-                   return True--  where docMap = interfaceNameMap interface--        printName x = moduleNameString (moduleName (nameModule x)) ++ "." ++ getOccString x---- | Print the documentation of the arguments.-printArgs :: InstalledInterface -> String -> IO ()-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))--  where formatArg i x = prefix ++-                        indentAfter (length prefix) (formatDoc x)-          where prefix = show i ++ ": "---- | Indent after the first line.-indentAfter :: Int -> String -> String-indentAfter i xs = intercalate "\n" (take 1 l ++ map (replicate (i-1) ' ' ++) (drop 1 l))-  where l = lines xs---- | 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 d name qname package = do-  printDocumentation d name (moduleName (nameModule qname)) Nothing (Just package)------------------------------------------------------------------------------------- Printing documentation---- | Format some documentation to plain text.-formatDoc :: Doc String -> String-formatDoc = trim . go where-  go DocEmpty = ""-  go (DocAppend a b) = go a ++ go b-  go (DocString str) = normalize str-  go (DocParagraph p) = go p ++ "\n"-  go (DocIdentifier i) = i-  go (DocIdentifierUnchecked (mname,occname)) =-    moduleNameString mname ++ "." ++ occNameString occname-  go (DocModule m) = m-  go (DocEmphasis e) = "*" ++ go e ++ "*"-  go (DocMonospaced e) = "`" ++ go e ++ "`"-  go (DocUnorderedList i) = unlines (map (("* " ++) . go) i)-  go (DocOrderedList i) = unlines (zipWith (\i x -> show i ++ ". " ++ go x) [1..] i)-  go (DocDefList xs) = unlines (map (\(i,x) -> go i ++ ". " ++ go x) xs)-  go (DocCodeBlock block) = unlines (map ("    " ++) (lines (go block))) ++ "\n"-#if MIN_VERSION_haddock(2,13,1)-  go (DocHyperlink (Hyperlink url label)) = maybe url (\l -> l ++ "[" ++ url ++ "]") label-#else-  go (DocURL url) = url-#endif-  go (DocPic pic) = pic-  go (DocAName name) = name-  go (DocExamples exs) = unlines (map formatExample exs)--  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)------------------------------------------------------------------------------------- Package querying functions---- | Get a mapping from names to doc string of that name from a--- Haddock interface.-interfaceNameMap :: InstalledInterface -> Map String (Doc String)-interfaceNameMap iface =-  M.fromList (map (second (fmap getOccString) . first getOccString)-             (M.toList (instDocMap iface)))---- | Get a mapping from names to doc string of that name from a--- Haddock interface.-interfaceArgMap :: InstalledInterface -> Map String (Map Int (Doc Name))-interfaceArgMap iface =-  M.fromList (map (first getOccString) (M.toList (instArgMap iface)))---- | Search for a module's package, returning suggestions if not--- found.-getPackagesByModule :: DynFlags -> ModuleName -> IO (Either [Module] [PackageConfig])-getPackagesByModule d m =-  return (fmap (map fst) (lookupModuleWithSuggestions d m))---- | Get the Haddock interfaces of the given package.-getHaddockInterfacesByPackage :: PackageConfig -> IO [Either String InterfaceFile]-getHaddockInterfacesByPackage = mapM (readInterfaceFile freshNameCache) . haddockInterfaces---- | Run an action with an initialized GHC package set.-withInitializedPackages :: (DynFlags -> IO a) -> IO a-withInitializedPackages cont = do-#if __GLASGOW_HASKELL__ < 706-  dflags <- defaultErrorHandler defaultLogAction $ runGhc (Just libdir) $ do-#else-  dflags <- defaultErrorHandler defaultFatalMessager defaultFlushOut $ runGhc (Just libdir) $ do-#endif-    dflags <- getSessionDynFlags-    setSessionDynFlags dflags-    return dflags-  (dflags,packageids) <- initPackages dflags-  cont dflags------------------------------------------------------------------------------------- Utilities and missing instances--instance Show ModuleName where show = show . moduleNameString-instance Show OccName where show = show . occNameString-deriving instance Show (Doc String)
+ src/main/Main.hs view
@@ -0,0 +1,19 @@+{-# OPTIONS -Wall #-}++module Main where++import Control.Monad+import Documentation.Haddock.Docs+import GHC (mkModuleName)+import System.Environment++-- | 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>]"