improving doc.

This commit is contained in:
Kazu Yamamoto 2013-09-05 14:35:28 +09:00
parent 8e60864a34
commit 5e53841451
8 changed files with 41 additions and 36 deletions

View File

@ -19,6 +19,7 @@ import Var
-- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained.
-- If 'operators' is 'True', operators are also returned.
browseModule :: Options
-> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> IO String
@ -38,6 +39,7 @@ browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt
-- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained.
-- If 'operators' is 'True', operators are also returned.
browse :: Options
-> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> Ghc [String]

View File

@ -16,7 +16,7 @@ import Prelude
-- Warnings and errors are returned.
checkSyntax :: Options
-> Cradle
-> [FilePath] -- ^ The target files
-> [FilePath] -- ^ The target files.
-> IO String
checkSyntax _ _ [] = error "ghc-mod: checkSyntax: No files given"
checkSyntax opt cradle files = unlines <$> withGHC sessionName (check opt cradle files)
@ -31,7 +31,7 @@ checkSyntax opt cradle files = unlines <$> withGHC sessionName (check opt cradle
-- Warnings and errors are returned.
check :: Options
-> Cradle
-> [FilePath] -- ^ The target files
-> [FilePath] -- ^ The target files.
-> Ghc [String]
check _ _ [] = error "ghc-mod: check: No files given"
check opt cradle fileNames = checkIt `gcatch` handleErrMsg ls

View File

@ -10,7 +10,7 @@ import System.FilePath ((</>),takeDirectory)
-- | Finding 'Cradle'.
-- An error would be thrown.
findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox
findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox.
-> GHCVersion
-> IO Cradle
findCradle (Just sbox) strver = do

View File

@ -18,7 +18,7 @@ import Prelude
debugInfo :: Options
-> Cradle
-> GHCVersion
-> FilePath -- ^ A target file
-> FilePath -- ^ A target file.
-> IO String
debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName)
@ -26,7 +26,7 @@ debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt crad
debug :: Options
-> Cradle
-> GHCVersion
-> FilePath -- ^ A target file
-> FilePath -- ^ A target file.
-> Ghc [String]
debug opt cradle ver fileName = do
(gopts, incDir, pkgs) <-

View File

@ -22,7 +22,7 @@ import System.FilePath (normalise)
----------------------------------------------------------------
-- | A means to read the log
-- | A means to read the log.
type LogReader = IO [String]
----------------------------------------------------------------

View File

@ -32,13 +32,13 @@ import System.IO
----------------------------------------------------------------
-- | Converting the 'Ghc' monad to the 'IO' monad.
withGHCDummyFile :: Alternative m => Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities
withGHCDummyFile :: Alternative m => Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities.
-> IO (m a)
withGHCDummyFile = withGHC "Dummy"
-- | Converting the 'Ghc' monad to the 'IO' monad.
withGHC :: Alternative m => FilePath -- ^ A target file displayed in an error message
-> Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities
withGHC :: Alternative m => FilePath -- ^ A target file displayed in an error message.
-> Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities.
-> IO (m a)
withGHC file body = ghandle ignore $ runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
@ -154,7 +154,7 @@ modifyFlagsWithOpts dflags cmdOpts =
----------------------------------------------------------------
-- | Set the files that GHC will load / compile
-- | Set the files that GHC will load / compile.
setTargetFiles :: (GhcMonad m) => [String] -> m ()
setTargetFiles [] = error "ghc-mod: setTargetFiles: No target files given"
setTargetFiles files = do
@ -163,7 +163,7 @@ setTargetFiles files = do
----------------------------------------------------------------
-- | Return the 'DynFlags' currently in use in the GHC session
-- | Return the 'DynFlags' currently in use in the GHC session.
getDynamicFlags :: IO DynFlags
getDynamicFlags = runGhc (Just libdir) getSessionDynFlags

View File

@ -42,18 +42,18 @@ data Cmd = Info | Type deriving Eq
-- | Obtaining information of a target expression. (GHCi's info:)
infoExpr :: Options
-> Cradle
-> FilePath -- ^ A target file
-> ModuleString -- ^ A module name
-> Expression -- ^ A Haskell expression
-> FilePath -- ^ A target file.
-> ModuleString -- ^ A module name.
-> Expression -- ^ A Haskell expression.
-> IO String
infoExpr opt cradle file modstr expr = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr)
-- | Obtaining information of a target expression. (GHCi's info:)
info :: Options
-> Cradle
-> FilePath -- ^ A target file
-> ModuleString -- ^ A module name
-> Expression -- ^ A Haskell expression
-> FilePath -- ^ A target file.
-> ModuleString -- ^ A module name.
-> Expression -- ^ A Haskell expression.
-> Ghc String
info opt cradle file modstr expr =
inModuleContext Info opt cradle file modstr exprToInfo "Cannot show info"
@ -83,20 +83,20 @@ instance HasType (LPat Id) where
-- | Obtaining type of a target expression. (GHCi's type:)
typeExpr :: Options
-> Cradle
-> FilePath -- ^ A target file
-> ModuleString -- ^ A odule name
-> Int -- ^ Line number
-> Int -- ^ Column number
-> FilePath -- ^ A target file.
-> ModuleString -- ^ A odule name.
-> Int -- ^ Line number.
-> Int -- ^ Column number.
-> IO String
typeExpr opt cradle file modstr lineNo colNo = withGHCDummyFile $ typeOf opt cradle file modstr lineNo colNo
-- | Obtaining type of a target expression. (GHCi's type:)
typeOf :: Options
-> Cradle
-> FilePath -- ^ A target file
-> ModuleString -- ^ A odule name
-> Int -- ^ Line number
-> Int -- ^ Column number
-> FilePath -- ^ A target file.
-> ModuleString -- ^ A odule name.
-> Int -- ^ Line number.
-> Int -- ^ Column number.
-> Ghc String
typeOf opt cradle file modstr lineNo colNo =
inModuleContext Type opt cradle file modstr exprToType errmsg

View File

@ -3,15 +3,17 @@
module Language.Haskell.GhcMod.Types where
-- | Output style.
data OutputStyle = LispStyle -- ^ S expression style
| PlainStyle -- ^ Plain textstyle
data OutputStyle = LispStyle -- ^ S expression style.
| PlainStyle -- ^ Plain textstyle.
-- | The type for line separator. Historically, a Null string is used.
newtype LineSeparator = LineSeparator String
data Options = Options {
outputStyle :: OutputStyle
, hlintOpts :: [String]
, ghcOpts :: [String]
-- | If 'True', 'browse' also returns operators.
, operators :: Bool
-- | If 'True', 'browse' also returns types.
, detailed :: Bool
@ -19,6 +21,7 @@ data Options = Options {
, expandSplice :: Bool
-- | The sandbox directory.
, sandbox :: Maybe FilePath
-- | Line separator string.
, lineSeparator :: LineSeparator
}
@ -74,33 +77,33 @@ addNewLine = (++ "\n")
----------------------------------------------------------------
-- | The environment where this library is used
-- | The environment where this library is used.
data Cradle = Cradle {
-- | The directory where this library is executed
-- | The directory where this library is executed.
cradleCurrentDir :: FilePath
-- | The directory where a cabal file is found
-- | The directory where a cabal file is found.
, cradleCabalDir :: Maybe FilePath
-- | The file name of the found cabal file
-- | The file name of the found cabal file.
, cradleCabalFile :: Maybe FilePath
-- | The sandbox directory (e.g. \"\/foo\/bar\/packages-\<ver\>.conf/\")
-- | The sandbox directory. (e.g. \"\/foo\/bar\/packages-\<ver\>.conf/\")
, cradlePackageConf :: Maybe FilePath
} deriving (Eq, Show)
----------------------------------------------------------------
-- | A single GHC option, as it would appear on the command line
-- | A single GHC option, as it would appear on the command line.
type GHCOption = String
type IncludeDir = FilePath
type Package = String
-- | GHC version in 'String'
-- | GHC version in 'String'.
type GHCVersion = String
-- | Haskell expression
-- | Haskell expression.
type Expression = String
-- | Module name
-- | Module name.
type ModuleString = String
data CheckSpeed = Slow | Fast