Skip to content
This repository has been archived by the owner on Apr 25, 2020. It is now read-only.
Permalink

Comparing changes

This is a direct comparison between two commits made in this repository or its related repositories. View the default comparison for this range or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: DanielG/ghc-mod
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: f6e581a4d27588721ec7713b743830e723e9c91f
Choose a base ref
..
head repository: DanielG/ghc-mod
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: eceb7e2a7e8c7a9942d612e778711f7c9196b70c
Choose a head ref
2 changes: 1 addition & 1 deletion Language/Haskell/GhcMod/Boot.hs
Original file line number Diff line number Diff line change
@@ -12,7 +12,7 @@ import Language.Haskell.GhcMod.Modules
boot :: IOish m => GhcModT m String
boot = concat <$> sequence ms
where
ms = [modules, languages, flags, concat <$> mapM browse preBrowsedModules]
ms = [modules False, languages, flags, concat <$> mapM (browse (BrowseOpts False False False)) preBrowsedModules]

preBrowsedModules :: [String]
preBrowsedModules = [
32 changes: 15 additions & 17 deletions Language/Haskell/GhcMod/Browse.hs
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
module Language.Haskell.GhcMod.Browse (
browse
browse,
BrowseOpts(..)
) where

import Control.Applicative
@@ -13,8 +14,8 @@ import qualified GHC as G
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified)
import Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Logging
import Name (getOccString)
import Outputable
@@ -26,12 +27,11 @@ import Prelude
----------------------------------------------------------------

-- | 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 :: forall m. IOish m
=> String -- ^ A module name. (e.g. \"Data.List\", "base:Prelude")
-> GhcModT m String
browse pkgmdl = do
=> BrowseOpts -- ^ Configuration parameters
-> String -- ^ A module name. (e.g. \"Data.List\", "base:Prelude")
-> GhcModT m String
browse opts pkgmdl = do
convert' . sort =<< go
where
-- TODO: Add API to Gm.Target to check if module is home module without
@@ -43,13 +43,11 @@ browse pkgmdl = do
gmLog GmException "browse" $ showDoc ex

goPkgModule = do
opt <- options
runGmPkgGhc $
processExports opt =<< tryModuleInfo =<< G.findModule mdlname mpkgid
processExports opts =<< tryModuleInfo =<< G.findModule mdlname mpkgid

goHomeModule = runGmlT [Right mdlname] $ do
opt <- options
processExports opt =<< tryModuleInfo =<< G.findModule mdlname Nothing
processExports opts =<< tryModuleInfo =<< G.findModule mdlname Nothing

tryModuleInfo m = fromJust <$> G.getModuleInfo m

@@ -80,31 +78,31 @@ isNotOp (h:_) = isAlpha h || (h == '_')
isNotOp _ = error "isNotOp"

processExports :: (G.GhcMonad m, MonadIO m, ExceptionMonad m)
=> Options -> ModuleInfo -> m [String]
=> BrowseOpts -> ModuleInfo -> m [String]
processExports opt minfo = do
let
removeOps
| optOperators opt = id
| optBrowseOperators opt = id
| otherwise = filter (isNotOp . getOccString)
mapM (showExport opt minfo) $ removeOps $ G.modInfoExports minfo

showExport :: forall m. (G.GhcMonad m, MonadIO m, ExceptionMonad m)
=> Options -> ModuleInfo -> Name -> m String
=> BrowseOpts -> ModuleInfo -> Name -> m String
showExport opt minfo e = do
mtype' <- mtype
return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype']
where
mqualified = (G.moduleNameString (G.moduleName $ G.nameModule e) ++ ".") `justIf` optQualified opt
mqualified = (G.moduleNameString (G.moduleName $ G.nameModule e) ++ ".") `justIf` optBrowseQualified opt
mtype :: m (Maybe String)
mtype
| optDetailed opt = do
| optBrowseDetailed opt = do
tyInfo <- G.modInfoLookupName minfo e
-- If nothing found, load dependent module and lookup global
tyResult <- maybe (inOtherModule e) (return . Just) tyInfo
dflag <- G.getSessionDynFlags
return $ do
typeName <- tyResult >>= showThing dflag
(" :: " ++ typeName) `justIf` optDetailed opt
(" :: " ++ typeName) `justIf` optBrowseDetailed opt
| otherwise = return Nothing
formatOp nm
| null nm = error "formatOp"
26 changes: 20 additions & 6 deletions Language/Haskell/GhcMod/Cradle.hs
Original file line number Diff line number Diff line change
@@ -4,6 +4,7 @@ module Language.Haskell.GhcMod.Cradle
(
findCradle
, findCradle'
, findCradleNoLog
, findSpecCradle
, cleanupCradle
)
@@ -15,6 +16,8 @@ import Language.Haskell.GhcMod.Monad.Types
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils
import Language.Haskell.GhcMod.Stack
import Language.Haskell.GhcMod.Logging


import Control.Applicative
import Control.Monad
@@ -23,17 +26,22 @@ import Data.Maybe
import System.Directory
import System.FilePath
import Prelude
import Control.Monad.Trans.Journal (runJournalT)


----------------------------------------------------------------

-- | Finding 'Cradle'.
-- Find a cabal file by tracing ancestor directories.
-- Find a sandbox according to a cabal sandbox config
-- in a cabal directory.
findCradle :: (IOish m, GmOut m) => m Cradle
findCradle :: (GmLog m, IOish m, GmOut m) => m Cradle
findCradle = findCradle' =<< liftIO getCurrentDirectory

findCradle' :: (IOish m, GmOut m) => FilePath -> m Cradle
findCradleNoLog :: forall m. (IOish m, GmOut m) => m Cradle
findCradleNoLog = fst <$> (runJournalT findCradle :: m (Cradle, GhcModLog))

findCradle' :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
findCradle' dir = run $
msum [ stackCradle dir
, cabalCradle dir
@@ -42,7 +50,7 @@ findCradle' dir = run $
]
where run a = fillTempDir =<< (fromJust <$> runMaybeT a)

findSpecCradle :: (IOish m, GmOut m) => FilePath -> m Cradle
findSpecCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> m Cradle
findSpecCradle dir = do
let cfs = [stackCradleSpec, cabalCradle, sandboxCradle]
cs <- catMaybes <$> mapM (runMaybeT . ($ dir)) cfs
@@ -77,8 +85,12 @@ cabalCradle wdir = do
, cradleDistDir = "dist"
}

stackCradle :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradle :: (GmLog m, IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradle wdir = do
#if !MIN_VERSION_ghc(7,8,0)
-- GHC < 7.8 is not supported by stack
mzero
#endif
cabalFile <- MaybeT $ liftIO $ findCabalFile wdir

let cabalDir = takeDirectory cabalFile
@@ -87,7 +99,9 @@ stackCradle wdir = do

-- If dist/setup-config already exists the user probably wants to use cabal
-- rather than stack, or maybe that's just me ;)
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ mzero
whenM (liftIO $ doesFileExist $ setupConfigPath "dist") $ do
gmLog GmWarning "" $ text "'dist/setup-config' exists, ignoring Stack and using cabal-install instead."
mzero

senv <- MaybeT $ getStackEnv cabalDir

@@ -100,7 +114,7 @@ stackCradle wdir = do
, cradleDistDir = seDistDir senv
}

stackCradleSpec :: (IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradleSpec :: (GmLog m, IOish m, GmOut m) => FilePath -> MaybeT m Cradle
stackCradleSpec wdir = do
crdl <- stackCradle wdir
case crdl of
5 changes: 3 additions & 2 deletions Language/Haskell/GhcMod/Debug.hs
Original file line number Diff line number Diff line change
@@ -3,6 +3,7 @@ module Language.Haskell.GhcMod.Debug (debugInfo, rootInfo, componentInfo) where
import Control.Arrow (first)
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Journal
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char
@@ -138,5 +139,5 @@ mapDoc kd ad m = vcat $
----------------------------------------------------------------

-- | Obtaining root information.
rootInfo :: (IOish m, GmOut m) => m String
rootInfo = (++"\n") . cradleRootDir <$> findCradle
rootInfo :: forall m. (IOish m, GmOut m) => m String
rootInfo = (++"\n") . cradleRootDir <$> fst `liftM` (runJournalT findCradle :: m (Cradle, GhcModLog))
10 changes: 5 additions & 5 deletions Language/Haskell/GhcMod/Lint.hs
Original file line number Diff line number Diff line change
@@ -4,8 +4,8 @@ import Exception (ghandle)
import Control.Exception (SomeException(..))
import Language.Haskell.GhcMod.Logger (checkErrorPrefix)
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Monad
import Language.Haskell.HLint (hlint)

import Language.Haskell.GhcMod.Utils (withMappedFile)
@@ -15,12 +15,12 @@ import Data.List (stripPrefix)
-- | Checking syntax of a target file using hlint.
-- Warnings and errors are returned.
lint :: IOish m
=> FilePath -- ^ A target file.
=> LintOpts -- ^ Configuration parameters
-> FilePath -- ^ A target file.
-> GhcModT m String
lint file = do
opt <- options
lint opt file =
withMappedFile file $ \tempfile ->
liftIO (hlint $ tempfile : "--quiet" : optHlintOpts opt)
liftIO (hlint $ tempfile : "--quiet" : optLintHlintOpts opt)
>>= mapM (replaceFileName tempfile)
>>= ghandle handler . pack
where
11 changes: 11 additions & 0 deletions Language/Haskell/GhcMod/Logging.hs
Original file line number Diff line number Diff line change
@@ -45,6 +45,11 @@ gmSetLogLevel :: GmLog m => GmLogLevel -> m ()
gmSetLogLevel level =
gmlJournal $ GhcModLog (Just level) (Last Nothing) []

gmGetLogLevel :: forall m. GmLog m => m GmLogLevel
gmGetLogLevel = do
GhcModLog { gmLogLevel = Just level } <- gmlHistory
return level

gmSetDumpLevel :: GmLog m => Bool -> m ()
gmSetDumpLevel level =
gmlJournal $ GhcModLog Nothing (Last (Just level)) []
@@ -78,6 +83,12 @@ gmLog level loc' doc = do

gmlJournal (GhcModLog Nothing (Last Nothing) [(level, loc', msgDoc)])

-- | Appends a collection of logs to the logging environment, with effects
-- | if their log level specifies it should
gmAppendLog :: (MonadIO m, GmLog m, GmOut m) => GhcModLog -> m ()
gmAppendLog GhcModLog { gmLogMessages } = (\(level, loc, msgDoc) -> gmLog level loc msgDoc) `mapM_` gmLogMessages


gmVomit :: (MonadIO m, GmLog m, GmOut m, GmEnv m) => String -> Doc -> String -> m ()
gmVomit filename doc content = do
gmLog GmVomit "" $ doc <+>: text content
9 changes: 5 additions & 4 deletions Language/Haskell/GhcMod/Modules.hs
Original file line number Diff line number Diff line change
@@ -14,13 +14,14 @@ import qualified GHC as G
----------------------------------------------------------------

-- | Listing installed modules.
modules :: (IOish m, Gm m) => m String
modules = do
Options { optDetailed } <- options
modules :: (IOish m, Gm m)
=> Bool -- ^ 'detailed', if 'True', also prints packages that modules belong to.
-> m String
modules detailed = do
df <- runGmPkgGhc G.getSessionDynFlags
let mns = listVisibleModuleNames df
pmnss = map (first moduleNameString) $ zip mns (modulePkg df `map` mns)
convert' $ nub [ if optDetailed then pkg ++ " " ++ mn else mn
convert' $ nub [ if detailed then pkg ++ " " ++ mn else mn
| (mn, pkgs) <- pmnss, pkg <- pkgs ]
where
modulePkg df = lookupModulePackageInAllPackages df
18 changes: 10 additions & 8 deletions Language/Haskell/GhcMod/Monad.hs
Original file line number Diff line number Diff line change
@@ -52,17 +52,17 @@ import Exception
import System.Directory
import Prelude

withGhcModEnv :: (IOish m, GmOut m) => FilePath -> Options -> (GhcModEnv -> m a) -> m a
withGhcModEnv :: (IOish m, GmOut m) => FilePath -> Options -> ((GhcModEnv, GhcModLog) -> m a) -> m a
withGhcModEnv = withGhcModEnv' withCradle
where
withCradle dir =
gbracket (findCradle' dir) (liftIO . cleanupCradle)

withGhcModEnv' :: (IOish m, GmOut m) => (FilePath -> (Cradle -> m a) -> m a) -> FilePath -> Options -> (GhcModEnv -> m a) -> m a
gbracket (runJournalT $ findCradle' dir) (liftIO . cleanupCradle . fst)
withGhcModEnv' :: (IOish m, GmOut m) => (FilePath -> ((Cradle, GhcModLog) -> m a) -> m a) -> FilePath -> Options -> ((GhcModEnv, GhcModLog) -> m a) -> m a
withGhcModEnv' withCradle dir opts f =
withCradle dir $ \crdl ->
withCradle dir $ \(crdl,lg) ->
withCradleRootDir crdl $
f $ GhcModEnv opts crdl
f (GhcModEnv opts crdl, lg)
where
withCradleRootDir (cradleRootDir -> projdir) a = do
cdir <- liftIO $ getCurrentDirectory
@@ -97,9 +97,11 @@ runGhcModT :: IOish m
-> m (Either GhcModError a, GhcModLog)
runGhcModT opt action = liftIO (getCurrentDirectory >>= canonicalizePath) >>= \dir' -> do
runGmOutT opt $
withGhcModEnv dir' opt $ \env ->
withGhcModEnv dir' opt $ \(env,lg) ->
first (fst <$>) <$> runGhcModT' env defaultGhcModState
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >> action)
(gmSetLogLevel (ooptLogLevel $ optOutput opt) >>
gmAppendLog lg >>
action)

-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
-- computation. Note that if the computation that returned @result@ modified the
19 changes: 19 additions & 0 deletions Language/Haskell/GhcMod/Monad/Types.hs
Original file line number Diff line number Diff line change
@@ -322,6 +322,11 @@ instance (Monad m, GmLog m) => GmLog (StateT s m) where
gmlHistory = lift gmlHistory
gmlClear = lift gmlClear

instance (Monad m, GmLog m) => GmLog (MaybeT m) where
gmlJournal = lift . gmlJournal
gmlHistory = lift gmlHistory
gmlClear = lift gmlClear

-- GmOut -----------------------------------------
class Monad m => GmOut m where
gmoAsk :: m GhcModOut
@@ -338,6 +343,12 @@ instance GmOut m => GmOut (GmT m) where
instance GmOut m => GmOut (StateT s m) where
gmoAsk = lift gmoAsk

instance GmOut m => GmOut (JournalT w m) where
gmoAsk = lift gmoAsk

instance GmOut m => GmOut (MaybeT m) where
gmoAsk = lift gmoAsk

instance Monad m => MonadJournal GhcModLog (GmT m) where
journal !w = GmT $ lift $ lift $ (journal w)
history = GmT $ lift $ lift $ history
@@ -519,6 +530,14 @@ instance (MonadIO m, MonadBaseControl IO m) => ExceptionMonad (ReaderT s m) wher
gmask = liftBaseOp gmask . liftRestore
where liftRestore f r = f $ liftBaseOp_ r

instance (Monoid w, MonadIO m, MonadBaseControl IO m) => ExceptionMonad (JournalT w m) where
gcatch act handler = control $ \run ->
run act `gcatch` (run . handler)

gmask = liftBaseOp gmask . liftRestore
where liftRestore f r = f $ liftBaseOp_ r


----------------------------------------------------------------

options :: GmEnv m => m Options
2 changes: 1 addition & 1 deletion Language/Haskell/GhcMod/Target.hs
Original file line number Diff line number Diff line change
@@ -330,7 +330,7 @@ resolveEntrypoint Cradle {..} c@GmComponent {..} = do
rms <- resolveModule env srcDirs `mapM` eps
return c { gmcEntrypoints = Set.fromList $ catMaybes rms }

-- TODO: remember that he file from `main-is:` is always module `Main` and let
-- TODO: remember that the file from `main-is:` is always module `Main` and let
-- ghc do the warning about it. Right now we run that module through
-- resolveModule like any other
resolveChEntrypoints :: FilePath -> ChEntrypoint -> IO [CompilationUnit]
Loading