haskell-docs 4.1.2 → 4.1.3

raw patch · 5 files changed

+108/−39 lines, 5 filesdep ~ghcPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc

API changes (from Hackage documentation)

Files

• haskell-docs.cabal +3/−2
• src/Haskell/Docs.hs +9/−6
• src/Haskell/Docs/Formatting.hs +32/−0
• src/main/Main.hs +61/−31
• src/test/Main.hs +3/−0

@@ -1,5 +1,5 @@ name:                haskell-docs-version:             4.1.2+version:             4.1.3 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@@ -85,7 +85,8 @@   hs-source-dirs:      src/main   main-is:             Main.hs   build-depends:       base > 4 && < 5,-                       haskell-docs+                       haskell-docs,+                       ghc  test-suite test     type: exitcode-stdio-1.0

@@ -23,21 +23,24 @@ -- -- | Print the documentation of a name in the given module. searchAndPrintDoc   :: Bool              -- ^ Print modules only.+  -> Bool              -- ^ S-expression format.   -> Maybe PackageName -- ^ Package.   -> Maybe ModuleName  -- ^ Module name.   -> Identifier        -- ^ Identifier.   -> Ghc ()-searchAndPrintDoc ms pname mname ident =+searchAndPrintDoc ms ss pname mname ident =   do (result,printPkg,printModule) <- search      case result of        Left err ->          error (show err)        Right (sortBy (comparing identDocPackageName) -> docs) ->-         mapM_ (\(i,doc') ->-                  do when (not ms && i > 0)-                          (liftIO (putStrLn ""))-                     printIdentDoc ms printPkg printModule doc')-               (zip [0::Int ..] (nub 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)

@@ -17,6 +17,10 @@  -- * Formatting +-- | Print docs as s-expressions.+printSexp :: [IdentDoc] -> Ghc ()+printSexp = mapM toSexp >=> liftIO . putStrLn . renderSexp . List+ -- | Print an identifier' documentation. printIdentDoc :: Bool -- ^ Print modules only?               -> Bool -- ^ Print package?@@ -50,6 +54,34 @@ formatDoc = trim . doc where  -- * Internal functions++-- | S-expression type.+data Sexp+  = Atom String+  | String String+  | List [Sexp]++-- | Render an s-expression to string.+renderSexp :: Sexp -> String+renderSexp (Atom string) = string+renderSexp (String string) = show string+renderSexp (List sexps) = "(" ++ intercalate " " (map renderSexp sexps) ++ ")"++-- | Convert docs to an s-expression.+toSexp :: IdentDoc -> Ghc Sexp+toSexp idoc =+  do d <- getSessionDynFlags+     return (List (concat (object d)))+  where+    object d =+      [[List [Atom "package",String (showPackageName (identDocPackageName idoc))]]+      ,[List [Atom "module",String (showppr d (moduleName (nameModule (getName i))))]+       |Just i <- [identDocIdent idoc]]+      ,[List [Atom "type",String (showppr d (idType i))]+       |Just i <- [identDocIdent idoc]]+      ,[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

@@ -1,53 +1,83 @@+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} -- | Main command-line interface.  module Main where -import Haskell.Docs-import Haskell.Docs.Types-import Haskell.Docs.Ghc+import           Haskell.Docs+import           Haskell.Docs.Ghc+import           Haskell.Docs.Types +import           Control.Exception+import           Control.Exception (IOException) import qualified Control.Exception as E-import System.Environment+import           GHC+import           GhcMonad+import           System.Environment+import           System.Exit+import           System.IO  -- | Main entry point. main :: IO () main =   do args <- getArgs-     E.catch-       (app args)-       (error . printEx)+     app args  -- | Do the printing. app :: [String] -> IO ()-app (extract -> (gs,ms,as)) =+app (extract -> (gs,ms,as,ss)) =   withInitializedPackages     gs-    (case as of-       [name] ->-         searchAndPrintDoc ms-                           Nothing-                           Nothing-                           (Identifier name)-       [mname,name,pname] ->-         searchAndPrintDoc ms-                           (Just (PackageName pname))-                           (Just (makeModuleName mname))-                           (Identifier name)-       [mname,name] ->-         searchAndPrintDoc ms-                           Nothing-                           (Just (makeModuleName mname))-                           (Identifier name)-       _ -> error "<module-name> <ident> [<package-name>] | <ident>")+    (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."))  -- | Extract arguments.-extract :: [String] -> ([String],Bool,[String])-extract = go ([],False,[])-  where go (gs,ms,as) ("-g":arg:ys)    = go (arg:gs,ms,as) ys-        go (gs,ms,as) ("--modules":ys) = go (gs,True,as) ys-        go (gs,ms,as) (y:ys)           = go (gs,ms,y:as) ys-        go (gs,ms,as) []               = (gs,ms,as)+extract :: [String] -> ([String],Bool,[String],Bool)+extract = go ([],False,[],False)+  where+    go (gs,ms,as,ss) ("-g":arg:ys)    = go (arg:gs,ms,as,ss) ys+    go (gs,ms,as,ss) ("--modules":ys) = go (gs,True,as,ss) ys+    go (gs,ms,as,ss) ("--sexp":ys)    = go (gs,ms,as,True) ys+    go (gs,ms,as,ss) (y:ys)           = go (gs,ms,y:as,ss) ys+    go (gs,ms,as,ss) []               = (gs,ms,as,ss)++-- | Catch errors and print 'em out.+catchErrors :: Ghc () -> Ghc ()+catchErrors m =+  gcatch (gcatch m+                 (\x ->+                    do bail (printEx x)+                       liftIO exitFailure))+         (\(e::SomeException) ->+            bail (show e))++-- | Print an error and bail out.+bail :: String -> Ghc ()+bail e =+  liftIO (hPutStrLn stderr e)  -- | Print an exception for humans. printEx :: DocsException -> String

@@ -36,6 +36,7 @@            []            (void (searchAndPrintDoc                     False+                    False                     Nothing                     (Just (makeModuleName "System.IO"))                     (Identifier "hSetBuffering"))))@@ -44,6 +45,7 @@            []            (void (searchAndPrintDoc                     False+                    False                     Nothing                     Nothing                     (Identifier "hSetBuffering"))))@@ -55,6 +57,7 @@         (withInitializedPackages            []            (do void (searchAndPrintDoc+                      False                       False                       Nothing                       (Just (makeModuleName "System.IO"))