From f9680e6f33cf8b05a33019a29f3ce318cd921af4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Fri, 26 May 2017 21:27:47 +0200 Subject: [PATCH] Move exe specific types out of core --- GhcModExe/Boot.hs | 2 +- GhcModExe/Browse.hs | 17 ++++++++++++++++- GhcModExe/Find.hs | 23 ++++++++++++++++++++--- GhcModExe/Internal.hs | 1 - GhcModExe/Lint.hs | 10 ++++++++++ core/Language/Haskell/GhcMod/Types.hs | 26 -------------------------- core/Language/Haskell/GhcMod/Utils.hs | 26 -------------------------- src/GHCMod/Options/Commands.hs | 4 +++- test/BrowseSpec.hs | 1 + test/FileMappingSpec.hs | 1 + test/LintSpec.hs | 2 +- 11 files changed, 53 insertions(+), 60 deletions(-) diff --git a/GhcModExe/Boot.hs b/GhcModExe/Boot.hs index 35c43d326..0d4f41e48 100644 --- a/GhcModExe/Boot.hs +++ b/GhcModExe/Boot.hs @@ -8,7 +8,7 @@ import GhcModExe.Flag import GhcModExe.Lang import GhcModExe.Modules import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Types (defaultBrowseOpts) +import Language.Haskell.GhcMod.Types -- | Printing necessary information for front-end booting. boot :: IOish m => GhcModT m String diff --git a/GhcModExe/Browse.hs b/GhcModExe/Browse.hs index d09666b99..e754562a6 100644 --- a/GhcModExe/Browse.hs +++ b/GhcModExe/Browse.hs @@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-} module GhcModExe.Browse ( browse, - BrowseOpts(..) + BrowseOpts(..), + defaultBrowseOpts ) where import Safe @@ -167,3 +168,17 @@ removeForAlls' ty (Just (pre, ftype)) showOutputable :: Outputable a => DynFlags -> a -> String showOutputable dflag = unwords . lines . showPage dflag styleUnqualified . ppr + +data BrowseOpts = BrowseOpts { + optBrowseOperators :: Bool + -- ^ If 'True', operators are also returned. + , optBrowseDetailed :: Bool + -- ^ If 'True', types are also returned. + , optBrowseParents :: Bool + -- ^ If 'True', parents are also returned. + , optBrowseQualified :: Bool + -- ^ If 'True', will return fully qualified names + } deriving (Show) + +defaultBrowseOpts :: BrowseOpts +defaultBrowseOpts = BrowseOpts False False False False diff --git a/GhcModExe/Find.hs b/GhcModExe/Find.hs index 3e0a7fd04..90e55bac1 100644 --- a/GhcModExe/Find.hs +++ b/GhcModExe/Find.hs @@ -44,9 +44,6 @@ import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.IORef -import System.Directory.ModTime -import System.IO.Unsafe - import GHC.Generics (Generic) import Data.Map (Map) @@ -55,8 +52,14 @@ import Data.Set (Set) import qualified Data.Set as S import Language.Haskell.GhcMod.PathsAndFiles import System.Directory +import System.Directory.ModTime +import System.Environment +import System.FilePath +import System.IO.Unsafe import Prelude +import Paths_ghc_mod (getBinDir) + ---------------------------------------------------------------- -- | Type of function and operation names. @@ -125,6 +128,20 @@ loadSymbolDb = do out <- liftIO $ readProc ghcMod ["--verbose", "error", "dumpsym"] "" return $!! decode out +ghcModExecutable :: IO FilePath +ghcModExecutable = do + exe <- getExecutablePath + stack <- lookupEnv "STACK_EXE" + case takeBaseName exe of + "spec" | Just _ <- stack -> + ( "ghc-mod") <$> getBinDir + "spec" -> + ( "dist/build/ghc-mod-real/ghc-mod-real") <$> getCurrentDirectory + "ghc-mod-real" -> + return exe + _ -> + return $ takeDirectory exe "ghc-mod" + ---------------------------------------------------------------- -- used 'ghc-mod dumpsym' diff --git a/GhcModExe/Internal.hs b/GhcModExe/Internal.hs index d31069093..a1f0bb1d3 100644 --- a/GhcModExe/Internal.hs +++ b/GhcModExe/Internal.hs @@ -9,7 +9,6 @@ module GhcModExe.Internal ( , GmEnv(..) -- * Various Paths , ghcLibDir - , ghcModExecutable -- * Logging , withLogger , setNoWarningFlags diff --git a/GhcModExe/Lint.hs b/GhcModExe/Lint.hs index 12237a9fc..d74ca953b 100644 --- a/GhcModExe/Lint.hs +++ b/GhcModExe/Lint.hs @@ -28,3 +28,13 @@ lint opt file = ghandle handler $ | srcSpanFilename (ideaSpan idea) == temp = idea{ideaSpan=(ideaSpan idea){srcSpanFilename = orig}} substFile _ _ idea = idea + +-- | Options for "lintWith" function +data LintOpts = LintOpts { + optLintHlintOpts :: [String] + -- ^ options that will be passed to hlint executable + } deriving (Show) + +-- | Default "LintOpts" instance +defaultLintOpts :: LintOpts +defaultLintOpts = LintOpts [] diff --git a/core/Language/Haskell/GhcMod/Types.hs b/core/Language/Haskell/GhcMod/Types.hs index 4836abbbf..7b937d814 100644 --- a/core/Language/Haskell/GhcMod/Types.hs +++ b/core/Language/Haskell/GhcMod/Types.hs @@ -373,32 +373,6 @@ instance Binary ChEntrypoint where put = ggput . from get = to `fmap` ggget --- | Options for "lintWith" function -data LintOpts = LintOpts { - optLintHlintOpts :: [String] - -- ^ options that will be passed to hlint executable - } deriving (Show) - --- | Default "LintOpts" instance -defaultLintOpts :: LintOpts -defaultLintOpts = LintOpts [] - --- | Options for "browseWith" function -data BrowseOpts = BrowseOpts { - optBrowseOperators :: Bool - -- ^ If 'True', "browseWith" also returns operators. - , optBrowseDetailed :: Bool - -- ^ If 'True', "browseWith" also returns types. - , optBrowseParents :: Bool - -- ^ If 'True', "browseWith" also returns parents. - , optBrowseQualified :: Bool - -- ^ If 'True', "browseWith" will return fully qualified name - } deriving (Show) - --- | Default "BrowseOpts" instance -defaultBrowseOpts :: BrowseOpts -defaultBrowseOpts = BrowseOpts False False False False - mkLabel ''GhcModCaches mkLabel ''GhcModState mkLabel ''Options diff --git a/core/Language/Haskell/GhcMod/Utils.hs b/core/Language/Haskell/GhcMod/Utils.hs index c92375066..1edc36ace 100644 --- a/core/Language/Haskell/GhcMod/Utils.hs +++ b/core/Language/Haskell/GhcMod/Utils.hs @@ -34,13 +34,10 @@ import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Monad.Types import System.Directory -import System.Environment import System.FilePath import System.IO.Temp (createTempDirectory) import System.Process (readProcess) -import Text.Printf -import Paths_ghc_mod (getLibexecDir, getBinDir) import Utils import Prelude @@ -76,29 +73,6 @@ newTempDir _dir = whenM :: Monad m => m Bool -> m () -> m () whenM mb ma = mb >>= flip when ma --- | Returns the path to the currently running ghc-mod executable. With ghc<7.6 --- this is a guess but >=7.6 uses 'getExecutablePath'. -ghcModExecutable :: IO FilePath -ghcModExecutable = do - exe <- getExecutablePath' - stack <- lookupEnv "STACK_EXE" - case takeBaseName exe of - "spec" | Just _ <- stack -> - ( "ghc-mod") <$> getBinDir - "spec" -> - ( "dist/build/ghc-mod/ghc-mod") <$> getCurrentDirectory - "ghc-mod" -> - return exe - _ -> - return $ takeDirectory exe "ghc-mod" - -getExecutablePath' :: IO FilePath -#if __GLASGOW_HASKELL__ >= 706 -getExecutablePath' = getExecutablePath -#else -getExecutablePath' = getProgName -#endif - canonFilePath :: FilePath -> IO FilePath canonFilePath f = do p <- canonicalizePath f diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs index cc9f64f79..6269d3599 100644 --- a/src/GHCMod/Options/Commands.hs +++ b/src/GHCMod/Options/Commands.hs @@ -22,11 +22,13 @@ import Data.Semigroup import Options.Applicative import Options.Applicative.Types import Options.Applicative.Builder.Internal -import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Read import Language.Haskell.GhcMod.Options.DocUtils import Language.Haskell.GhcMod.Options.Help +import GhcModExe.Lint +import GhcModExe.Browse + type Symbol = String type Expr = String type Module = String diff --git a/test/BrowseSpec.hs b/test/BrowseSpec.hs index dfd320e62..cc9d13819 100644 --- a/test/BrowseSpec.hs +++ b/test/BrowseSpec.hs @@ -2,6 +2,7 @@ module BrowseSpec where import Control.Applicative import GhcMod +import GhcModExe.Browse import Test.Hspec import Prelude diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index 5b50e6c2b..0e5e614a1 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -10,6 +10,7 @@ import System.IO.Temp import System.Directory import GhcMod +import GhcModExe.Lint spec :: Spec spec = do diff --git a/test/LintSpec.hs b/test/LintSpec.hs index b30055bfa..cfac205db 100644 --- a/test/LintSpec.hs +++ b/test/LintSpec.hs @@ -1,6 +1,6 @@ module LintSpec where -import GhcMod +import GhcModExe.Lint import Test.Hspec import TestUtils