ghc-imported-from 0.2.0.5 → 0.2.0.6
raw patch · 4 files changed
+40/−111 lines, 4 filesdep +optparse-applicativePVP ok
version bump matches the API change (PVP)
Dependencies added: optparse-applicative
API changes (from Hackage documentation)
Files
- Language/Haskell/GhcImportedFrom.hs +6/−1
- changelog.md +5/−0
- ghc-imported-from.cabal +4/−1
- src/Main.hs +25/−109
Language/Haskell/GhcImportedFrom.hs view
@@ -140,7 +140,7 @@ parseHaskellModuleName :: TP.ParsecT String u Data.Functor.Identity.Identity String parseHaskellModuleName = do c <- TP.upper- cs <- TP.many (TP.choice [TP.lower, TP.upper])+ cs <- TP.many (TP.choice [TP.lower, TP.upper, TP.char '_', TP.digit]) return (c:cs) parseDottedHaskellModuleName :: TP.ParsecT String u Data.Functor.Identity.Identity String@@ -246,6 +246,8 @@ GhcMonad.liftIO $ putStrLn $ "getSummary, setting dynamic flags..." (allGhcOpts, _) <- getSessionDynFlags >>= setDynamicFlags ghcopts + GhcMonad.liftIO $ putStrLn $ "getSummary, allGhcOpts: " ++ show allGhcOpts+ -- Load the target file (e.g. "Muddle.hs"). GhcMonad.liftIO $ putStrLn $ "getSummary, loading the target file..." target <- guessTarget targetFile Nothing@@ -782,6 +784,9 @@ setCurrentDirectory workDir let targetFile = currentDir </> _targetFile++ putStrLn $ "currentDir: " ++ currentDir+ putStrLn $ "workDir: " ++ workDir putStrLn $ "targetFile: " ++ targetFile putStrLn $ "targetModule: " ++ targetModule
changelog.md view
@@ -1,3 +1,8 @@+2014-07-05 v0.2.0.6++* Use optparse-applicative for argument parsing.+* Allow digits and underscores in module names.+ 2014-06-01 v0.2.0.5 * Version bound on ghc-mod.
ghc-imported-from.cabal view
@@ -1,5 +1,5 @@ name: ghc-imported-from-version: 0.2.0.5+version: 0.2.0.6 synopsis: Find the Haddock documentation for a symbol. description: Given a Haskell module and symbol, determine the URL to the Haddock documentation for that symbol.@@ -39,6 +39,7 @@ , mtl , transformers , parsec+ , optparse-applicative if impl(ghc < 7.7) Build-Depends: Cabal >= 1.10 && < 1.17 else@@ -74,6 +75,7 @@ , mtl , transformers , parsec+ , optparse-applicative , hspec if impl(ghc < 7.7)@@ -106,6 +108,7 @@ , mtl , transformers , parsec+ , optparse-applicative , hspec if impl(ghc < 7.7) Build-Depends: Cabal >= 1.10 && < 1.17
src/Main.hs view
@@ -1,116 +1,32 @@-{-# LANGUAGE DeriveDataTypeable #-}----module Main where+module Main where import Language.Haskell.GhcImportedFrom--import Data.List-import Data.Maybe-import Data.Version ( showVersion )-import System.Environment--import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)-import System.Console.GetOpt-import System.Exit--import Control.Exception-import Data.Typeable--import Control.Monad (forM_) import Control.Monad.Writer--import Paths_ghc_imported_from---- FIXME adapt these to ghc-imported-from-data GHCImportedFromError = SafeList- | TooManyArguments String- | NoSuchCommand String- | CmdArg [String]- | FileNotExist String deriving (Show, Typeable)--instance Exception GHCImportedFromError--ghcOptHelp :: String-ghcOptHelp = " [--ghc-option GHC_opt1 --ghc-option GHC_opt2 ...] "--ghcPkgOptHelp :: String-ghcPkgOptHelp = " [--ghc-pkg-option ghc_pkg_opt1 --ghc-pkg-option ghc_pkg_opt2 ...] "--usage :: String-usage = "ghc-imported-from version " ++ showVersion version ++ "\n"- ++ "Usage:\n"- ++ "\t ghc-imported-from haddock-url" ++ ghcOptHelp ++ ghcPkgOptHelp ++ "<HaskellFile> <module> <symbol> <line-no> <column-no>\n"- ++ "\t ghc-imported-from help\n"- ++ "\nExample: ghc-imported-from haddock-url src/Main.hs Main getArgs 160 13\n"+import Options.Applicative -parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])-parseArgs spec argv- = case getOpt Permute spec argv of- (o,n,[] ) -> (foldr id defaultOptions o, n)- (_,_,errs) -> throw (CmdArg errs)+data CmdOptions = CmdOptions { cmdGhcOptions :: [String]+ , cmdGhcPkgOptions :: [String]+ , cmdHaskellFile :: FilePath+ , cmdModuleName :: String+ , cmdSymbol :: String+ , cmdLineNr :: Int+ , cmdColNr :: Int+ } deriving Show -argspec :: [OptDescr (Options -> Options)]-argspec = [ Option "g" ["ghc-options"]- (ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghc-options")- "GHC options"- , Option "p" ["ghc-pkg-options"]- (ReqArg (\g opts -> opts { ghcPkgOpts = g : ghcPkgOpts opts }) "ghc-pkg-options")- "ghc-pkg options"- -- , Option "b" ["boundary"]- -- (ReqArg (\s opts -> opts { lineSeparator = LineSeparator s }) "sep")- -- "specify line separator (default is Nul string)"- ]+parserOptions :: Parser CmdOptions+parserOptions = CmdOptions+ <$> (many $ strOption ( long "ghc-options" <> help "GHC options" ))+ <*> (many $ strOption ( long "ghc-pkg-options" <> help "ghc-pkg options" ))+ <*> argument str (metavar "<Haskell file>")+ <*> argument str (metavar "<module name>")+ <*> argument str (metavar "<symbol>")+ <*> argument auto (metavar "<line nr>")+ <*> argument auto (metavar "<column nr>") main :: IO ()-main = flip catches handlers $ do--- #if __GLASGOW_HASKELL__ >= 611- hSetEncoding stdout utf8--- #endif- args <- getArgs- let (opt,cmdArg) = parseArgs argspec args-- -- print opt- -- print cmdArg-- let cmdArg0 = cmdArg !. 0- cmdArg1 = cmdArg !. 1- cmdArg2 = cmdArg !. 2- cmdArg3 = cmdArg !. 3- cmdArg4 = cmdArg !. 4- cmdArg5 = cmdArg !. 5- remainingArgs = tail cmdArg- nArgs n f = if length remainingArgs == n- then f- else throw (TooManyArguments cmdArg0)-- res <- case cmdArg0 of- "haddock-url" -> nArgs 5 $ haddockUrl opt cmdArg1 cmdArg2 cmdArg3 (read cmdArg4) (read cmdArg5)- "help" -> return $ usageInfo usage argspec- cmd -> throw (NoSuchCommand cmd)- putStr res-- where- handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]- handleThenExit handler = \e -> handler e >> exitFailure- handler1 :: ErrorCall -> IO ()- handler1 = print -- for debug- handler2 :: GHCImportedFromError -> IO ()- handler2 SafeList = printUsage- handler2 (TooManyArguments cmd) = do- hPutStrLn stderr $ "\"" ++ cmd ++ "\": Too many arguments"- printUsage- handler2 (NoSuchCommand cmd) = do- hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"- printUsage- handler2 (CmdArg errs) = do- mapM_ (hPutStr stderr) errs- printUsage- handler2 (FileNotExist file) = do- hPutStrLn stderr $ "\"" ++ file ++ "\" not found"- printUsage- printUsage = hPutStrLn stderr $ '\n' : usageInfo usage argspec-- xs !. idx- | length xs <= idx = throw SafeList- | otherwise = xs !! idx-+main = do+ (CmdOptions gOpts gpkgOpts hfile mname sym line col) <- execParser opts+ haddockUrl (Options gOpts gpkgOpts (LineSeparator "\0")) hfile mname sym line col >>= putStr+ where+ opts = info (helper <*> parserOptions)+ (fullDesc <> header "ghc-imported-from - find the haddock url for a symbol in a Haskell file.\n\nExample: ghc-imported-from src/Main.hs Main getArgs 160 13\n")