From 089d49060709a560c2996731e2614920f8d763a5 Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 20 May 2013 14:28:56 +0900 Subject: [PATCH] writing docs. --- Language/Haskell/GhcMod.hs | 12 ++++-- Language/Haskell/GhcMod/Browse.hs | 12 +++++- Language/Haskell/GhcMod/CabalApi.hs | 3 +- Language/Haskell/GhcMod/Check.hs | 14 ++++++- Language/Haskell/GhcMod/Cradle.hs | 7 +++- Language/Haskell/GhcMod/Debug.hs | 14 ++++++- Language/Haskell/GhcMod/Flag.hs | 2 + Language/Haskell/GhcMod/GHCApi.hs | 9 ++++- Language/Haskell/GhcMod/Info.hs | 62 +++++++++++++++++++++-------- Language/Haskell/GhcMod/Lang.hs | 2 + Language/Haskell/GhcMod/Lint.hs | 10 ++++- Language/Haskell/GhcMod/List.hs | 10 +++-- Language/Haskell/GhcMod/Types.hs | 24 ++++++++++- src/GHCMod.hs | 4 +- test/InfoSpec.hs | 12 +++--- 15 files changed, 150 insertions(+), 47 deletions(-) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 27ed0f1..97edebb 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -3,31 +3,35 @@ module Language.Haskell.GhcMod ( Cradle(..) , findCradle -- * GHC version + , GHCVersion , getGHCVersion -- * Options , Options(..) , OutputStyle(..) , defaultOptions + -- * Types + , ModuleString + , Expression -- * 'IO' utilities , browseModule , checkSyntax - , debugInfo + , lintSyntax , infoExpr , typeExpr , listModules , listLanguages , listFlags - , lintSyntax + , debugInfo -- * Converting the 'Ghc' monad to the 'IO' monad , withGHC , withGHCDummyFile -- * 'Ghc' utilities , browse , check - , debug , info , typeOf - , list + , listMods + , debug ) where import Language.Haskell.GhcMod.Browse diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index f0871df..3347da3 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -17,7 +17,11 @@ import Var ---------------------------------------------------------------- -browseModule :: Options -> String -> IO String +-- | Getting functions, classes, etc from a module. +-- If 'detailed' is 'True', their types are also obtained. +browseModule :: Options + -> ModuleString -- ^ A module name. (e.g. \"Data.List\") + -> IO String browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt mdlName) where format @@ -32,7 +36,11 @@ browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt (name, tail_) = break isSpace x formatOps' [] = error "formatOps'" -browse :: Options -> String -> Ghc [String] +-- | Getting functions, classes, etc from a module. +-- If 'detailed' is 'True', their types are also obtained. +browse :: Options + -> ModuleString -- ^ A module name. (e.g. \"Data.List\") + -> Ghc [String] browse opt mdlName = do initializeFlags opt getModule >>= getModuleInfo >>= listExports diff --git a/Language/Haskell/GhcMod/CabalApi.hs b/Language/Haskell/GhcMod/CabalApi.hs index e23cf86..a57b808 100644 --- a/Language/Haskell/GhcMod/CabalApi.hs +++ b/Language/Haskell/GhcMod/CabalApi.hs @@ -129,7 +129,8 @@ uniqueAndSort = toList . fromList ---------------------------------------------------------------- -getGHCVersion :: IO (String, Int) +-- | Getting GHC version. 7.6.3 becames 706 in the second of the result. +getGHCVersion :: IO (GHCVersion, Int) getGHCVersion = ghcVer >>= toTupple where ghcVer = programFindVersion ghcProgram silent (programName ghcProgram) diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index 860f1db..83571b4 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -12,12 +12,22 @@ import Prelude ---------------------------------------------------------------- -checkSyntax :: Options -> Cradle -> FilePath -> IO String +-- | Checking syntax of a target file using GHC. +-- Warnings and errors are returned. +checkSyntax :: Options + -> Cradle + -> FilePath -- ^ A target file + -> IO String checkSyntax opt cradle file = unlines <$> withGHC file (check opt cradle file) ---------------------------------------------------------------- -check :: Options -> Cradle -> FilePath -> Ghc [String] +-- | Checking syntax of a target file using GHC. +-- Warnings and errors are returned. +check :: Options + -> Cradle + -> FilePath -- ^ A target file + -> Ghc [String] check opt cradle fileName = checkIt `gcatch` handleErrMsg where checkIt = do diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index 8a47fb8..07d6860 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -8,8 +8,11 @@ import Language.Haskell.GhcMod.Types import System.Directory import System.FilePath ((),takeDirectory) --- An error would be thrown -findCradle :: Maybe FilePath -> String -> IO Cradle +-- | Finding 'Cradle'. +-- An error would be thrown. +findCradle :: Maybe FilePath -- ^ A 'FilePath' for a sandbox + -> GHCVersion + -> IO Cradle findCradle (Just sbox) strver = do pkgConf <- checkPackageConf sbox strver wdir <- getCurrentDirectory diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index c4407b4..9bab277 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -14,10 +14,20 @@ import Prelude ---------------------------------------------------------------- -debugInfo :: Options -> Cradle -> String -> FilePath -> IO String +-- | Obtaining debug information. +debugInfo :: Options + -> Cradle + -> GHCVersion + -> FilePath -- ^ A target file + -> IO String debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName) -debug :: Options -> Cradle -> String -> FilePath -> Ghc [String] +-- | Obtaining debug information. +debug :: Options + -> Cradle + -> GHCVersion + -> FilePath -- ^ A target file + -> Ghc [String] debug opt cradle ver fileName = do (gopts, incDir, pkgs) <- if cabal then diff --git a/Language/Haskell/GhcMod/Flag.hs b/Language/Haskell/GhcMod/Flag.hs index a0ccfc5..b184cc2 100644 --- a/Language/Haskell/GhcMod/Flag.hs +++ b/Language/Haskell/GhcMod/Flag.hs @@ -5,6 +5,8 @@ module Language.Haskell.GhcMod.Flag where import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types +-- | Listing GHC flags. (e.g -fno-warn-orphans) + listFlags :: Options -> IO String listFlags opt = return $ convert opt [ "-f" ++ prefix ++ option | option <- Gap.fOptions diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index 9349b53..2d465d2 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -30,10 +30,15 @@ import System.IO ---------------------------------------------------------------- -withGHCDummyFile :: Alternative m => Ghc (m a) -> IO (m a) +-- | Converting the 'Ghc' monad to the 'IO' monad. +withGHCDummyFile :: Alternative m => Ghc (m a) -- ^ 'Ghc' actions created by the Ghc utilities + -> IO (m a) withGHCDummyFile = withGHC "Dummy" -withGHC :: Alternative m => FilePath -> Ghc (m a) -> IO (m a) +-- | 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 + -> IO (m a) withGHC file body = ghandle ignore $ runGhc (Just libdir) $ do dflags <- getSessionDynFlags defaultCleanupHandler dflags body diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 794cdaf..484196e 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -1,7 +1,12 @@ {-# LANGUAGE TupleSections, FlexibleInstances, TypeSynonymInstances #-} {-# LANGUAGE Rank2Types #-} -module Language.Haskell.GhcMod.Info (infoExpr, info, typeExpr, typeOf) where +module Language.Haskell.GhcMod.Info ( + infoExpr + , info + , typeExpr + , typeOf + ) where import Control.Applicative import Control.Monad (void, when) @@ -29,19 +34,28 @@ import TcRnTypes ---------------------------------------------------------------- -type Expression = String -type ModuleString = String - data Cmd = Info | Type deriving Eq ---------------------------------------------------------------- -infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String -infoExpr opt cradle modstr expr file = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr) +-- | Obtaining information of a target expression. (GHCi's info:) +infoExpr :: Options + -> Cradle + -> 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) -info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String -info opt cradle fileName modstr expr = - inModuleContext Info opt cradle fileName modstr exprToInfo "Cannot show info" +-- | Obtaining information of a target expression. (GHCi's info:) +info :: Options + -> Cradle + -> 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" where exprToInfo = infoThing expr @@ -67,12 +81,28 @@ instance HasType (LHsBind Id) where instance HasType (LPat Id) where getType _ (L spn pat) = return $ Just (spn, hsPatType pat) -typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> IO String -typeExpr opt cradle modstr lineNo colNo file = withGHCDummyFile $ typeOf opt cradle file modstr lineNo colNo +---------------------------------------------------------------- -typeOf :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> Ghc String -typeOf opt cradle fileName modstr lineNo colNo = - inModuleContext Type opt cradle fileName modstr exprToType errmsg +-- | 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 + -> 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 + -> Ghc String +typeOf opt cradle file modstr lineNo colNo = + inModuleContext Type opt cradle file modstr exprToType errmsg where exprToType = do modSum <- getModSummary $ mkModuleName modstr @@ -142,13 +172,13 @@ pprInfo pefas (thing, fixity, insts) ---------------------------------------------------------------- inModuleContext :: Cmd -> Options -> Cradle -> FilePath -> ModuleString -> Ghc String -> String -> Ghc String -inModuleContext cmd opt cradle fileName modstr action errmsg = +inModuleContext cmd opt cradle file modstr action errmsg = valid ||> invalid ||> return errmsg where valid = do void $ initializeFlagsWithCradle opt cradle ["-w:"] False when (cmd == Info) setSlowDynFlags - setTargetFile fileName + setTargetFile file checkSlowAndSet void $ load LoadAllTargets doif setContextFromTarget action diff --git a/Language/Haskell/GhcMod/Lang.hs b/Language/Haskell/GhcMod/Lang.hs index e64bd06..57fff18 100644 --- a/Language/Haskell/GhcMod/Lang.hs +++ b/Language/Haskell/GhcMod/Lang.hs @@ -3,5 +3,7 @@ module Language.Haskell.GhcMod.Lang where import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types +-- | Listing language extensions. + listLanguages :: Options -> IO String listLanguages opt = return $ convert opt Gap.supportedExtensions diff --git a/Language/Haskell/GhcMod/Lint.hs b/Language/Haskell/GhcMod/Lint.hs index a87a290..6a44c36 100644 --- a/Language/Haskell/GhcMod/Lint.hs +++ b/Language/Haskell/GhcMod/Lint.hs @@ -5,10 +5,16 @@ import Data.List import Language.Haskell.GhcMod.Types import Language.Haskell.HLint -lintSyntax :: Options -> String -> IO String +-- | Checking syntax of a target file using hlint. +-- Warnings and errors are returned. +lintSyntax :: Options + -> FilePath -- ^ A target file. + -> IO String lintSyntax opt file = pack <$> lint opt file where pack = unlines . map (intercalate "\0" . lines) -lint :: Options -> String -> IO [String] +lint :: Options + -> FilePath -- ^ A target file. + -> IO [String] lint opt file = map show <$> hlint ([file, "--quiet"] ++ hlintOpts opt) diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index e59690f..2d360d9 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/Language/Haskell/GhcMod/List.hs @@ -1,4 +1,4 @@ -module Language.Haskell.GhcMod.List (listModules, list) where +module Language.Haskell.GhcMod.List (listModules, listMods) where import Control.Applicative import Data.List @@ -10,11 +10,13 @@ import UniqFM ---------------------------------------------------------------- +-- | Listing installed modules. listModules :: Options -> IO String -listModules opt = convert opt . nub . sort <$> withGHCDummyFile (list opt) +listModules opt = convert opt . nub . sort <$> withGHCDummyFile (listMods opt) -list :: Options -> Ghc [String] -list opt = do +-- | Listing installed modules. +listMods :: Options -> Ghc [String] +listMods opt = do initializeFlags opt getExposedModules <$> getSessionDynFlags where diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 0ec09f4..f32b769 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -2,18 +2,24 @@ module Language.Haskell.GhcMod.Types where -data OutputStyle = LispStyle | PlainStyle +-- | Output style. +data OutputStyle = LispStyle -- ^ S expression style + | PlainStyle -- ^ Plain textstyle data Options = Options { outputStyle :: OutputStyle , hlintOpts :: [String] , ghcOpts :: [String] , operators :: Bool + -- | If 'True', 'browse' also returns types. , detailed :: Bool + -- | Whether or not Template Haskell should be expanded. , expandSplice :: Bool - , sandbox :: Maybe String + -- | The sandbox directory. + , sandbox :: Maybe FilePath } +-- | A default 'Options'. defaultOptions :: Options defaultOptions = Options { outputStyle = PlainStyle @@ -64,10 +70,15 @@ addNewLine = (++ "\n") ---------------------------------------------------------------- +-- | The environment where this library is used data Cradle = Cradle { + -- | The directory where this library is executed cradleCurrentDir :: FilePath + -- | The directory where a cabal file is found , cradleCabalDir :: Maybe FilePath + -- | The file name of the found cabal file , cradleCabalFile :: Maybe FilePath + -- | The sandbox directory (e.g. \"\/foo\/bar\/packages-\.conf/\") , cradlePackageConf :: Maybe FilePath } deriving (Eq, Show) @@ -77,4 +88,13 @@ type GHCOption = String type IncludeDir = FilePath type Package = String +-- | GHC version in 'String' +type GHCVersion = String + +-- | Haskell expression +type Expression = String + +-- | Module name +type ModuleString = String + data CheckSpeed = Slow | Fast diff --git a/src/GHCMod.hs b/src/GHCMod.hs index d6f147c..2645804 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -96,8 +96,8 @@ main = flip catches handlers $ do "check" -> checkSyntax opt cradle cmdArg1 "expand" -> checkSyntax opt { expandSplice = True } cradle cmdArg1 "debug" -> debugInfo opt cradle strVer cmdArg1 - "type" -> typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4) cmdArg1 - "info" -> infoExpr opt cradle cmdArg2 cmdArg3 cmdArg1 + "type" -> typeExpr opt cradle cmdArg1 cmdArg2 (read cmdArg3) (read cmdArg4) + "info" -> infoExpr opt cradle cmdArg1 cmdArg2 cmdArg3 "lint" -> withFile (lintSyntax opt) cmdArg1 "lang" -> listLanguages opt "flag" -> listFlags opt diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index 477b5da..ebef607 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -14,38 +14,38 @@ spec = do withDirectory_ "test/data/ghc-mod-check" $ do (strVer,_) <- getGHCVersion cradle <- findCradle Nothing strVer - res <- typeExpr defaultOptions cradle "Data.Foo" 9 5 "Data/Foo.hs" + res <- typeExpr defaultOptions cradle "Data/Foo.hs" "Data.Foo" 9 5 res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do cradle <- getGHCVersion >>= findCradle Nothing . fst - res <- typeExpr defaultOptions cradle "Bar" 5 1 "Bar.hs" + res <- typeExpr defaultOptions cradle "Bar.hs" "Bar" 5 1 res `shouldBe` unlines ["5 1 5 20 \"[Char]\""] it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do cradle <- getGHCVersion >>= findCradle Nothing . fst - res <- typeExpr defaultOptions cradle "Main" 3 8 "Main.hs" + res <- typeExpr defaultOptions cradle "Main.hs" "Main" 3 8 res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""] describe "infoExpr" $ do it "works for non-export functions" $ do withDirectory_ "test/data" $ do cradle <- getGHCVersion >>= findCradle Nothing . fst - res <- infoExpr defaultOptions cradle "Info" "fib" "Info.hs" + res <- infoExpr defaultOptions cradle "Info.hs" "Info" "fib" res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`) it "works with a module using TemplateHaskell" $ do withDirectory_ "test/data" $ do cradle <- getGHCVersion >>= findCradle Nothing . fst - res <- infoExpr defaultOptions cradle "Bar" "foo" "Bar.hs" + res <- infoExpr defaultOptions cradle "Bar.hs" "Bar" "foo" res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`) it "works with a module that imports another module using TemplateHaskell" $ do withDirectory_ "test/data" $ do cradle <- getGHCVersion >>= findCradle Nothing . fst - res <- infoExpr defaultOptions cradle "Main" "bar" "Main.hs" + res <- infoExpr defaultOptions cradle "Main.hs" "Main" "bar" res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`) it "doesn't fail on unicode output" $ do