packages feed

haskell-docs (empty) → 0.1.0.0

raw patch · 4 files changed

+340/−0 lines, 4 filesdep +basedep +containersdep +ghcsetup-changed

Dependencies added: base, containers, ghc, ghc-paths, haddock, monad-loops

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Chris Done++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Done nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ haskell-docs.cabal view
@@ -0,0 +1,73 @@+name:                haskell-docs+version:             0.1.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+                     the documentation of that name.+                     .+                     /EXAMPLE USAGE/+                     .+                     > $ haskell-docs Data.List.Split split+                     > Split a list according to the given splitting strategy. This is+                     >  how to "run" a Splitter that has been built using the other+                     >  combinators.+                     .+                     /INSTALLATION/+                     .+                     You should ensure that you have+                     .+                     > documentation: True+                     .+                     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-dev 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.+                     .+                     /USING WITH 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 user .ghci to have it on start-up.+                     .+                     /CONTRIBUTION AND ISSUES/+                     .+                     Issues/ideas/contributions please make a Github issue: <http://github.com/chrisdone/haskell-docs/issues>+                     .+license:             BSD3+license-file:        LICENSE+author:              Chris Done+maintainer:          chrisdone@gmail.com+copyright:           2012 Chris Done+category:            Development+build-type:          Simple+cabal-version:       >=1.8+Homepage:            http://github.com/chrisdone/haskell-docs+Bug-Reports:         http://github.com/chrisdone/haskell-docs/issues+++executable haskell-docs+  hs-source-dirs:      src+  main-is:             Main.hs+  build-depends:       base > 4 && < 5,+                       ghc,+                       ghc-paths,+                       haddock,+                       containers,+                       monad-loops++source-repository head+  type:        git+  location:    git://github.com/chrisdone/haskell-docs.git
+ src/Main.hs view
@@ -0,0 +1,235 @@+{-# OPTIONS -Wall -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | 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+import           DynFlags (defaultLogAction)+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) interfaces++-- | Print the documentation from the given interface.+printWithInterface :: DynFlags -> Bool -> PackageConfig -> String -> InstalledInterface -> IO Bool+printWithInterface d printPackage package name interface = do+  case M.lookup name docMap of+    Nothing ->+      case lookup name (map (getOccString &&& id) (instExports interface)) of+        Just subname -> descendSearch d name subname package+        Nothing -> 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"+  go (DocURL url) = url+  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+  dflags <- defaultErrorHandler defaultLogAction $ runGhc (Just libdir) $ do+    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)