Separating IO and Ghc.

This commit is contained in:
Kazu Yamamoto 2013-05-20 11:29:44 +09:00
parent f2f3b120af
commit 849c308e5c
17 changed files with 70 additions and 75 deletions

View File

@ -1,22 +1,33 @@
module Language.Haskell.GhcMod ( module Language.Haskell.GhcMod (
browseModule -- * Cradle
, checkSyntax Cradle(..)
, check , findCradle
, module Language.Haskell.GhcMod.Cradle -- * GHC version
, debugInfo
, debug
, infoExpr
, info
, typeExpr
, typeOf
, listLanguages
, lintSyntax
, listModules
, module Language.Haskell.GhcMod.Types
, listFlags
, getGHCVersion , getGHCVersion
, withGHCDummyFile -- * Options
, Options(..)
, OutputStyle(..)
, defaultOptions
-- * 'IO' utilities
, browseModule
, checkSyntax
, debugInfo
, infoExpr
, typeExpr
, listModules
, listLanguages
, listFlags
, lintSyntax
-- * Converting the 'Ghc' monad to the 'IO' monad
, withGHC , withGHC
, withGHCDummyFile
-- * 'Ghc' utilities
, browse
, check
, debug
, info
, typeOf
, list
) where ) where
import Language.Haskell.GhcMod.Browse import Language.Haskell.GhcMod.Browse

View File

@ -17,8 +17,8 @@ import Var
---------------------------------------------------------------- ----------------------------------------------------------------
browseModule :: Options -> String -> Ghc String browseModule :: Options -> String -> IO String
browseModule opt mdlName = convert opt . format <$> browse opt mdlName browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt mdlName)
where where
format format
| operators opt = formatOps | operators opt = formatOps

View File

@ -12,12 +12,12 @@ import Prelude
---------------------------------------------------------------- ----------------------------------------------------------------
checkSyntax :: Options -> Cradle -> String -> Ghc String checkSyntax :: Options -> Cradle -> FilePath -> IO String
checkSyntax opt cradle file = unlines <$> check opt cradle file checkSyntax opt cradle file = unlines <$> withGHC file (check opt cradle file)
---------------------------------------------------------------- ----------------------------------------------------------------
check :: Options -> Cradle -> String -> Ghc [String] check :: Options -> Cradle -> FilePath -> Ghc [String]
check opt cradle fileName = checkIt `gcatch` handleErrMsg check opt cradle fileName = checkIt `gcatch` handleErrMsg
where where
checkIt = do checkIt = do

View File

@ -14,10 +14,10 @@ import Prelude
---------------------------------------------------------------- ----------------------------------------------------------------
debugInfo :: Options -> Cradle -> String -> String -> Ghc String debugInfo :: Options -> Cradle -> String -> FilePath -> IO String
debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName debugInfo opt cradle ver fileName = unlines <$> withGHC fileName (debug opt cradle ver fileName)
debug :: Options -> Cradle -> String -> String -> Ghc [String] debug :: Options -> Cradle -> String -> FilePath -> Ghc [String]
debug opt cradle ver fileName = do debug opt cradle ver fileName = do
(gopts, incDir, pkgs) <- (gopts, incDir, pkgs) <-
if cabal then if cabal then

View File

@ -36,8 +36,8 @@ data Cmd = Info | Type deriving Eq
---------------------------------------------------------------- ----------------------------------------------------------------
infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> Ghc String infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String
infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr infoExpr opt cradle modstr expr file = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr)
info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String
info opt cradle fileName modstr expr = info opt cradle fileName modstr expr =
@ -67,8 +67,8 @@ instance HasType (LHsBind Id) where
instance HasType (LPat Id) where instance HasType (LPat Id) where
getType _ (L spn pat) = return $ Just (spn, hsPatType pat) getType _ (L spn pat) = return $ Just (spn, hsPatType pat)
typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> Ghc String typeExpr :: Options -> Cradle -> ModuleString -> Int -> Int -> FilePath -> IO String
typeExpr opt cradle modstr lineNo colNo file = typeOf opt cradle file modstr lineNo colNo 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 :: Options -> Cradle -> FilePath -> ModuleString -> Int -> Int -> Ghc String
typeOf opt cradle fileName modstr lineNo colNo = typeOf opt cradle fileName modstr lineNo colNo =

View File

@ -10,8 +10,8 @@ import UniqFM
---------------------------------------------------------------- ----------------------------------------------------------------
listModules :: Options -> Ghc String listModules :: Options -> IO String
listModules opt = convert opt . nub . sort <$> list opt listModules opt = convert opt . nub . sort <$> withGHCDummyFile (list opt)
list :: Options -> Ghc [String] list :: Options -> Ghc [String]
list opt = do list opt = do

View File

@ -91,21 +91,21 @@ main = flip catches handlers $ do
cmdArg3 = cmdArg !. 3 cmdArg3 = cmdArg !. 3
cmdArg4 = cmdArg !. 4 cmdArg4 = cmdArg !. 4
res <- case cmdArg0 of res <- case cmdArg0 of
"browse" -> withGHCDummyFile $ concat <$> mapM (browseModule opt) (tail cmdArg) "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg)
"list" -> withGHCDummyFile $ listModules opt "list" -> listModules opt
"check" -> withGHCFile (checkSyntax opt cradle) cmdArg1 "check" -> checkSyntax opt cradle cmdArg1
"expand" -> withGHCFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1 "expand" -> checkSyntax opt { expandSplice = True } cradle cmdArg1
"debug" -> withGHCFile (debugInfo opt cradle strVer) cmdArg1 "debug" -> debugInfo opt cradle strVer cmdArg1
"type" -> withGHCFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1 "type" -> typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4) cmdArg1
"info" -> withGHCFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1 "info" -> infoExpr opt cradle cmdArg2 cmdArg3 cmdArg1
"lint" -> withFile (lintSyntax opt) cmdArg1 "lint" -> withFile (lintSyntax opt) cmdArg1
"lang" -> listLanguages opt "lang" -> listLanguages opt
"flag" -> listFlags opt "flag" -> listFlags opt
"boot" -> do "boot" -> do
mods <- withGHCDummyFile $ listModules opt mods <- listModules opt
langs <- listLanguages opt langs <- listLanguages opt
flags <- listFlags opt flags <- listFlags opt
pre <- withGHCDummyFile $ concat <$> mapM (browseModule opt) preBrowsedModules pre <- concat <$> mapM (browseModule opt) preBrowsedModules
return $ mods ++ langs ++ flags ++ pre return $ mods ++ langs ++ flags ++ pre
cmd -> throw (NoSuchCommand cmd) cmd -> throw (NoSuchCommand cmd)
putStr res putStr res
@ -130,7 +130,6 @@ main = flip catches handlers $ do
if exist if exist
then cmd file then cmd file
else throw (FileNotExist file) else throw (FileNotExist file)
withGHCFile cmd = withFile (\f -> withGHC f (cmd f))
xs !. idx xs !. idx
| length xs <= idx = throw SafeList | length xs <= idx = throw SafeList
| otherwise = xs !! idx | otherwise = xs !! idx

View File

@ -1,10 +1,9 @@
module BrowseSpec where module BrowseSpec where
import Control.Applicative import Control.Applicative
import Test.Hspec
import Browse
import Expectation import Expectation
import Types import Language.Haskell.GhcMod
import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,8 +1,8 @@
module CabalApiSpec where module CabalApiSpec where
import Control.Applicative import Control.Applicative
import Language.Haskell.GhcMod.CabalApi
import Test.Hspec import Test.Hspec
import CabalApi
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,13 +1,10 @@
module CheckSpec where module CheckSpec where
import CabalApi
import Check
import Cradle
import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
import Expectation import Expectation
import Test.Hspec import Language.Haskell.GhcMod
import Types
import System.FilePath import System.FilePath
import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,13 +1,12 @@
module CradleSpec where module CradleSpec where
import Control.Applicative import Control.Applicative
import Cradle
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Expectation import Expectation
import Language.Haskell.GhcMod
import System.Directory (canonicalizePath)
import System.FilePath (addTrailingPathSeparator, (</>)) import System.FilePath (addTrailingPathSeparator, (</>))
import Test.Hspec import Test.Hspec
import Types
import System.Directory (canonicalizePath)
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,18 +1,15 @@
module DebugSpec where module DebugSpec where
import CabalApi
import Cradle
import Debug
import Expectation import Expectation
import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import Types
checkFast :: String -> String -> IO () checkFast :: String -> String -> IO ()
checkFast file ans = withDirectory_ "test/data" $ do checkFast file ans = withDirectory_ "test/data" $ do
(strVer,_) <- getGHCVersion (strVer,_) <- getGHCVersion
cradle <- findCradle Nothing strVer cradle <- findCradle Nothing strVer
res <- debug defaultOptions cradle strVer file res <- debugInfo defaultOptions cradle strVer file
res `shouldContain` ans lines res `shouldContain` ans
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,10 +1,9 @@
module FlagSpec where module FlagSpec where
import Control.Applicative import Control.Applicative
import Test.Hspec
import Expectation import Expectation
import Flag import Language.Haskell.GhcMod
import Types import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,14 +1,11 @@
module InfoSpec where module InfoSpec where
import CabalApi
import Cradle
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Expectation import Expectation
import Info import Language.Haskell.GhcMod
import Test.Hspec
import Types
import System.Process
import System.Exit import System.Exit
import System.Process
import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,10 +1,9 @@
module LangSpec where module LangSpec where
import Control.Applicative import Control.Applicative
import Test.Hspec
import Expectation import Expectation
import Lang import Language.Haskell.GhcMod
import Types import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,8 +1,7 @@
module LintSpec where module LintSpec where
import Language.Haskell.GhcMod
import Test.Hspec import Test.Hspec
import Lint
import Types
spec :: Spec spec :: Spec
spec = do spec = do

View File

@ -1,10 +1,9 @@
module ListSpec where module ListSpec where
import Control.Applicative import Control.Applicative
import Test.Hspec
import Expectation import Expectation
import List import Language.Haskell.GhcMod
import Types import Test.Hspec
spec :: Spec spec :: Spec
spec = do spec = do