diff --git a/Language/Haskell/GhcMod/Boot.hs b/Language/Haskell/GhcMod/Boot.hs index 70c77b6..c0abae5 100644 --- a/Language/Haskell/GhcMod/Boot.hs +++ b/Language/Haskell/GhcMod/Boot.hs @@ -1,6 +1,7 @@ module Language.Haskell.GhcMod.Boot where import Control.Applicative +import Prelude import Language.Haskell.GhcMod.Browse import Language.Haskell.GhcMod.Flag import Language.Haskell.GhcMod.Lang diff --git a/Language/Haskell/GhcMod/Browse.hs b/Language/Haskell/GhcMod/Browse.hs index 19a4b02..6093c9e 100644 --- a/Language/Haskell/GhcMod/Browse.hs +++ b/Language/Haskell/GhcMod/Browse.hs @@ -2,7 +2,7 @@ module Language.Haskell.GhcMod.Browse ( browse ) where -import Control.Applicative ((<$>)) +import Control.Applicative import Control.Exception (SomeException(..)) import Data.Char import Data.List @@ -20,6 +20,7 @@ import Outputable import TyCon (isAlgTyCon) import Type (dropForAlls, splitFunTy_maybe, mkFunTy, isPredTy) import Exception (ExceptionMonad, ghandle) +import Prelude ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/CabalHelper.hs b/Language/Haskell/GhcMod/CabalHelper.hs index 53b6007..735a62e 100644 --- a/Language/Haskell/GhcMod/CabalHelper.hs +++ b/Language/Haskell/GhcMod/CabalHelper.hs @@ -34,6 +34,7 @@ import Language.Haskell.GhcMod.Utils import Language.Haskell.GhcMod.World import Language.Haskell.GhcMod.PathsAndFiles import System.FilePath +import Prelude import Paths_ghc_mod as GhcMod @@ -61,7 +62,7 @@ helperProgs opts = Programs { -- The Component\'s 'gmcHomeModuleGraph' will be empty and has to be resolved by -- 'resolveGmComponents'. getComponents :: (Applicative m, MonadIO m, GmEnv m, GmLog m) - => m [GmComponent GMCRaw ChEntrypoint] + => m [GmComponent 'GMCRaw ChEntrypoint] getComponents = chCached cabalHelperCache chCached :: (Applicative m, MonadIO m, GmEnv m, GmLog m, Serialize a) @@ -83,7 +84,7 @@ chCached c = do cabalHelperCache :: (Functor m, Applicative m, MonadIO m) - => Cached m (Programs, FilePath, (Version, String)) [GmComponent GMCRaw ChEntrypoint] + => Cached m (Programs, FilePath, (Version, String)) [GmComponent 'GMCRaw ChEntrypoint] cabalHelperCache = Cached { cacheFile = cabalHelperCacheFile, cachedAction = \ _ (progs, root, _) _ -> diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index 5820bf0..f4bd658 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -5,7 +5,8 @@ module Language.Haskell.GhcMod.Check ( , expand ) where -import Control.Applicative ((<$>)) +import Control.Applicative +import Prelude import Language.Haskell.GhcMod.DynFlags import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Logger diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index a679aa0..2715696 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -5,7 +5,8 @@ module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFoun import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Types -import Control.Applicative ((<$>)) +import Control.Applicative +import Prelude type Builder = String -> String diff --git a/Language/Haskell/GhcMod/Cradle.hs b/Language/Haskell/GhcMod/Cradle.hs index c9438c4..d409ce7 100644 --- a/Language/Haskell/GhcMod/Cradle.hs +++ b/Language/Haskell/GhcMod/Cradle.hs @@ -16,6 +16,7 @@ import Control.Monad.Trans.Maybe import Data.Maybe import System.Directory import System.FilePath +import Prelude ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/DynFlags.hs b/Language/Haskell/GhcMod/DynFlags.hs index 2c8ee53..f1950f7 100644 --- a/Language/Haskell/GhcMod/DynFlags.hs +++ b/Language/Haskell/GhcMod/DynFlags.hs @@ -2,7 +2,7 @@ module Language.Haskell.GhcMod.DynFlags where -import Control.Applicative ((<$>)) +import Control.Applicative import Control.Monad (void) import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..)) import qualified GHC as G @@ -11,6 +11,7 @@ import GhcMonad import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types import System.IO.Unsafe (unsafePerformIO) +import Prelude setEmptyLogger :: DynFlags -> DynFlags setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return () diff --git a/Language/Haskell/GhcMod/Find.hs b/Language/Haskell/GhcMod/Find.hs index aee450c..11228f5 100644 --- a/Language/Haskell/GhcMod/Find.hs +++ b/Language/Haskell/GhcMod/Find.hs @@ -14,7 +14,7 @@ module Language.Haskell.GhcMod.Find #endif where -import Control.Applicative ((<$>)) +import Control.Applicative import Control.Monad (when, void, (<=<)) import Data.Function (on) import Data.List (groupBy, sort) @@ -31,6 +31,7 @@ import Module (moduleName) import System.Directory (doesFileExist, getModificationTime) import System.FilePath (()) import System.IO +import Prelude import Data.Map (Map) import qualified Data.Map as M diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs index 4719185..9ca8cd9 100644 --- a/Language/Haskell/GhcMod/Gap.hs +++ b/Language/Haskell/GhcMod/Gap.hs @@ -49,7 +49,7 @@ import CoreSyn (CoreExpr) import Data.List (intersperse) import Data.Maybe (catMaybes) import Data.Time.Clock (UTCTime) -import Data.Traversable (traverse) +import Data.Traversable import DataCon (dataConRepType) import Desugar (deSugarExpr) import DynFlags @@ -104,6 +104,7 @@ import SrcLoc import Packages import Language.Haskell.GhcMod.Types (Expression(..)) +import Prelude ---------------------------------------------------------------- ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/GhcPkg.hs b/Language/Haskell/GhcMod/GhcPkg.hs index 7eaa2ed..3114916 100644 --- a/Language/Haskell/GhcMod/GhcPkg.hs +++ b/Language/Haskell/GhcMod/GhcPkg.hs @@ -8,13 +8,14 @@ module Language.Haskell.GhcMod.GhcPkg ( ) where import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt) -import Control.Applicative ((<$>)) +import Control.Applicative import Data.List.Split (splitOn) import Data.Maybe import Exception (handleIO) import Language.Haskell.GhcMod.Types import System.Directory (doesDirectoryExist, getAppUserDataDirectory) import System.FilePath (()) +import Prelude ghcVersion :: Int ghcVersion = read cProjectVersionInt diff --git a/Language/Haskell/GhcMod/HomeModuleGraph.hs b/Language/Haskell/GhcMod/HomeModuleGraph.hs index 3b382a0..d10f483 100644 --- a/Language/Haskell/GhcMod/HomeModuleGraph.hs +++ b/Language/Haskell/GhcMod/HomeModuleGraph.hs @@ -41,19 +41,20 @@ import GHC import HscTypes import Control.Arrow ((&&&)) -import Control.Applicative ((<$>)) +import Control.Applicative import Control.Monad import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Control.Monad.State.Strict (execStateT) import Control.Monad.State.Class import Data.Maybe -import Data.Monoid +import Data.Monoid as Monoid import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import System.FilePath import System.Directory +import Prelude import Language.Haskell.GhcMod.Logging import Language.Haskell.GhcMod.Logger @@ -220,7 +221,7 @@ updateHomeModuleGraph' env smp0 = do Left errs -> do -- TODO: Remember these and present them as proper errors if this is -- the file the user is looking at. - gmLog GmWarning ("preprocess " ++ show fn) $ empty $+$ (vcat $ map text errs) + gmLog GmWarning ("preprocess " ++ show fn) $ Monoid.mempty $+$ (vcat $ map text errs) return Nothing imports :: ModulePath -> String -> DynFlags -> MaybeT m (Set ModulePath) diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 6344a5d..be32635 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -10,6 +10,7 @@ import Data.Maybe (catMaybes) import System.FilePath import Exception (ghandle, SomeException(..)) import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type) +import Prelude import qualified GHC as G import qualified Language.Haskell.GhcMod.Gap as Gap diff --git a/Language/Haskell/GhcMod/Logger.hs b/Language/Haskell/GhcMod/Logger.hs index 2d97580..3fbd436 100644 --- a/Language/Haskell/GhcMod/Logger.hs +++ b/Language/Haskell/GhcMod/Logger.hs @@ -7,7 +7,7 @@ module Language.Haskell.GhcMod.Logger ( ) where import Control.Arrow -import Control.Applicative ((<$>)) +import Control.Applicative import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) @@ -27,6 +27,7 @@ import Language.Haskell.GhcMod.DynFlags (withDynFlags) import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Error import qualified Language.Haskell.GhcMod.Gap as Gap +import Prelude type Builder = [String] -> [String] diff --git a/Language/Haskell/GhcMod/Logging.hs b/Language/Haskell/GhcMod/Logging.hs index 019c12b..b6052c2 100644 --- a/Language/Haskell/GhcMod/Logging.hs +++ b/Language/Haskell/GhcMod/Logging.hs @@ -32,6 +32,7 @@ import Data.Char import Data.Monoid (mempty, mappend, mconcat, (<>)) import System.IO import Text.PrettyPrint hiding (style, (<>)) +import Prelude import Language.Haskell.GhcMod.Monad.Types import Language.Haskell.GhcMod.Pretty diff --git a/Language/Haskell/GhcMod/Monad.hs b/Language/Haskell/GhcMod/Monad.hs index 8f89f1c..0d74b5d 100644 --- a/Language/Haskell/GhcMod/Monad.hs +++ b/Language/Haskell/GhcMod/Monad.hs @@ -46,6 +46,7 @@ import Control.Monad.Trans.Journal (runJournalT) import Exception (ExceptionMonad(..)) import System.Directory +import Prelude withCradle :: IOish m => FilePath -> (Cradle -> m a) -> m a withCradle cradledir f = diff --git a/Language/Haskell/GhcMod/Monad/Types.hs b/Language/Haskell/GhcMod/Monad/Types.hs index b2ec57b..88519b3 100644 --- a/Language/Haskell/GhcMod/Monad/Types.hs +++ b/Language/Haskell/GhcMod/Monad/Types.hs @@ -71,7 +71,7 @@ import DynFlags import Exception import HscTypes -import Control.Applicative (Applicative, Alternative, (<$>)) +import Control.Applicative import Control.Monad import Control.Monad.Reader (ReaderT(..)) @@ -96,12 +96,13 @@ import Data.Monoid (Monoid) #endif import Data.Set (Set) -import Data.Map (Map, empty) +import Data.Map as Map (Map, empty) import Data.Maybe import Data.Monoid import Data.IORef import Distribution.Helper import Text.PrettyPrint (Doc) +import Prelude import qualified MonadUtils as GHC (MonadIO(..)) @@ -127,12 +128,12 @@ data GmGhcSession = GmGhcSession { data GhcModState = GhcModState { gmGhcSession :: !(Maybe GmGhcSession) - , gmComponents :: !(Map ChComponentName (GmComponent GMCResolved (Set ModulePath))) + , gmComponents :: !(Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath))) , gmCompilerMode :: !CompilerMode } defaultGhcModState :: GhcModState -defaultGhcModState = GhcModState Nothing empty Simple +defaultGhcModState = GhcModState Nothing Map.empty Simple data CompilerMode = Simple | Intelligent deriving (Eq,Show,Read) diff --git a/Language/Haskell/GhcMod/PathsAndFiles.hs b/Language/Haskell/GhcMod/PathsAndFiles.hs index 8c6c039..ebb5c4b 100644 --- a/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/Language/Haskell/GhcMod/PathsAndFiles.hs @@ -25,7 +25,7 @@ import Control.Monad import Data.List import Data.Char import Data.Maybe -import Data.Traversable (traverse) +import Data.Traversable import Distribution.Helper (buildPlatform) import System.Directory import System.FilePath @@ -36,6 +36,7 @@ import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Caching import qualified Language.Haskell.GhcMod.Utils as U import Utils (mightExist) +import Prelude -- | Guaranteed to be a path to a directory with no trailing slash. type DirPath = FilePath diff --git a/Language/Haskell/GhcMod/PkgDoc.hs b/Language/Haskell/GhcMod/PkgDoc.hs index 8497fcc..a83141f 100644 --- a/Language/Haskell/GhcMod/PkgDoc.hs +++ b/Language/Haskell/GhcMod/PkgDoc.hs @@ -5,7 +5,8 @@ import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Utils -import Control.Applicative ((<$>)) +import Control.Applicative +import Prelude -- | Obtaining the package name and the doc path of a module. pkgDoc :: IOish m => String -> GhcModT m String diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs index de398dd..0938f81 100644 --- a/Language/Haskell/GhcMod/SrcUtils.hs +++ b/Language/Haskell/GhcMod/SrcUtils.hs @@ -3,7 +3,7 @@ module Language.Haskell.GhcMod.SrcUtils where -import Control.Applicative ((<$>)) +import Control.Applicative import CoreUtils (exprType) import Data.Generics import Data.Maybe (fromMaybe) @@ -19,6 +19,7 @@ import qualified Language.Haskell.GhcMod.Gap as Gap import OccName (OccName) import Outputable (PprStyle) import TcHsSyn (hsPatType) +import Prelude ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/Target.hs b/Language/Haskell/GhcMod/Target.hs index eb3cac9..24e62e4 100644 --- a/Language/Haskell/GhcMod/Target.hs +++ b/Language/Haskell/GhcMod/Target.hs @@ -18,7 +18,7 @@ module Language.Haskell.GhcMod.Target where import Control.Arrow -import Control.Applicative (Applicative, (<$>)) +import Control.Applicative import Control.Monad.Reader (runReaderT) import GHC import GHC.Paths (libdir) @@ -27,7 +27,6 @@ import SysTools import DynFlags import HscMain import HscTypes -import Bag (bagToList) import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.Monad.Types @@ -37,22 +36,22 @@ import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Logger import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Utils import Data.Maybe -import Data.Monoid +import Data.Monoid as Monoid import Data.Either import Data.Foldable (foldrM) -import Data.Traversable (traverse) +import Data.Traversable import Data.IORef import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set import Distribution.Helper +import Prelude import System.Directory import System.FilePath @@ -196,8 +195,8 @@ targetGhcOptions crdl sefnmn = do return $ gmcGhcOpts $ fromJust $ Map.lookup cn mcs resolvedComponentsCache :: IOish m => Cached (GhcModT m) - [GmComponent GMCRaw (Set.Set ModulePath)] - (Map.Map ChComponentName (GmComponent GMCResolved (Set.Set ModulePath))) + [GmComponent 'GMCRaw (Set.Set ModulePath)] + (Map.Map ChComponentName (GmComponent 'GMCResolved (Set.Set ModulePath))) resolvedComponentsCache = Cached { cacheFile = resolvedComponentsCacheFile, cachedAction = \tcfs comps ma -> do @@ -278,8 +277,8 @@ sandboxOpts crdl = resolveGmComponent :: (IOish m, GmLog m, GmEnv m) => Maybe [CompilationUnit] -- ^ Updated modules - -> GmComponent GMCRaw (Set ModulePath) - -> m (GmComponent GMCResolved (Set ModulePath)) + -> GmComponent 'GMCRaw (Set ModulePath) + -> m (GmComponent 'GMCResolved (Set ModulePath)) resolveGmComponent mums c@GmComponent {..} = do withLightHscEnv ghcOpts $ \env -> do let srcDirs = if null gmcSourceDirs then [""] else gmcSourceDirs @@ -303,8 +302,8 @@ resolveGmComponent mums c@GmComponent {..} = do resolveEntrypoint :: (IOish m, GmLog m) => Cradle - -> GmComponent GMCRaw ChEntrypoint - -> m (GmComponent GMCRaw (Set ModulePath)) + -> GmComponent 'GMCRaw ChEntrypoint + -> m (GmComponent 'GMCRaw (Set ModulePath)) resolveEntrypoint Cradle {..} c@GmComponent {..} = do withLightHscEnv gmcGhcSrcOpts $ \env -> do let srcDirs = if null gmcSourceDirs then [""] else gmcSourceDirs @@ -347,7 +346,7 @@ resolveModule env srcDirs (Left fn') = do case emn of Left errs -> do gmLog GmWarning ("resolveModule " ++ show fn) $ - empty $+$ (vcat $ map text errs) + Monoid.mempty $+$ (vcat $ map text errs) return Nothing -- TODO: should expose these errors otherwise -- modules with preprocessor/parse errors are -- going to be missing @@ -368,8 +367,8 @@ type CompilationUnit = Either FilePath ModuleName resolveGmComponents :: (IOish m, GmState m, GmLog m, GmEnv m) => Maybe [CompilationUnit] -- ^ Updated modules - -> [GmComponent GMCRaw (Set ModulePath)] - -> m (Map ChComponentName (GmComponent GMCResolved (Set ModulePath))) + -> [GmComponent 'GMCRaw (Set ModulePath)] + -> m (Map ChComponentName (GmComponent 'GMCResolved (Set ModulePath))) resolveGmComponents mumns cs = do s <- gmsGet m' <- foldrM' (gmComponents s) cs $ \c m -> do diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index b33c01a..416c04c 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -31,6 +31,7 @@ import qualified MonadUtils as GHC (MonadIO(..)) import GHC (ModuleName, moduleNameString, mkModuleName) import PackageConfig (PackageConfig) import GHC.Generics +import Prelude -- | A constraint alias (-XConstraintKinds) to make functions dealing with -- 'GhcModT' somewhat cleaner. diff --git a/Language/Haskell/GhcMod/Utils.hs b/Language/Haskell/GhcMod/Utils.hs index a9a092b..e397ad0 100644 --- a/Language/Haskell/GhcMod/Utils.hs +++ b/Language/Haskell/GhcMod/Utils.hs @@ -39,6 +39,7 @@ import Text.Printf import Paths_ghc_mod (getLibexecDir) import Utils +import Prelude -- dropWhileEnd is not provided prior to base 4.5.0.0. dropWhileEnd :: (a -> Bool) -> [a] -> [a] diff --git a/Language/Haskell/GhcMod/World.hs b/Language/Haskell/GhcMod/World.hs index 41035f3..9f77a0c 100644 --- a/Language/Haskell/GhcMod/World.hs +++ b/Language/Haskell/GhcMod/World.hs @@ -5,12 +5,13 @@ import Language.Haskell.GhcMod.PathsAndFiles import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.Utils -import Control.Applicative ((<$>)) +import Control.Applicative import Data.Maybe -import Data.Traversable (traverse) +import Data.Traversable import System.FilePath (()) import GHC.Paths (libdir) +import Prelude data World = World { worldPackageCaches :: [TimedFile] diff --git a/Utils.hs b/Utils.hs index 7bfd18e..a4c1ff2 100644 --- a/Utils.hs +++ b/Utils.hs @@ -10,6 +10,8 @@ import Data.Time (UTCTime) #else import System.Time (ClockTime) #endif +import Prelude + #if MIN_VERSION_directory(1,2,0) type ModTime = UTCTime diff --git a/src/GHCMod.hs b/src/GHCMod.hs index ba9b79d..50be2b1 100644 --- a/src/GHCMod.hs +++ b/src/GHCMod.hs @@ -23,6 +23,7 @@ import System.Exit (exitFailure) import System.IO (hPutStrLn, stdout, stderr, hSetEncoding, utf8, hFlush) import System.Exit (exitSuccess) import Text.PrettyPrint +import Prelude import Misc diff --git a/src/Misc.hs b/src/Misc.hs index 2c646c6..6b6fbcf 100644 --- a/src/Misc.hs +++ b/src/Misc.hs @@ -13,12 +13,13 @@ module Misc ( , checkDb ) where -import Control.Applicative ((<$>)) +import Control.Applicative import Control.Concurrent.Async (Async, async, wait) import Control.Exception (Exception) import CoreMonad (liftIO) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Typeable (Typeable) +import Prelude import Language.Haskell.GhcMod import Language.Haskell.GhcMod.Internal