diff --git a/GhcMod.hs b/GhcMod.hs index 551e30b..8934759 100644 --- a/GhcMod.hs +++ b/GhcMod.hs @@ -69,24 +69,24 @@ module GhcMod ( , unloadMappedFile ) where -import GhcModExe.Boot -import GhcModExe.Browse -import GhcModExe.CaseSplit -import GhcModExe.Check -import GhcModExe.Debug -import GhcModExe.FillSig -import GhcModExe.Find -import GhcModExe.Flag -import GhcModExe.Info -import GhcModExe.Lang -import GhcModExe.Lint -import GhcModExe.Modules -import GhcModExe.PkgDoc -import GhcModExe.Test -import Language.Haskell.GhcMod.Cradle -import Language.Haskell.GhcMod.FileMapping -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Output -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.Types +import GhcMod.Exe.Boot +import GhcMod.Exe.Browse +import GhcMod.Exe.CaseSplit +import GhcMod.Exe.Check +import GhcMod.Exe.Debug +import GhcMod.Exe.FillSig +import GhcMod.Exe.Find +import GhcMod.Exe.Flag +import GhcMod.Exe.Info +import GhcMod.Exe.Lang +import GhcMod.Exe.Lint +import GhcMod.Exe.Modules +import GhcMod.Exe.PkgDoc +import GhcMod.Exe.Test +import GhcMod.Cradle +import GhcMod.FileMapping +import GhcMod.Logging +import GhcMod.Monad +import GhcMod.Output +import GhcMod.Target +import GhcMod.Types diff --git a/GhcModExe/Boot.hs b/GhcMod/Exe/Boot.hs similarity index 69% rename from GhcModExe/Boot.hs rename to GhcMod/Exe/Boot.hs index 35c43d3..4316259 100644 --- a/GhcModExe/Boot.hs +++ b/GhcMod/Exe/Boot.hs @@ -1,14 +1,14 @@ -module GhcModExe.Boot where +module GhcMod.Exe.Boot where import Control.Applicative import Prelude -import GhcModExe.Browse -import GhcModExe.Flag -import GhcModExe.Lang -import GhcModExe.Modules -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Types (defaultBrowseOpts) +import GhcMod.Exe.Browse +import GhcMod.Exe.Flag +import GhcMod.Exe.Lang +import GhcMod.Exe.Modules +import GhcMod.Monad +import GhcMod.Types (defaultBrowseOpts) -- | Printing necessary information for front-end booting. boot :: IOish m => GhcModT m String diff --git a/GhcModExe/Browse.hs b/GhcMod/Exe/Browse.hs similarity index 95% rename from GhcModExe/Browse.hs rename to GhcMod/Exe/Browse.hs index d09666b..069750b 100644 --- a/GhcModExe/Browse.hs +++ b/GhcMod/Exe/Browse.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -module GhcModExe.Browse ( +module GhcMod.Exe.Browse ( browse, BrowseOpts(..) ) where @@ -14,12 +14,12 @@ import FastString import GHC import HscTypes 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.Types -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Logging +import GhcMod.Convert +import GhcMod.Doc (showPage, styleUnqualified) +import GhcMod.Gap as Gap +import GhcMod.Types +import GhcMod.Monad +import GhcMod.Logging import Name (getOccString) import Outputable import TyCon (isAlgTyCon) diff --git a/GhcModExe/CaseSplit.hs b/GhcMod/Exe/CaseSplit.hs similarity index 95% rename from GhcModExe/CaseSplit.hs rename to GhcMod/Exe/CaseSplit.hs index 02562aa..d866fb6 100644 --- a/GhcModExe/CaseSplit.hs +++ b/GhcMod/Exe/CaseSplit.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} -module GhcModExe.CaseSplit ( +module GhcMod.Exe.CaseSplit ( splits ) where @@ -19,16 +19,16 @@ import qualified TyCon as Ty import qualified Type as Ty import Exception -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.DynFlags -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.SrcUtils -import Language.Haskell.GhcMod.Doc -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils (withMappedFile) -import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping) +import GhcMod.Convert +import GhcMod.DynFlags +import qualified GhcMod.Gap as Gap +import GhcMod.Monad +import GhcMod.SrcUtils +import GhcMod.Doc +import GhcMod.Logging +import GhcMod.Types +import GhcMod.Utils (withMappedFile) +import GhcMod.FileMapping (fileModSummaryWithMapping) import Control.DeepSeq ---------------------------------------------------------------- diff --git a/GhcModExe/Check.hs b/GhcMod/Exe/Check.hs similarity index 88% rename from GhcModExe/Check.hs rename to GhcMod/Exe/Check.hs index dcb6868..00f2c0f 100644 --- a/GhcModExe/Check.hs +++ b/GhcMod/Exe/Check.hs @@ -1,4 +1,4 @@ -module GhcModExe.Check ( +module GhcMod.Exe.Check ( checkSyntax , check , expandTemplate @@ -7,10 +7,10 @@ module GhcModExe.Check ( import Control.Applicative import Prelude -import Language.Haskell.GhcMod.DynFlags -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Logger -import Language.Haskell.GhcMod.Monad +import GhcMod.DynFlags +import qualified GhcMod.Gap as Gap +import GhcMod.Logger +import GhcMod.Monad ---------------------------------------------------------------- diff --git a/GhcModExe/Debug.hs b/GhcMod/Exe/Debug.hs similarity index 93% rename from GhcModExe/Debug.hs rename to GhcMod/Exe/Debug.hs index 39f63e5..2ba7ac5 100644 --- a/GhcModExe/Debug.hs +++ b/GhcMod/Exe/Debug.hs @@ -1,4 +1,4 @@ -module GhcModExe.Debug (debugInfo, rootInfo, componentInfo) where +module GhcMod.Exe.Debug (debugInfo, rootInfo, componentInfo) where import Control.Arrow (first) import Control.Applicative @@ -11,15 +11,15 @@ import Data.Version import Data.List.Split import System.Directory -import GhcModExe.Internal -import Language.Haskell.GhcMod.Cradle -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Output -import Language.Haskell.GhcMod.Pretty -import Language.Haskell.GhcMod.Stack -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils +import GhcMod.Exe.Internal +import GhcMod.Cradle +import GhcMod.Monad +import GhcMod.Output +import GhcMod.Pretty +import GhcMod.Stack +import GhcMod.Target +import GhcMod.Types +import GhcMod.Utils import Paths_ghc_mod (version) diff --git a/GhcModExe/FillSig.hs b/GhcMod/Exe/FillSig.hs similarity index 97% rename from GhcModExe/FillSig.hs rename to GhcMod/Exe/FillSig.hs index 0172a3b..236f1dc 100644 --- a/GhcModExe/FillSig.hs +++ b/GhcMod/Exe/FillSig.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} -module GhcModExe.FillSig ( +module GhcMod.Exe.FillSig ( sig , refine , auto @@ -30,16 +30,16 @@ import qualified HsPat as Ty import qualified Language.Haskell.Exts as HE import Djinn.GHC -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.DynFlags -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.SrcUtils -import Language.Haskell.GhcMod.Logging (gmLog) -import Language.Haskell.GhcMod.Pretty (showToDoc) -import Language.Haskell.GhcMod.Doc -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping) +import qualified GhcMod.Gap as Gap +import GhcMod.Convert +import GhcMod.DynFlags +import GhcMod.Monad +import GhcMod.SrcUtils +import GhcMod.Logging (gmLog) +import GhcMod.Pretty (showToDoc) +import GhcMod.Doc +import GhcMod.Types +import GhcMod.FileMapping (fileModSummaryWithMapping) #if __GLASGOW_HASKELL__ >= 710 import GHC (unLoc) diff --git a/GhcModExe/Find.hs b/GhcMod/Exe/Find.hs similarity index 94% rename from GhcModExe/Find.hs rename to GhcMod/Exe/Find.hs index 3e0a7fd..17c6190 100644 --- a/GhcModExe/Find.hs +++ b/GhcMod/Exe/Find.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP, BangPatterns, TupleSections, DeriveGeneric #-} -module GhcModExe.Find +module GhcMod.Exe.Find ( Symbol , SymbolDb , loadSymbolDb @@ -22,14 +22,14 @@ import OccName import HscTypes import Exception -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Gap -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Output -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils -import Language.Haskell.GhcMod.World -import Language.Haskell.GhcMod.LightGhc +import GhcMod.Convert +import GhcMod.Gap +import GhcMod.Monad +import GhcMod.Output +import GhcMod.Types +import GhcMod.Utils +import GhcMod.World +import GhcMod.LightGhc import Control.Applicative import Control.DeepSeq @@ -53,7 +53,7 @@ import Data.Map (Map) import qualified Data.Map as M import Data.Set (Set) import qualified Data.Set as S -import Language.Haskell.GhcMod.PathsAndFiles +import GhcMod.PathsAndFiles import System.Directory import Prelude diff --git a/GhcMod/Exe/Flag.hs b/GhcMod/Exe/Flag.hs new file mode 100644 index 0000000..9384dd6 --- /dev/null +++ b/GhcMod/Exe/Flag.hs @@ -0,0 +1,9 @@ +module GhcMod.Exe.Flag where + +import qualified GhcMod.Gap as Gap +import GhcMod.Convert +import GhcMod.Monad + +-- | Listing of GHC flags, same as @ghc@\'s @--show-options@ with @ghc >= 7.10@. +flags :: IOish m => GhcModT m String +flags = convert' Gap.ghcCmdOptions diff --git a/GhcModExe/Info.hs b/GhcMod/Exe/Info.hs similarity index 81% rename from GhcModExe/Info.hs rename to GhcMod/Exe/Info.hs index 0b635ae..0021936 100644 --- a/GhcModExe/Info.hs +++ b/GhcMod/Exe/Info.hs @@ -1,4 +1,4 @@ -module GhcModExe.Info ( +module GhcMod.Exe.Info ( info , types ) where @@ -11,17 +11,17 @@ import GHC (GhcMonad, SrcSpan) import Prelude import qualified GHC as G -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Doc -import Language.Haskell.GhcMod.DynFlags -import Language.Haskell.GhcMod.Gap -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.SrcUtils -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc) -import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping) +import qualified GhcMod.Gap as Gap +import GhcMod.Convert +import GhcMod.Doc +import GhcMod.DynFlags +import GhcMod.Gap +import GhcMod.Logging +import GhcMod.Monad +import GhcMod.SrcUtils +import GhcMod.Types +import GhcMod.Utils (mkRevRedirMapFunc) +import GhcMod.FileMapping (fileModSummaryWithMapping) ---------------------------------------------------------------- diff --git a/GhcModExe/Internal.hs b/GhcMod/Exe/Internal.hs similarity index 68% rename from GhcModExe/Internal.hs rename to GhcMod/Exe/Internal.hs index d310690..930b22b 100644 --- a/GhcModExe/Internal.hs +++ b/GhcMod/Exe/Internal.hs @@ -1,6 +1,6 @@ -- | Low level access to the ghc-mod library. -module GhcModExe.Internal ( +module GhcMod.Exe.Internal ( -- * Types GHCOption , IncludeDir @@ -51,22 +51,22 @@ module GhcModExe.Internal ( , GHandler(..) , gcatches -- * FileMapping - , module Language.Haskell.GhcMod.FileMapping + , module GhcMod.FileMapping ) where import GHC.Paths (libdir) -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.DynFlags -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Logger -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils -import Language.Haskell.GhcMod.World -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.FileMapping +import GhcMod.Target +import GhcMod.DynFlags +import GhcMod.Error +import GhcMod.Logger +import GhcMod.Logging +import GhcMod.Monad +import GhcMod.Types +import GhcMod.Utils +import GhcMod.World +import GhcMod.CabalHelper +import GhcMod.FileMapping -- | Obtaining the directory for ghc system libraries. ghcLibDir :: FilePath diff --git a/GhcModExe/Lang.hs b/GhcMod/Exe/Lang.hs similarity index 63% rename from GhcModExe/Lang.hs rename to GhcMod/Exe/Lang.hs index 0a5ac4b..3546c4a 100644 --- a/GhcModExe/Lang.hs +++ b/GhcMod/Exe/Lang.hs @@ -1,8 +1,8 @@ -module GhcModExe.Lang where +module GhcMod.Exe.Lang where import DynFlags (supportedLanguagesAndExtensions) -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Monad +import GhcMod.Convert +import GhcMod.Monad -- | Listing language extensions. diff --git a/GhcModExe/Lint.hs b/GhcMod/Exe/Lint.hs similarity index 77% rename from GhcModExe/Lint.hs rename to GhcMod/Exe/Lint.hs index 12237a9..c4a2d75 100644 --- a/GhcModExe/Lint.hs +++ b/GhcMod/Exe/Lint.hs @@ -1,14 +1,14 @@ -module GhcModExe.Lint where +module GhcMod.Exe.Lint where import Exception (ghandle) import Control.Exception (SomeException(..)) -import Language.Haskell.GhcMod.Logger (checkErrorPrefix) -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad +import GhcMod.Logger (checkErrorPrefix) +import GhcMod.Convert +import GhcMod.Types +import GhcMod.Monad import Language.Haskell.HLint3 -import Language.Haskell.GhcMod.Utils (withMappedFile) +import GhcMod.Utils (withMappedFile) import Language.Haskell.Exts.SrcLoc (SrcSpan(..)) -- | Checking syntax of a target file using hlint. diff --git a/GhcModExe/Modules.hs b/GhcMod/Exe/Modules.hs similarity index 78% rename from GhcModExe/Modules.hs rename to GhcMod/Exe/Modules.hs index 80abe7d..735bd8f 100644 --- a/GhcModExe/Modules.hs +++ b/GhcMod/Exe/Modules.hs @@ -1,11 +1,11 @@ -module GhcModExe.Modules (modules) where +module GhcMod.Exe.Modules (modules) where import Control.Arrow import Data.List -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Gap ( listVisibleModuleNames +import GhcMod.Convert +import GhcMod.Types +import GhcMod.Monad +import GhcMod.Gap ( listVisibleModuleNames , lookupModulePackageInAllPackages ) diff --git a/GhcModExe/PkgDoc.hs b/GhcMod/Exe/PkgDoc.hs similarity index 80% rename from GhcModExe/PkgDoc.hs rename to GhcMod/Exe/PkgDoc.hs index d10d2d8..4d521fd 100644 --- a/GhcModExe/PkgDoc.hs +++ b/GhcMod/Exe/PkgDoc.hs @@ -1,9 +1,9 @@ -module GhcModExe.PkgDoc (pkgDoc) where +module GhcMod.Exe.PkgDoc (pkgDoc) where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.GhcPkg -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Output +import GhcMod.Types +import GhcMod.GhcPkg +import GhcMod.Monad +import GhcMod.Output import Control.Applicative import Prelude diff --git a/GhcModExe/Test.hs b/GhcMod/Exe/Test.hs similarity index 88% rename from GhcModExe/Test.hs rename to GhcMod/Exe/Test.hs index be127e9..96eb01c 100644 --- a/GhcModExe/Test.hs +++ b/GhcMod/Exe/Test.hs @@ -1,4 +1,4 @@ -module GhcModExe.Test where +module GhcMod.Exe.Test where import Control.Applicative import Data.List @@ -6,9 +6,9 @@ import System.FilePath import System.Directory import Prelude -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.DynFlags +import GhcMod.Types +import GhcMod.Monad +import GhcMod.DynFlags import GHC import GHC.Exception diff --git a/GhcModExe/Flag.hs b/GhcModExe/Flag.hs deleted file mode 100644 index 1a09f77..0000000 --- a/GhcModExe/Flag.hs +++ /dev/null @@ -1,9 +0,0 @@ -module GhcModExe.Flag where - -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Monad - --- | Listing of GHC flags, same as @ghc@\'s @--show-options@ with @ghc >= 7.10@. -flags :: IOish m => GhcModT m String -flags = convert' Gap.ghcCmdOptions diff --git a/bench/Bench.hs b/bench/Bench.hs index 1880492..542fa4c 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -1,7 +1,7 @@ import Criterion.Main -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Types +import GhcMod.Target +import GhcMod.Monad +import GhcMod.Types import Dir import System.IO.Temp import System.Process hiding (env) diff --git a/core/Language/Haskell/GhcMod/CabalHelper.hs b/core/GhcMod/CabalHelper.hs similarity index 96% rename from core/Language/Haskell/GhcMod/CabalHelper.hs rename to core/GhcMod/CabalHelper.hs index cb09569..4265739 100644 --- a/core/Language/Haskell/GhcMod/CabalHelper.hs +++ b/core/GhcMod/CabalHelper.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE CPP #-} -module Language.Haskell.GhcMod.CabalHelper +module GhcMod.CabalHelper ( getComponents , getGhcMergedPkgOptions , getCabalPackageDbStack @@ -34,15 +34,15 @@ import Data.Binary (Binary) import Data.Traversable import Distribution.Helper hiding (Programs(..)) import qualified Distribution.Helper as CH -import qualified Language.Haskell.GhcMod.Types as T -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Utils -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Output -import Language.Haskell.GhcMod.CustomPackageDb -import Language.Haskell.GhcMod.Stack +import qualified GhcMod.Types as T +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Utils +import GhcMod.PathsAndFiles +import GhcMod.Logging +import GhcMod.Output +import GhcMod.CustomPackageDb +import GhcMod.Stack import System.FilePath import System.Process import System.Exit diff --git a/core/Language/Haskell/GhcMod/Caching.hs b/core/GhcMod/Caching.hs similarity index 94% rename from core/Language/Haskell/GhcMod/Caching.hs rename to core/GhcMod/Caching.hs index c8cdb05..2f58929 100644 --- a/core/Language/Haskell/GhcMod/Caching.hs +++ b/core/GhcMod/Caching.hs @@ -14,9 +14,9 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . {-# LANGUAGE CPP, OverloadedStrings #-} -module Language.Haskell.GhcMod.Caching ( - module Language.Haskell.GhcMod.Caching - , module Language.Haskell.GhcMod.Caching.Types +module GhcMod.Caching ( + module GhcMod.Caching + , module GhcMod.Caching.Types ) where import Control.Arrow (first) @@ -38,9 +38,9 @@ import Utils (TimedFile(..), timeMaybe, mightExist) import Paths_ghc_mod (version) import Prelude -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Caching.Types -import Language.Haskell.GhcMod.Logging +import GhcMod.Monad.Types +import GhcMod.Caching.Types +import GhcMod.Logging -- | Cache a MonadIO action with proper invalidation. cached :: forall m a d. (Gm m, MonadIO m, Binary a, Eq d, Binary d, Show d) diff --git a/core/Language/Haskell/GhcMod/Caching/Types.hs b/core/GhcMod/Caching/Types.hs similarity index 97% rename from core/Language/Haskell/GhcMod/Caching/Types.hs rename to core/GhcMod/Caching/Types.hs index 501eae2..4a8a813 100644 --- a/core/Language/Haskell/GhcMod/Caching/Types.hs +++ b/core/GhcMod/Caching/Types.hs @@ -13,7 +13,7 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.Caching.Types where +module GhcMod.Caching.Types where import Utils import Data.Label diff --git a/core/Language/Haskell/GhcMod/Convert.hs b/core/GhcMod/Convert.hs similarity index 96% rename from core/Language/Haskell/GhcMod/Convert.hs rename to core/GhcMod/Convert.hs index fa266d2..f33509e 100644 --- a/core/Language/Haskell/GhcMod/Convert.hs +++ b/core/GhcMod/Convert.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP, FlexibleInstances, FlexibleContexts #-} -module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFound, whenFound') where +module GhcMod.Convert (convert, convert', emptyResult, whenFound, whenFound') where -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Types import Control.Applicative import Prelude diff --git a/core/Language/Haskell/GhcMod/Cradle.hs b/core/GhcMod/Cradle.hs similarity index 95% rename from core/Language/Haskell/GhcMod/Cradle.hs rename to core/GhcMod/Cradle.hs index b4e499b..9226fd5 100644 --- a/core/Language/Haskell/GhcMod/Cradle.hs +++ b/core/GhcMod/Cradle.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -module Language.Haskell.GhcMod.Cradle +module GhcMod.Cradle ( findCradle , findCradle' , findCradleNoLog @@ -10,13 +10,13 @@ module Language.Haskell.GhcMod.Cradle , plainCradle ) where -import Language.Haskell.GhcMod.PathsAndFiles -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 Language.Haskell.GhcMod.Error +import GhcMod.PathsAndFiles +import GhcMod.Monad.Types +import GhcMod.Types +import GhcMod.Utils +import GhcMod.Stack +import GhcMod.Logging +import GhcMod.Error import Safe import Control.Applicative diff --git a/core/Language/Haskell/GhcMod/CustomPackageDb.hs b/core/GhcMod/CustomPackageDb.hs similarity index 88% rename from core/Language/Haskell/GhcMod/CustomPackageDb.hs rename to core/GhcMod/CustomPackageDb.hs index 8fc78e3..8f6c38c 100644 --- a/core/Language/Haskell/GhcMod/CustomPackageDb.hs +++ b/core/GhcMod/CustomPackageDb.hs @@ -13,16 +13,16 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.CustomPackageDb where +module GhcMod.CustomPackageDb where import Control.Applicative import Control.Monad import Control.Category ((.)) import Data.Maybe import Data.Traversable -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.PathsAndFiles +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.PathsAndFiles import Prelude hiding ((.)) parseCustomPackageDb :: String -> [GhcPkgDb] diff --git a/core/Language/Haskell/GhcMod/DebugLogger.hs b/core/GhcMod/DebugLogger.hs similarity index 97% rename from core/Language/Haskell/GhcMod/DebugLogger.hs rename to core/GhcMod/DebugLogger.hs index 780dcd6..6e9dfa8 100644 --- a/core/Language/Haskell/GhcMod/DebugLogger.hs +++ b/core/GhcMod/DebugLogger.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . {-# LANGUAGE CPP, RankNTypes #-} -module Language.Haskell.GhcMod.DebugLogger where +module GhcMod.DebugLogger where -- (c) The University of Glasgow 2005 -- @@ -57,8 +57,8 @@ import Outputable (SDoc, PprStyle, runSDoc, initSDocContext, blankLine) import qualified Outputable import ErrUtils -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Gap +import GhcMod.Error +import GhcMod.Gap import Prelude debugLogAction :: (String -> IO ()) -> GmLogAction diff --git a/core/Language/Haskell/GhcMod/Doc.hs b/core/GhcMod/Doc.hs similarity index 83% rename from core/Language/Haskell/GhcMod/Doc.hs rename to core/GhcMod/Doc.hs index 7914e2e..005eaf1 100644 --- a/core/Language/Haskell/GhcMod/Doc.hs +++ b/core/GhcMod/Doc.hs @@ -1,7 +1,7 @@ -module Language.Haskell.GhcMod.Doc where +module GhcMod.Doc where import GHC -import Language.Haskell.GhcMod.Gap (withStyle, showDocWith) +import GhcMod.Gap (withStyle, showDocWith) import Outputable import Pretty (Mode(..)) diff --git a/core/Language/Haskell/GhcMod/DynFlags.hs b/core/GhcMod/DynFlags.hs similarity index 93% rename from core/Language/Haskell/GhcMod/DynFlags.hs rename to core/GhcMod/DynFlags.hs index a68a050..77f213d 100644 --- a/core/Language/Haskell/GhcMod/DynFlags.hs +++ b/core/GhcMod/DynFlags.hs @@ -1,16 +1,16 @@ {-# LANGUAGE TemplateHaskell #-} -module Language.Haskell.GhcMod.DynFlags where +module GhcMod.DynFlags where import Control.Applicative import Control.Monad import GHC import qualified GHC as G import GHC.Paths (libdir) -import qualified Language.Haskell.GhcMod.Gap as Gap -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.DebugLogger -import Language.Haskell.GhcMod.DynFlagsTH +import qualified GhcMod.Gap as Gap +import GhcMod.Types +import GhcMod.DebugLogger +import GhcMod.DynFlagsTH import System.IO.Unsafe (unsafePerformIO) import Prelude diff --git a/core/Language/Haskell/GhcMod/DynFlagsTH.hs b/core/GhcMod/DynFlagsTH.hs similarity index 99% rename from core/Language/Haskell/GhcMod/DynFlagsTH.hs rename to core/GhcMod/DynFlagsTH.hs index f5a1c01..9085707 100644 --- a/core/Language/Haskell/GhcMod/DynFlagsTH.hs +++ b/core/GhcMod/DynFlagsTH.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE CPP, TemplateHaskell #-} -module Language.Haskell.GhcMod.DynFlagsTH where +module GhcMod.DynFlagsTH where import Language.Haskell.TH import Language.Haskell.TH.Syntax diff --git a/core/Language/Haskell/GhcMod/Error.hs b/core/GhcMod/Error.hs similarity index 98% rename from core/Language/Haskell/GhcMod/Error.hs rename to core/GhcMod/Error.hs index bf60962..18e5fc8 100644 --- a/core/Language/Haskell/GhcMod/Error.hs +++ b/core/GhcMod/Error.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE ExistentialQuantification #-} -module Language.Haskell.GhcMod.Error ( +module GhcMod.Error ( GhcModError(..) , GmError , gmeDoc @@ -47,8 +47,8 @@ import Pretty import Config (cProjectVersion, cHostPlatformString) import Paths_ghc_mod (version) -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Pretty +import GhcMod.Types +import GhcMod.Pretty type GmError m = MonadError GhcModError m diff --git a/core/Language/Haskell/GhcMod/FileMapping.hs b/core/GhcMod/FileMapping.hs similarity index 93% rename from core/Language/Haskell/GhcMod/FileMapping.hs rename to core/GhcMod/FileMapping.hs index 4655605..e05a540 100644 --- a/core/Language/Haskell/GhcMod/FileMapping.hs +++ b/core/GhcMod/FileMapping.hs @@ -1,4 +1,4 @@ -module Language.Haskell.GhcMod.FileMapping +module GhcMod.FileMapping ( loadMappedFile , loadMappedFileSource , unloadMappedFile @@ -6,11 +6,11 @@ module Language.Haskell.GhcMod.FileMapping , fileModSummaryWithMapping ) where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Gap -import Language.Haskell.GhcMod.HomeModuleGraph -import Language.Haskell.GhcMod.Utils +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Gap +import GhcMod.HomeModuleGraph +import GhcMod.Utils import System.IO import System.FilePath diff --git a/core/Language/Haskell/GhcMod/Gap.hs b/core/GhcMod/Gap.hs similarity index 99% rename from core/Language/Haskell/GhcMod/Gap.hs rename to core/GhcMod/Gap.hs index 13d0246..728a04c 100644 --- a/core/Language/Haskell/GhcMod/Gap.hs +++ b/core/GhcMod/Gap.hs @@ -1,7 +1,7 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, CPP, ScopedTypeVariables, RankNTypes #-} -module Language.Haskell.GhcMod.Gap ( - Language.Haskell.GhcMod.Gap.ClsInst +module GhcMod.Gap ( + GhcMod.Gap.ClsInst , mkTarget , withStyle , GmLogAction @@ -44,7 +44,7 @@ module Language.Haskell.GhcMod.Gap ( , listVisibleModuleNames , listVisibleModules , lookupModulePackageInAllPackages - , Language.Haskell.GhcMod.Gap.isSynTyCon + , GhcMod.Gap.isSynTyCon , parseModuleHeader , mkErrStyle' , everythingStagedWithContext @@ -139,7 +139,7 @@ import Packages import Data.Generics (GenericQ, extQ, gmapQ) import GHC.SYB.Utils (Stage(..)) -import Language.Haskell.GhcMod.Types (Expression(..)) +import GhcMod.Types (Expression(..)) import Prelude ---------------------------------------------------------------- diff --git a/core/Language/Haskell/GhcMod/GhcPkg.hs b/core/GhcMod/GhcPkg.hs similarity index 92% rename from core/Language/Haskell/GhcMod/GhcPkg.hs rename to core/GhcMod/GhcPkg.hs index 86ab83b..746b2ea 100644 --- a/core/Language/Haskell/GhcMod/GhcPkg.hs +++ b/core/GhcMod/GhcPkg.hs @@ -1,5 +1,5 @@ {-# LANGUAGE BangPatterns, ScopedTypeVariables, TupleSections #-} -module Language.Haskell.GhcMod.GhcPkg ( +module GhcMod.GhcPkg ( ghcPkgDbOpt , ghcPkgDbStackOpts , ghcDbStackOpts @@ -18,12 +18,12 @@ import System.Directory (doesDirectoryExist, getAppUserDataDirectory) import System.FilePath (()) import Prelude -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.CustomPackageDb -import Language.Haskell.GhcMod.Stack +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.CabalHelper +import GhcMod.PathsAndFiles +import GhcMod.CustomPackageDb +import GhcMod.Stack ghcVersion :: Int ghcVersion = read cProjectVersionInt diff --git a/core/Language/Haskell/GhcMod/HomeModuleGraph.hs b/core/GhcMod/HomeModuleGraph.hs similarity index 96% rename from core/Language/Haskell/GhcMod/HomeModuleGraph.hs rename to core/GhcMod/HomeModuleGraph.hs index 7ed7b01..cda8261 100644 --- a/core/Language/Haskell/GhcMod/HomeModuleGraph.hs +++ b/core/GhcMod/HomeModuleGraph.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE ScopedTypeVariables, RecordWildCards #-} -module Language.Haskell.GhcMod.HomeModuleGraph ( +module GhcMod.HomeModuleGraph ( GmModuleGraph(..) , ModulePath(..) , mkFileMap @@ -58,12 +58,12 @@ import System.Directory import System.IO import Prelude -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Logger -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils (withMappedFile) -import Language.Haskell.GhcMod.Gap (parseModuleHeader) +import GhcMod.Logging +import GhcMod.Logger +import GhcMod.Monad.Types +import GhcMod.Types +import GhcMod.Utils (withMappedFile) +import GhcMod.Gap (parseModuleHeader) -- | Turn module graph into a graphviz dot file -- diff --git a/core/Language/Haskell/GhcMod/LightGhc.hs b/core/GhcMod/LightGhc.hs similarity index 89% rename from core/Language/Haskell/GhcMod/LightGhc.hs rename to core/GhcMod/LightGhc.hs index 8978991..3be80e0 100644 --- a/core/Language/Haskell/GhcMod/LightGhc.hs +++ b/core/GhcMod/LightGhc.hs @@ -1,4 +1,4 @@ -module Language.Haskell.GhcMod.LightGhc where +module GhcMod.LightGhc where import Control.Monad import Control.Monad.Reader (runReaderT) @@ -12,10 +12,10 @@ import DynFlags import HscMain import HscTypes -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.DynFlags -import qualified Language.Haskell.GhcMod.Gap as Gap +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.DynFlags +import qualified GhcMod.Gap as Gap -- We have to be more careful about tearing down 'HscEnv's since GHC 8 added an -- out of process GHCI server which has to be shutdown. diff --git a/core/Language/Haskell/GhcMod/Logger.hs b/core/GhcMod/Logger.hs similarity index 93% rename from core/Language/Haskell/GhcMod/Logger.hs rename to core/GhcMod/Logger.hs index 6c14d5e..3ccf89b 100644 --- a/core/Language/Haskell/GhcMod/Logger.hs +++ b/core/GhcMod/Logger.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP, RankNTypes #-} -module Language.Haskell.GhcMod.Logger ( +module GhcMod.Logger ( withLogger , withLogger' , checkErrorPrefix @@ -27,14 +27,14 @@ import Bag import SrcLoc import FastString -import Language.Haskell.GhcMod.Convert -import Language.Haskell.GhcMod.Doc (showPage) -import Language.Haskell.GhcMod.DynFlags (withDynFlags) -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Pretty -import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc) -import qualified Language.Haskell.GhcMod.Gap as Gap +import GhcMod.Convert +import GhcMod.Doc (showPage) +import GhcMod.DynFlags (withDynFlags) +import GhcMod.Monad.Types +import GhcMod.Error +import GhcMod.Pretty +import GhcMod.Utils (mkRevRedirMapFunc) +import qualified GhcMod.Gap as Gap import Prelude type Builder = [String] -> [String] diff --git a/core/Language/Haskell/GhcMod/Logging.hs b/core/GhcMod/Logging.hs similarity index 92% rename from core/Language/Haskell/GhcMod/Logging.hs rename to core/GhcMod/Logging.hs index a6cfaff..930a56b 100644 --- a/core/Language/Haskell/GhcMod/Logging.hs +++ b/core/GhcMod/Logging.hs @@ -16,9 +16,9 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Language.Haskell.GhcMod.Logging ( - module Language.Haskell.GhcMod.Logging - , module Language.Haskell.GhcMod.Pretty +module GhcMod.Logging ( + module GhcMod.Logging + , module GhcMod.Pretty , GmLogLevel(..) , module Data.Monoid , module Pretty @@ -37,10 +37,10 @@ import Prelude import Pretty hiding (style, (<>)) -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Pretty -import Language.Haskell.GhcMod.Output +import GhcMod.Monad.Types +import GhcMod.Types +import GhcMod.Pretty +import GhcMod.Output gmSetLogLevel :: GmLog m => GmLogLevel -> m () gmSetLogLevel level = diff --git a/core/Language/Haskell/GhcMod/Monad.hs b/core/GhcMod/Monad.hs similarity index 92% rename from core/Language/Haskell/GhcMod/Monad.hs rename to core/GhcMod/Monad.hs index 8f44db8..83d22b6 100644 --- a/core/Language/Haskell/GhcMod/Monad.hs +++ b/core/GhcMod/Monad.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE CPP #-} -module Language.Haskell.GhcMod.Monad ( +module GhcMod.Monad ( runGmOutT , runGmOutT' , runGhcModT @@ -27,16 +27,16 @@ module Language.Haskell.GhcMod.Monad ( , runGmPkgGhc , withGhcModEnv , withGhcModEnv' - , module Language.Haskell.GhcMod.Monad.Types + , module GhcMod.Monad.Types ) where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Cradle -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.Output +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Error +import GhcMod.Logging +import GhcMod.Cradle +import GhcMod.Target +import GhcMod.Output import Control.Arrow (first) import Control.Applicative diff --git a/core/Language/Haskell/GhcMod/Monad/Compat.hs_h b/core/GhcMod/Monad/Compat.hs_h similarity index 100% rename from core/Language/Haskell/GhcMod/Monad/Compat.hs_h rename to core/GhcMod/Monad/Compat.hs_h diff --git a/core/Language/Haskell/GhcMod/Monad/Env.hs b/core/GhcMod/Monad/Env.hs similarity index 94% rename from core/Language/Haskell/GhcMod/Monad/Env.hs rename to core/GhcMod/Monad/Env.hs index 23b42be..79db698 100644 --- a/core/Language/Haskell/GhcMod/Monad/Env.hs +++ b/core/GhcMod/Monad/Env.hs @@ -17,10 +17,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} -module Language.Haskell.GhcMod.Monad.Env where +module GhcMod.Monad.Env where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Newtypes +import GhcMod.Types +import GhcMod.Monad.Newtypes import Control.Monad import Control.Monad.Trans.Journal (JournalT) diff --git a/core/Language/Haskell/GhcMod/Monad/Log.hs b/core/GhcMod/Monad/Log.hs similarity index 94% rename from core/Language/Haskell/GhcMod/Monad/Log.hs rename to core/GhcMod/Monad/Log.hs index f353084..5e21375 100644 --- a/core/Language/Haskell/GhcMod/Monad/Log.hs +++ b/core/GhcMod/Monad/Log.hs @@ -17,10 +17,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} -module Language.Haskell.GhcMod.Monad.Log where +module GhcMod.Monad.Log where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Newtypes +import GhcMod.Types +import GhcMod.Monad.Newtypes import Control.Monad import Control.Monad.Trans.Journal (JournalT) diff --git a/core/Language/Haskell/GhcMod/Monad/Newtypes.hs b/core/GhcMod/Monad/Newtypes.hs similarity index 98% rename from core/Language/Haskell/GhcMod/Monad/Newtypes.hs rename to core/GhcMod/Monad/Newtypes.hs index 90a6b26..b9a070f 100644 --- a/core/Language/Haskell/GhcMod/Monad/Newtypes.hs +++ b/core/GhcMod/Monad/Newtypes.hs @@ -18,11 +18,11 @@ {-# LANGUAGE MultiParamTypeClasses, TypeFamilies, UndecidableInstances #-} {-# LANGUAGE RankNTypes, FlexibleInstances #-} -module Language.Haskell.GhcMod.Monad.Newtypes where +module GhcMod.Monad.Newtypes where #include "Compat.hs_h" -import Language.Haskell.GhcMod.Types +import GhcMod.Types import GHC diff --git a/core/Language/Haskell/GhcMod/Monad/Orphans.hs b/core/GhcMod/Monad/Orphans.hs similarity index 95% rename from core/Language/Haskell/GhcMod/Monad/Orphans.hs rename to core/GhcMod/Monad/Orphans.hs index 18fe9f5..0c9e7fd 100644 --- a/core/Language/Haskell/GhcMod/Monad/Orphans.hs +++ b/core/GhcMod/Monad/Orphans.hs @@ -18,12 +18,12 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Language.Haskell.GhcMod.Monad.Orphans where +module GhcMod.Monad.Orphans where #include "Compat.hs_h" -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Newtypes +import GhcMod.Types +import GhcMod.Monad.Newtypes #if DIFFERENT_MONADIO import qualified MonadUtils as GHC (MonadIO(..)) diff --git a/core/Language/Haskell/GhcMod/Monad/Out.hs b/core/GhcMod/Monad/Out.hs similarity index 92% rename from core/Language/Haskell/GhcMod/Monad/Out.hs rename to core/GhcMod/Monad/Out.hs index d372f9f..6024f9d 100644 --- a/core/Language/Haskell/GhcMod/Monad/Out.hs +++ b/core/GhcMod/Monad/Out.hs @@ -17,10 +17,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-} -module Language.Haskell.GhcMod.Monad.Out where +module GhcMod.Monad.Out where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Newtypes +import GhcMod.Types +import GhcMod.Monad.Newtypes import Control.Monad import Control.Monad.State.Strict (StateT(..)) diff --git a/core/Language/Haskell/GhcMod/Monad/State.hs b/core/GhcMod/Monad/State.hs similarity index 94% rename from core/Language/Haskell/GhcMod/Monad/State.hs rename to core/GhcMod/Monad/State.hs index 5edcbe7..fdef21e 100644 --- a/core/Language/Haskell/GhcMod/Monad/State.hs +++ b/core/GhcMod/Monad/State.hs @@ -17,10 +17,10 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, StandaloneDeriving #-} {-# LANGUAGE FlexibleInstances, UndecidableInstances #-} -module Language.Haskell.GhcMod.Monad.State where +module GhcMod.Monad.State where -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Newtypes +import GhcMod.Types +import GhcMod.Monad.Newtypes import Control.Monad import Control.Monad.State.Strict (StateT(..)) diff --git a/core/Language/Haskell/GhcMod/Monad/Types.hs b/core/GhcMod/Monad/Types.hs similarity index 95% rename from core/Language/Haskell/GhcMod/Monad/Types.hs rename to core/GhcMod/Monad/Types.hs index 416ee13..abb7a6f 100644 --- a/core/Language/Haskell/GhcMod/Monad/Types.hs +++ b/core/GhcMod/Monad/Types.hs @@ -20,7 +20,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Language.Haskell.GhcMod.Monad.Types ( +module GhcMod.Monad.Types ( -- * Monad Types GhcModT , GmOutT(..) @@ -64,14 +64,14 @@ module Language.Haskell.GhcMod.Monad.Types ( #include "Compat.hs_h" -import Language.Haskell.GhcMod.Types +import GhcMod.Types -import Language.Haskell.GhcMod.Monad.Env -import Language.Haskell.GhcMod.Monad.State -import Language.Haskell.GhcMod.Monad.Log -import Language.Haskell.GhcMod.Monad.Out -import Language.Haskell.GhcMod.Monad.Newtypes -import Language.Haskell.GhcMod.Monad.Orphans () +import GhcMod.Monad.Env +import GhcMod.Monad.State +import GhcMod.Monad.Log +import GhcMod.Monad.Out +import GhcMod.Monad.Newtypes +import GhcMod.Monad.Orphans () import Safe diff --git a/core/Language/Haskell/GhcMod/Options/DocUtils.hs b/core/GhcMod/Options/DocUtils.hs similarity index 95% rename from core/Language/Haskell/GhcMod/Options/DocUtils.hs rename to core/GhcMod/Options/DocUtils.hs index 9fd846c..ab8add7 100644 --- a/core/Language/Haskell/GhcMod/Options/DocUtils.hs +++ b/core/GhcMod/Options/DocUtils.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.Options.DocUtils ( +module GhcMod.Options.DocUtils ( ($$), ($$$), (<=>), diff --git a/core/Language/Haskell/GhcMod/Options/Help.hs b/core/GhcMod/Options/Help.hs similarity index 97% rename from core/Language/Haskell/GhcMod/Options/Help.hs rename to core/GhcMod/Options/Help.hs index 2ecc144..b23487c 100644 --- a/core/Language/Haskell/GhcMod/Options/Help.hs +++ b/core/GhcMod/Options/Help.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE OverloadedStrings, FlexibleInstances, GeneralizedNewtypeDeriving #-} -module Language.Haskell.GhcMod.Options.Help where +module GhcMod.Options.Help where import Options.Applicative import Options.Applicative.Help.Pretty (Doc) diff --git a/core/Language/Haskell/GhcMod/Options/Options.hs b/core/GhcMod/Options/Options.hs similarity index 96% rename from core/Language/Haskell/GhcMod/Options/Options.hs rename to core/GhcMod/Options/Options.hs index 34d6fe0..551f925 100644 --- a/core/Language/Haskell/GhcMod/Options/Options.hs +++ b/core/GhcMod/Options/Options.hs @@ -16,20 +16,20 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -module Language.Haskell.GhcMod.Options.Options ( +module GhcMod.Options.Options ( globalArgSpec , parseCmdLineOptions ) where import Options.Applicative import Options.Applicative.Types -import Language.Haskell.GhcMod.Types +import GhcMod.Types import Control.Arrow import Data.Char (toUpper, toLower) import Data.List (intercalate) -import Language.Haskell.GhcMod.Read -import Language.Haskell.GhcMod.Options.DocUtils -import Language.Haskell.GhcMod.Options.Help +import GhcMod.Read +import GhcMod.Options.DocUtils +import GhcMod.Options.Help import Data.Monoid import Prelude diff --git a/core/Language/Haskell/GhcMod/Output.hs b/core/GhcMod/Output.hs similarity index 97% rename from core/Language/Haskell/GhcMod/Output.hs rename to core/GhcMod/Output.hs index 9a02b1c..0d39398 100644 --- a/core/Language/Haskell/GhcMod/Output.hs +++ b/core/GhcMod/Output.hs @@ -18,7 +18,7 @@ -- Copyright (c) The University of Glasgow 2004-2008 {-# LANGUAGE FlexibleInstances #-} -module Language.Haskell.GhcMod.Output ( +module GhcMod.Output ( gmPutStr , gmErrStr , gmPutStrLn @@ -53,9 +53,9 @@ import Pipes import Pipes.Lift import Prelude -import Language.Haskell.GhcMod.Types hiding (LineSeparator, MonadIO(..)) -import Language.Haskell.GhcMod.Monad.Types hiding (MonadIO(..)) -import Language.Haskell.GhcMod.Gap () +import GhcMod.Types hiding (LineSeparator, MonadIO(..)) +import GhcMod.Monad.Types hiding (MonadIO(..)) +import GhcMod.Gap () class ProcessOutput a where hGetContents' :: Handle -> IO a diff --git a/core/Language/Haskell/GhcMod/PathsAndFiles.hs b/core/GhcMod/PathsAndFiles.hs similarity index 96% rename from core/Language/Haskell/GhcMod/PathsAndFiles.hs rename to core/GhcMod/PathsAndFiles.hs index dcb982e..c55987c 100644 --- a/core/Language/Haskell/GhcMod/PathsAndFiles.hs +++ b/core/GhcMod/PathsAndFiles.hs @@ -14,9 +14,9 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.PathsAndFiles ( - module Language.Haskell.GhcMod.PathsAndFiles - , module Language.Haskell.GhcMod.Caching +module GhcMod.PathsAndFiles ( + module GhcMod.PathsAndFiles + , module GhcMod.Caching ) where import Config (cProjectVersion) @@ -34,9 +34,9 @@ import System.Directory import System.FilePath import System.Process -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Caching -import qualified Language.Haskell.GhcMod.Utils as U +import GhcMod.Types +import GhcMod.Caching +import qualified GhcMod.Utils as U import Utils (mightExist) import Prelude diff --git a/core/Language/Haskell/GhcMod/Pretty.hs b/core/GhcMod/Pretty.hs similarity index 94% rename from core/Language/Haskell/GhcMod/Pretty.hs rename to core/GhcMod/Pretty.hs index 35718a8..9f6145b 100644 --- a/core/Language/Haskell/GhcMod/Pretty.hs +++ b/core/GhcMod/Pretty.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.Pretty +module GhcMod.Pretty ( renderGm , renderSDoc , gmComponentNameDoc @@ -35,9 +35,9 @@ import Pretty import GHC import Outputable (SDoc, withPprStyleDoc) -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Doc -import Language.Haskell.GhcMod.Gap (renderGm) +import GhcMod.Types +import GhcMod.Doc +import GhcMod.Gap (renderGm) renderSDoc :: GhcMonad m => SDoc -> m Doc renderSDoc sdoc = do diff --git a/core/Language/Haskell/GhcMod/Read.hs b/core/GhcMod/Read.hs similarity index 99% rename from core/Language/Haskell/GhcMod/Read.hs rename to core/GhcMod/Read.hs index 21b5b65..3297f51 100644 --- a/core/Language/Haskell/GhcMod/Read.hs +++ b/core/GhcMod/Read.hs @@ -1,4 +1,4 @@ -module Language.Haskell.GhcMod.Read where +module GhcMod.Read where import Text.Read (readPrec_to_S, readPrec, minPrec) import qualified Text.ParserCombinators.ReadP as P diff --git a/core/Language/Haskell/GhcMod/SrcUtils.hs b/core/GhcMod/SrcUtils.hs similarity index 97% rename from core/Language/Haskell/GhcMod/SrcUtils.hs rename to core/GhcMod/SrcUtils.hs index 5829fde..30999f3 100644 --- a/core/Language/Haskell/GhcMod/SrcUtils.hs +++ b/core/GhcMod/SrcUtils.hs @@ -2,7 +2,7 @@ {-# LANGUAGE CPP, TupleSections, FlexibleInstances, Rank2Types #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Language.Haskell.GhcMod.SrcUtils where +module GhcMod.SrcUtils where import Control.Applicative import CoreUtils (exprType) @@ -17,9 +17,9 @@ import qualified Type as G import GHC.SYB.Utils import GhcMonad import qualified Language.Haskell.Exts as HE -import Language.Haskell.GhcMod.Doc -import Language.Haskell.GhcMod.Gap -import qualified Language.Haskell.GhcMod.Gap as Gap +import GhcMod.Doc +import GhcMod.Gap +import qualified GhcMod.Gap as Gap import OccName (OccName) import Outputable (PprStyle) import TcHsSyn (hsPatType) diff --git a/core/Language/Haskell/GhcMod/Stack.hs b/core/GhcMod/Stack.hs similarity index 92% rename from core/Language/Haskell/GhcMod/Stack.hs rename to core/GhcMod/Stack.hs index e733c88..0c0ada0 100644 --- a/core/Language/Haskell/GhcMod/Stack.hs +++ b/core/GhcMod/Stack.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module Language.Haskell.GhcMod.Stack where +module GhcMod.Stack where import Safe import Control.Applicative @@ -30,12 +30,12 @@ import System.FilePath import System.Info.Extra import Exception -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Output -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Error -import qualified Language.Haskell.GhcMod.Utils as U +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Output +import GhcMod.Logging +import GhcMod.Error +import qualified GhcMod.Utils as U import Prelude patchStackPrograms :: (IOish m, GmOut m) => Cradle -> Programs -> m Programs diff --git a/core/Language/Haskell/GhcMod/Target.hs b/core/GhcMod/Target.hs similarity index 96% rename from core/Language/Haskell/GhcMod/Target.hs rename to core/GhcMod/Target.hs index f0eeeb6..1b61f9e 100644 --- a/core/Language/Haskell/GhcMod/Target.hs +++ b/core/GhcMod/Target.hs @@ -15,7 +15,7 @@ -- along with this program. If not, see . {-# LANGUAGE CPP, ViewPatterns, NamedFieldPuns, RankNTypes #-} -module Language.Haskell.GhcMod.Target where +module GhcMod.Target where import Control.Arrow import Control.Applicative @@ -30,20 +30,20 @@ import DynFlags import HscTypes import Pretty -import Language.Haskell.GhcMod.DynFlags -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.HomeModuleGraph -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.GhcPkg -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Utils as U -import Language.Haskell.GhcMod.FileMapping -import Language.Haskell.GhcMod.LightGhc -import Language.Haskell.GhcMod.CustomPackageDb -import Language.Haskell.GhcMod.Output +import GhcMod.DynFlags +import GhcMod.Monad.Types +import GhcMod.CabalHelper +import GhcMod.HomeModuleGraph +import GhcMod.PathsAndFiles +import GhcMod.GhcPkg +import GhcMod.Error +import GhcMod.Logging +import GhcMod.Types +import GhcMod.Utils as U +import GhcMod.FileMapping +import GhcMod.LightGhc +import GhcMod.CustomPackageDb +import GhcMod.Output import Safe import Data.Maybe diff --git a/core/Language/Haskell/GhcMod/Types.hs b/core/GhcMod/Types.hs similarity index 98% rename from core/Language/Haskell/GhcMod/Types.hs rename to core/GhcMod/Types.hs index 4836abb..7eccdac 100644 --- a/core/Language/Haskell/GhcMod/Types.hs +++ b/core/GhcMod/Types.hs @@ -2,8 +2,8 @@ StandaloneDeriving, DefaultSignatures, FlexibleInstances, TemplateHaskell, GeneralizedNewtypeDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-deprecations #-} -module Language.Haskell.GhcMod.Types ( - module Language.Haskell.GhcMod.Types +module GhcMod.Types ( + module GhcMod.Types , ModuleName , mkModuleName , moduleNameString @@ -40,7 +40,7 @@ import GHC.Generics import Pretty (Doc) import Prelude -import Language.Haskell.GhcMod.Caching.Types +import GhcMod.Caching.Types -- | A constraint alias (-XConstraintKinds) to make functions dealing with -- 'GhcModT' somewhat cleaner. diff --git a/core/Language/Haskell/GhcMod/Utils.hs b/core/GhcMod/Utils.hs similarity index 96% rename from core/Language/Haskell/GhcMod/Utils.hs rename to core/GhcMod/Utils.hs index c923750..38062b6 100644 --- a/core/Language/Haskell/GhcMod/Utils.hs +++ b/core/GhcMod/Utils.hs @@ -17,8 +17,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} -module Language.Haskell.GhcMod.Utils ( - module Language.Haskell.GhcMod.Utils +module GhcMod.Utils ( + module GhcMod.Utils , module Utils , readProcess ) where @@ -30,9 +30,9 @@ import Data.Maybe (fromMaybe) import Data.Either (rights) import Data.List (inits) import Exception -import Language.Haskell.GhcMod.Error -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types +import GhcMod.Error +import GhcMod.Types +import GhcMod.Monad.Types import System.Directory import System.Environment import System.FilePath diff --git a/core/Language/Haskell/GhcMod/World.hs b/core/GhcMod/World.hs similarity index 86% rename from core/Language/Haskell/GhcMod/World.hs rename to core/GhcMod/World.hs index d166b49..374a1d5 100644 --- a/core/Language/Haskell/GhcMod/World.hs +++ b/core/GhcMod/World.hs @@ -1,10 +1,10 @@ -module Language.Haskell.GhcMod.World where +module GhcMod.World where -import Language.Haskell.GhcMod.GhcPkg -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.Types -import Language.Haskell.GhcMod.Monad.Types -import Language.Haskell.GhcMod.Utils +import GhcMod.GhcPkg +import GhcMod.PathsAndFiles +import GhcMod.Types +import GhcMod.Monad.Types +import GhcMod.Utils import Control.Applicative import Data.Maybe diff --git a/ghc-mod.cabal b/ghc-mod.cabal index fb05305..edc6a95 100644 --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -30,7 +30,7 @@ Data-Files: elisp/Makefile elisp/*.el Extra-Source-Files: ChangeLog README.md - core/Language/Haskell/GhcMod/Monad/Compat.hs_h + core/GhcMod/Monad/Compat.hs_h test/data/annotations/*.hs test/data/broken-cabal/*.cabal test/data/broken-sandbox/cabal.sandbox.config @@ -110,60 +110,60 @@ Library HS-Source-Dirs: ., core, shared Exposed-Modules: GhcMod - GhcModExe.Boot - GhcModExe.Browse - GhcModExe.CaseSplit - GhcModExe.Check - GhcModExe.Debug - GhcModExe.FillSig - GhcModExe.Find - GhcModExe.Flag - GhcModExe.Info - GhcModExe.Internal - GhcModExe.Lang - GhcModExe.Lint - GhcModExe.Modules - GhcModExe.PkgDoc - GhcModExe.Test - Language.Haskell.GhcMod.CabalHelper - Language.Haskell.GhcMod.Caching - Language.Haskell.GhcMod.Caching.Types - Language.Haskell.GhcMod.Convert - Language.Haskell.GhcMod.Cradle - Language.Haskell.GhcMod.CustomPackageDb - Language.Haskell.GhcMod.DebugLogger - Language.Haskell.GhcMod.Doc - Language.Haskell.GhcMod.DynFlags - Language.Haskell.GhcMod.DynFlagsTH - Language.Haskell.GhcMod.Error - Language.Haskell.GhcMod.FileMapping - Language.Haskell.GhcMod.Gap - Language.Haskell.GhcMod.GhcPkg - Language.Haskell.GhcMod.HomeModuleGraph - Language.Haskell.GhcMod.LightGhc - Language.Haskell.GhcMod.Logger - Language.Haskell.GhcMod.Logging - Language.Haskell.GhcMod.Monad - Language.Haskell.GhcMod.Monad.Env - Language.Haskell.GhcMod.Monad.Log - Language.Haskell.GhcMod.Monad.Newtypes - Language.Haskell.GhcMod.Monad.Orphans - Language.Haskell.GhcMod.Monad.Out - Language.Haskell.GhcMod.Monad.State - Language.Haskell.GhcMod.Monad.Types - Language.Haskell.GhcMod.Options.DocUtils - Language.Haskell.GhcMod.Options.Help - Language.Haskell.GhcMod.Options.Options - Language.Haskell.GhcMod.Output - Language.Haskell.GhcMod.PathsAndFiles - Language.Haskell.GhcMod.Pretty - Language.Haskell.GhcMod.Read - Language.Haskell.GhcMod.SrcUtils - Language.Haskell.GhcMod.Stack - Language.Haskell.GhcMod.Target - Language.Haskell.GhcMod.Types - Language.Haskell.GhcMod.Utils - Language.Haskell.GhcMod.World + GhcMod.Exe.Boot + GhcMod.Exe.Browse + GhcMod.Exe.CaseSplit + GhcMod.Exe.Check + GhcMod.Exe.Debug + GhcMod.Exe.FillSig + GhcMod.Exe.Find + GhcMod.Exe.Flag + GhcMod.Exe.Info + GhcMod.Exe.Internal + GhcMod.Exe.Lang + GhcMod.Exe.Lint + GhcMod.Exe.Modules + GhcMod.Exe.PkgDoc + GhcMod.Exe.Test + GhcMod.CabalHelper + GhcMod.Caching + GhcMod.Caching.Types + GhcMod.Convert + GhcMod.Cradle + GhcMod.CustomPackageDb + GhcMod.DebugLogger + GhcMod.Doc + GhcMod.DynFlags + GhcMod.DynFlagsTH + GhcMod.Error + GhcMod.FileMapping + GhcMod.Gap + GhcMod.GhcPkg + GhcMod.HomeModuleGraph + GhcMod.LightGhc + GhcMod.Logger + GhcMod.Logging + GhcMod.Monad + GhcMod.Monad.Env + GhcMod.Monad.Log + GhcMod.Monad.Newtypes + GhcMod.Monad.Orphans + GhcMod.Monad.Out + GhcMod.Monad.State + GhcMod.Monad.Types + GhcMod.Options.DocUtils + GhcMod.Options.Help + GhcMod.Options.Options + GhcMod.Output + GhcMod.PathsAndFiles + GhcMod.Pretty + GhcMod.Read + GhcMod.SrcUtils + GhcMod.Stack + GhcMod.Target + GhcMod.Types + GhcMod.Utils + GhcMod.World Other-Modules: Paths_ghc_mod Utils Data.Binary.Generic @@ -213,12 +213,12 @@ Library Executable ghc-mod Default-Language: Haskell2010 - Main-Is: GHCModMain.hs + Main-Is: GhcModMain.hs Other-Modules: Paths_ghc_mod - , GHCMod.Options - , GHCMod.Options.Commands - , GHCMod.Version - , GHCMod.Options.ShellParse + , GhcMod.Exe.Options + , GhcMod.Exe.Options.Commands + , GhcMod.Exe.Version + , GhcMod.Exe.Options.ShellParse GHC-Options: -Wall -fno-warn-deprecations -threaded Default-Extensions: ConstraintKinds, FlexibleContexts HS-Source-Dirs: src, shared @@ -243,7 +243,7 @@ Executable ghc-mod Executable ghc-modi Default-Language: Haskell2010 - Main-Is: GHCModi.hs + Main-Is: GhcModi.hs Other-Modules: Paths_ghc_mod Utils System.Directory.ModTime diff --git a/src/GHCMod/Options.hs b/src/GhcMod/Exe/Options.hs similarity index 89% rename from src/GHCMod/Options.hs rename to src/GhcMod/Exe/Options.hs index 8549fbd..936dd97 100644 --- a/src/GHCMod/Options.hs +++ b/src/GhcMod/Exe/Options.hs @@ -16,7 +16,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -module GHCMod.Options ( +module GhcMod.Exe.Options ( parseArgs, parseArgsInteractive, GhcModCommands(..) @@ -25,12 +25,12 @@ module GHCMod.Options ( import Options.Applicative import Options.Applicative.Types -import GHCMod.Options.Commands -import GHCMod.Options.ShellParse -import GHCMod.Version -import Language.Haskell.GhcMod.Options.DocUtils -import Language.Haskell.GhcMod.Options.Options -import Language.Haskell.GhcMod.Types +import GhcMod.Exe.Options.Commands +import GhcMod.Exe.Options.ShellParse +import GhcMod.Exe.Version +import GhcMod.Options.DocUtils +import GhcMod.Options.Options +import GhcMod.Types parseArgs :: IO (Options, GhcModCommands) parseArgs = diff --git a/src/GHCMod/Options/Commands.hs b/src/GhcMod/Exe/Options/Commands.hs similarity index 98% rename from src/GHCMod/Options/Commands.hs rename to src/GhcMod/Exe/Options/Commands.hs index cc9f64f..cd8ef55 100644 --- a/src/GHCMod/Options/Commands.hs +++ b/src/GhcMod/Exe/Options/Commands.hs @@ -16,16 +16,16 @@ {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -module GHCMod.Options.Commands where +module GhcMod.Exe.Options.Commands where 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 GhcMod.Types +import GhcMod.Read +import GhcMod.Options.DocUtils +import GhcMod.Options.Help type Symbol = String type Expr = String diff --git a/src/GHCMod/Options/ShellParse.hs b/src/GhcMod/Exe/Options/ShellParse.hs similarity index 96% rename from src/GHCMod/Options/ShellParse.hs rename to src/GhcMod/Exe/Options/ShellParse.hs index 6a74dc2..e9c73d7 100644 --- a/src/GHCMod/Options/ShellParse.hs +++ b/src/GhcMod/Exe/Options/ShellParse.hs @@ -13,7 +13,7 @@ -- -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module GHCMod.Options.ShellParse (parseCmdLine) where +module GhcMod.Exe.Options.ShellParse (parseCmdLine) where import Data.Char import Data.List diff --git a/src/GHCMod/Version.hs b/src/GhcMod/Exe/Version.hs similarity index 97% rename from src/GHCMod/Version.hs rename to src/GhcMod/Exe/Version.hs index c151c04..b27e8c0 100644 --- a/src/GHCMod/Version.hs +++ b/src/GhcMod/Exe/Version.hs @@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program. If not, see . -module GHCMod.Version where +module GhcMod.Exe.Version where import Paths_ghc_mod import Data.Version (showVersion) diff --git a/src/GHCModMain.hs b/src/GhcModMain.hs similarity index 96% rename from src/GHCModMain.hs rename to src/GhcModMain.hs index 2e74b3d..d4c0116 100644 --- a/src/GHCModMain.hs +++ b/src/GhcModMain.hs @@ -7,7 +7,7 @@ import Control.Monad import Data.Typeable (Typeable) import Data.List import Data.List.Split -import Language.Haskell.GhcMod.Pretty +import GhcMod.Pretty import System.FilePath (()) import System.Directory (setCurrentDirectory, getAppUserDataDirectory, removeDirectoryRecursive) @@ -15,12 +15,12 @@ import System.IO import System.Exit import Prelude -import GHCMod.Options import GhcMod -import GhcModExe.Find -import GhcModExe.Internal hiding (MonadIO,liftIO) -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Types +import GhcMod.Exe.Find +import GhcMod.Exe.Options +import GhcMod.Exe.Internal hiding (MonadIO,liftIO) +import GhcMod.Monad +import GhcMod.Types import Exception diff --git a/src/GHCModi.hs b/src/GhcModi.hs similarity index 100% rename from src/GHCModi.hs rename to src/GhcModi.hs diff --git a/test/CabalHelperSpec.hs b/test/CabalHelperSpec.hs index 1645c81..c14ed38 100644 --- a/test/CabalHelperSpec.hs +++ b/test/CabalHelperSpec.hs @@ -4,9 +4,9 @@ module CabalHelperSpec where import Control.Arrow import Control.Applicative import Distribution.Helper -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.Error +import GhcMod.CabalHelper +import GhcMod.PathsAndFiles +import GhcMod.Error import Test.Hspec import System.Directory import System.FilePath diff --git a/test/CradleSpec.hs b/test/CradleSpec.hs index c62a589..02c6d5b 100644 --- a/test/CradleSpec.hs +++ b/test/CradleSpec.hs @@ -2,8 +2,8 @@ module CradleSpec where import Control.Applicative import Data.List (isSuffixOf) -import Language.Haskell.GhcMod.Cradle -import Language.Haskell.GhcMod.Types +import GhcMod.Cradle +import GhcMod.Types import System.Directory (canonicalizePath) import System.FilePath (pathSeparator) import Test.Hspec diff --git a/test/CustomPackageDbSpec.hs b/test/CustomPackageDbSpec.hs index c19c193..f25d59a 100644 --- a/test/CustomPackageDbSpec.hs +++ b/test/CustomPackageDbSpec.hs @@ -1,8 +1,8 @@ module CustomPackageDbSpec where -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.CustomPackageDb -import Language.Haskell.GhcMod.Error +import GhcMod.CabalHelper +import GhcMod.CustomPackageDb +import GhcMod.Error import System.Process import Test.Hspec import Prelude diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs index 5b50e6c..aec284d 100644 --- a/test/FileMappingSpec.hs +++ b/test/FileMappingSpec.hs @@ -1,7 +1,7 @@ module FileMappingSpec where -import Language.Haskell.GhcMod.FileMapping -import Language.Haskell.GhcMod.Utils (withMappedFile) +import GhcMod.FileMapping +import GhcMod.Utils (withMappedFile) import Test.Hspec import TestUtils import qualified Data.Map as M diff --git a/test/FindSpec.hs b/test/FindSpec.hs index 2ccf346..b98376a 100644 --- a/test/FindSpec.hs +++ b/test/FindSpec.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module FindSpec where -import GhcModExe.Find +import GhcMod.Exe.Find import Test.Hspec import TestUtils diff --git a/test/GhcPkgSpec.hs b/test/GhcPkgSpec.hs index 69d9661..19a1604 100644 --- a/test/GhcPkgSpec.hs +++ b/test/GhcPkgSpec.hs @@ -1,8 +1,8 @@ module GhcPkgSpec where -import Language.Haskell.GhcMod.GhcPkg -import Language.Haskell.GhcMod.CabalHelper -import Language.Haskell.GhcMod.CustomPackageDb +import GhcMod.GhcPkg +import GhcMod.CabalHelper +import GhcMod.CustomPackageDb import Test.Hspec import System.Process (system) diff --git a/test/HomeModuleGraphSpec.hs b/test/HomeModuleGraphSpec.hs index 9e10987..8f534e1 100644 --- a/test/HomeModuleGraphSpec.hs +++ b/test/HomeModuleGraphSpec.hs @@ -18,8 +18,8 @@ module HomeModuleGraphSpec where -import Language.Haskell.GhcMod.HomeModuleGraph -import Language.Haskell.GhcMod.LightGhc +import GhcMod.HomeModuleGraph +import GhcMod.LightGhc import TestUtils import GHC diff --git a/test/PathsAndFilesSpec.hs b/test/PathsAndFilesSpec.hs index d3611f1..cd0f6d5 100644 --- a/test/PathsAndFilesSpec.hs +++ b/test/PathsAndFilesSpec.hs @@ -1,9 +1,9 @@ module PathsAndFilesSpec where -import Language.Haskell.GhcMod.PathsAndFiles -import Language.Haskell.GhcMod.Cradle -import qualified Language.Haskell.GhcMod.Utils as U +import GhcMod.PathsAndFiles +import GhcMod.Cradle +import qualified GhcMod.Utils as U import Control.Monad.Trans.Maybe import System.Directory diff --git a/test/ShellParseSpec.hs b/test/ShellParseSpec.hs index 2c5cefe..751f404 100644 --- a/test/ShellParseSpec.hs +++ b/test/ShellParseSpec.hs @@ -1,7 +1,7 @@ module ShellParseSpec where -import GHCMod.Options.ShellParse +import GhcMod.Exe.Options.ShellParse import Test.Hspec diff --git a/test/TargetSpec.hs b/test/TargetSpec.hs index f5ceef2..dcc2362 100644 --- a/test/TargetSpec.hs +++ b/test/TargetSpec.hs @@ -1,9 +1,9 @@ {-# LANGUAGE OverloadedStrings #-} module TargetSpec where -import Language.Haskell.GhcMod.Target -import Language.Haskell.GhcMod.LightGhc -import Language.Haskell.GhcMod.Gap +import GhcMod.Target +import GhcMod.LightGhc +import GhcMod.Gap import Test.Hspec import TestUtils diff --git a/test/TestUtils.hs b/test/TestUtils.hs index af5367b..3d252f1 100644 --- a/test/TestUtils.hs +++ b/test/TestUtils.hs @@ -10,14 +10,14 @@ module TestUtils ( , shouldReturnError , isPkgDbAt , isPkgConfDAt - , module Language.Haskell.GhcMod.Monad - , module Language.Haskell.GhcMod.Types + , module GhcMod.Monad + , module GhcMod.Types ) where -import Language.Haskell.GhcMod.Logging -import Language.Haskell.GhcMod.Monad -import Language.Haskell.GhcMod.Cradle -import Language.Haskell.GhcMod.Types +import GhcMod.Logging +import GhcMod.Monad +import GhcMod.Cradle +import GhcMod.Types import Control.Arrow import Control.Category