From 849c308e5c9722f5dba7051493bfcd127024175c Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 20 May 2013 11:29:44 +0900 Subject: [PATCH] Separating IO and Ghc. --- Language/Haskell/GhcMod.hs | 43 +++++++++++++++++++------------ Language/Haskell/GhcMod/Browse.hs | 4 +-- Language/Haskell/GhcMod/Check.hs | 6 ++--- Language/Haskell/GhcMod/Debug.hs | 6 ++--- Language/Haskell/GhcMod/Info.hs | 8 +++--- Language/Haskell/GhcMod/List.hs | 4 +-- src/GHCMod.hs | 19 +++++++------- test/BrowseSpec.hs | 5 ++-- test/CabalApiSpec.hs | 2 +- test/CheckSpec.hs | 7 ++--- test/CradleSpec.hs | 5 ++-- test/DebugSpec.hs | 9 +++---- test/FlagSpec.hs | 5 ++-- test/InfoSpec.hs | 9 +++---- test/LangSpec.hs | 5 ++-- test/LintSpec.hs | 3 +-- test/ListSpec.hs | 5 ++-- 17 files changed, 70 insertions(+), 75 deletions(-) diff --git a/Language/Haskell/GhcMod.hs b/Language/Haskell/GhcMod.hs index 0344ec7..27ed0f1 100644 --- a/Language/Haskell/GhcMod.hs +++ b/Language/Haskell/GhcMod.hs @@ -1,22 +1,33 @@ module Language.Haskell.GhcMod ( - browseModule - , checkSyntax - , check - , module Language.Haskell.GhcMod.Cradle - , debugInfo - , debug - , infoExpr - , info - , typeExpr - , typeOf - , listLanguages - , lintSyntax - , listModules - , module Language.Haskell.GhcMod.Types - , listFlags + -- * Cradle + Cradle(..) + , findCradle + -- * GHC version , 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 + , withGHCDummyFile + -- * 'Ghc' utilities + , browse + , check + , debug + , info + , typeOf + , list ) where import Language.Haskell.GhcMod.Browse diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 69f921c..f0871df 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -17,8 +17,8 @@ import Var ---------------------------------------------------------------- -browseModule :: Options -> String -> Ghc String -browseModule opt mdlName = convert opt . format <$> browse opt mdlName +browseModule :: Options -> String -> IO String +browseModule opt mdlName = convert opt . format <$> withGHCDummyFile (browse opt mdlName) where format | operators opt = formatOps diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index ff07f3f..860f1db 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -12,12 +12,12 @@ import Prelude ---------------------------------------------------------------- -checkSyntax :: Options -> Cradle -> String -> Ghc String -checkSyntax opt cradle file = unlines <$> check opt cradle file +checkSyntax :: Options -> Cradle -> FilePath -> IO String +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 where checkIt = do diff --git a/Language/Haskell/GhcMod/Debug.hs b/Language/Haskell/GhcMod/Debug.hs index ba4cb5d..c4407b4 100644 --- a/Language/Haskell/GhcMod/Debug.hs +++ b/Language/Haskell/GhcMod/Debug.hs @@ -14,10 +14,10 @@ import Prelude ---------------------------------------------------------------- -debugInfo :: Options -> Cradle -> String -> String -> Ghc String -debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName +debugInfo :: Options -> Cradle -> String -> FilePath -> IO String +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 (gopts, incDir, pkgs) <- if cabal then diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 3ea98c8..794cdaf 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -36,8 +36,8 @@ data Cmd = Info | Type deriving Eq ---------------------------------------------------------------- -infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> Ghc String -infoExpr opt cradle modstr expr file = (++ "\n") <$> info opt cradle file modstr expr +infoExpr :: Options -> Cradle -> ModuleString -> Expression -> FilePath -> IO String +infoExpr opt cradle modstr expr file = (++ "\n") <$> withGHCDummyFile (info opt cradle file modstr expr) info :: Options -> Cradle -> FilePath -> ModuleString -> Expression -> Ghc String info opt cradle fileName modstr expr = @@ -67,8 +67,8 @@ 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 -> Ghc String -typeExpr opt cradle modstr lineNo colNo file = typeOf opt cradle file modstr lineNo colNo +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 = diff --git a/Language/Haskell/GhcMod/List.hs b/Language/Haskell/GhcMod/List.hs index 07a7f69..e59690f 100644 --- a/Language/Haskell/GhcMod/List.hs +++ b/Language/Haskell/GhcMod/List.hs @@ -10,8 +10,8 @@ import UniqFM ---------------------------------------------------------------- -listModules :: Options -> Ghc String -listModules opt = convert opt . nub . sort <$> list opt +listModules :: Options -> IO String +listModules opt = convert opt . nub . sort <$> withGHCDummyFile (list opt) list :: Options -> Ghc [String] list opt = do diff --git a/src/GHCMod.hs b/src/GHCMod.hs index 2da0c45..d6f147c 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -91,21 +91,21 @@ main = flip catches handlers $ do cmdArg3 = cmdArg !. 3 cmdArg4 = cmdArg !. 4 res <- case cmdArg0 of - "browse" -> withGHCDummyFile $ concat <$> mapM (browseModule opt) (tail cmdArg) - "list" -> withGHCDummyFile $ listModules opt - "check" -> withGHCFile (checkSyntax opt cradle) cmdArg1 - "expand" -> withGHCFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1 - "debug" -> withGHCFile (debugInfo opt cradle strVer) cmdArg1 - "type" -> withGHCFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1 - "info" -> withGHCFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1 + "browse" -> concat <$> mapM (browseModule opt) (tail cmdArg) + "list" -> listModules opt + "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 "lint" -> withFile (lintSyntax opt) cmdArg1 "lang" -> listLanguages opt "flag" -> listFlags opt "boot" -> do - mods <- withGHCDummyFile $ listModules opt + mods <- listModules opt langs <- listLanguages opt flags <- listFlags opt - pre <- withGHCDummyFile $ concat <$> mapM (browseModule opt) preBrowsedModules + pre <- concat <$> mapM (browseModule opt) preBrowsedModules return $ mods ++ langs ++ flags ++ pre cmd -> throw (NoSuchCommand cmd) putStr res @@ -130,7 +130,6 @@ main = flip catches handlers $ do if exist then cmd file else throw (FileNotExist file) - withGHCFile cmd = withFile (\f -> withGHC f (cmd f)) xs !. idx | length xs <= idx = throw SafeList | otherwise = xs !! idx diff --git a/test/BrowseSpec.hs b/test/BrowseSpec.hs index 26c1394..5e790a1 100644 --- a/test/BrowseSpec.hs +++ b/test/BrowseSpec.hs @@ -1,10 +1,9 @@ module BrowseSpec where import Control.Applicative -import Test.Hspec -import Browse import Expectation -import Types +import Language.Haskell.GhcMod +import Test.Hspec spec :: Spec spec = do diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs index 5830615..b3a2f7c 100644 --- a/test/CabalApiSpec.hs +++ b/test/CabalApiSpec.hs @@ -1,8 +1,8 @@ module CabalApiSpec where import Control.Applicative +import Language.Haskell.GhcMod.CabalApi import Test.Hspec -import CabalApi spec :: Spec spec = do diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs index c27cee5..b0aeb17 100644 --- a/test/CheckSpec.hs +++ b/test/CheckSpec.hs @@ -1,13 +1,10 @@ module CheckSpec where -import CabalApi -import Check -import Cradle import Data.List (isSuffixOf, isInfixOf, isPrefixOf) import Expectation -import Test.Hspec -import Types +import Language.Haskell.GhcMod import System.FilePath +import Test.Hspec spec :: Spec spec = do diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index 325e4ac..647d576 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -1,13 +1,12 @@ module CradleSpec where import Control.Applicative -import Cradle import Data.List (isPrefixOf) import Expectation +import Language.Haskell.GhcMod +import System.Directory (canonicalizePath) import System.FilePath (addTrailingPathSeparator, ()) import Test.Hspec -import Types -import System.Directory (canonicalizePath) spec :: Spec spec = do diff --git a/test/DebugSpec.hs b/test/DebugSpec.hs index e348087..558a35d 100644 --- a/test/DebugSpec.hs +++ b/test/DebugSpec.hs @@ -1,18 +1,15 @@ module DebugSpec where -import CabalApi -import Cradle -import Debug import Expectation +import Language.Haskell.GhcMod import Test.Hspec -import Types checkFast :: String -> String -> IO () checkFast file ans = withDirectory_ "test/data" $ do (strVer,_) <- getGHCVersion cradle <- findCradle Nothing strVer - res <- debug defaultOptions cradle strVer file - res `shouldContain` ans + res <- debugInfo defaultOptions cradle strVer file + lines res `shouldContain` ans spec :: Spec spec = do diff --git a/test/FlagSpec.hs b/test/FlagSpec.hs index 1da9090..2277ab6 100644 --- a/test/FlagSpec.hs +++ b/test/FlagSpec.hs @@ -1,10 +1,9 @@ module FlagSpec where import Control.Applicative -import Test.Hspec import Expectation -import Flag -import Types +import Language.Haskell.GhcMod +import Test.Hspec spec :: Spec spec = do diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs index 4f663e2..477b5da 100644 --- a/test/InfoSpec.hs +++ b/test/InfoSpec.hs @@ -1,14 +1,11 @@ module InfoSpec where -import CabalApi -import Cradle import Data.List (isPrefixOf) import Expectation -import Info -import Test.Hspec -import Types -import System.Process +import Language.Haskell.GhcMod import System.Exit +import System.Process +import Test.Hspec spec :: Spec spec = do diff --git a/test/LangSpec.hs b/test/LangSpec.hs index c26eff1..f428ee0 100644 --- a/test/LangSpec.hs +++ b/test/LangSpec.hs @@ -1,10 +1,9 @@ module LangSpec where import Control.Applicative -import Test.Hspec import Expectation -import Lang -import Types +import Language.Haskell.GhcMod +import Test.Hspec spec :: Spec spec = do diff --git a/test/LintSpec.hs b/test/LintSpec.hs index e4eaebb..e333f5d 100644 --- a/test/LintSpec.hs +++ b/test/LintSpec.hs @@ -1,8 +1,7 @@ module LintSpec where +import Language.Haskell.GhcMod import Test.Hspec -import Lint -import Types spec :: Spec spec = do diff --git a/test/ListSpec.hs b/test/ListSpec.hs index ff9cce9..22fc2d9 100644 --- a/test/ListSpec.hs +++ b/test/ListSpec.hs @@ -1,10 +1,9 @@ module ListSpec where import Control.Applicative -import Test.Hspec import Expectation -import List -import Types +import Language.Haskell.GhcMod +import Test.Hspec spec :: Spec spec = do