ghc-mod 5.0.1.2 → 5.1.0.0
raw patch · 33 files changed
+449/−180 lines, 33 filesdep +asyncdep ~ghc-syb-utilsdep ~monad-journaldep ~text
Dependencies added: async
Dependency ranges changed: ghc-syb-utils, monad-journal, text
Files
- ChangeLog +10/−0
- Language/Haskell/GhcMod.hs +1/−1
- Language/Haskell/GhcMod/Boot.hs +1/−1
- Language/Haskell/GhcMod/Browse.hs +1/−1
- Language/Haskell/GhcMod/Cabal21.hs +73/−0
- Language/Haskell/GhcMod/CabalApi.hs +12/−9
- Language/Haskell/GhcMod/CabalConfig.hs +52/−12
- Language/Haskell/GhcMod/Debug.hs +1/−1
- Language/Haskell/GhcMod/DynFlags.hs +11/−11
- Language/Haskell/GhcMod/Error.hs +41/−0
- Language/Haskell/GhcMod/Find.hs +9/−8
- Language/Haskell/GhcMod/GHCApi.hs +1/−1
- Language/Haskell/GhcMod/Internal.hs +1/−0
- Language/Haskell/GhcMod/List.hs +0/−32
- Language/Haskell/GhcMod/Modules.hs +32/−0
- Language/Haskell/GhcMod/Monad.hs +40/−22
- Language/Haskell/GhcMod/PkgDoc.hs +5/−4
- Language/Haskell/GhcMod/SrcUtils.hs +4/−1
- Language/Haskell/GhcMod/Target.hs +9/−5
- Language/Haskell/GhcMod/Types.hs +10/−13
- Language/Haskell/GhcMod/Utils.hs +8/−27
- elisp/ghc.el +1/−1
- ghc-mod.cabal +10/−4
- src/GHCMod.hs +10/−1
- src/GHCModi.hs +15/−18
- test/CabalApiSpec.hs +20/−7
- test/CheckSpec.hs +8/−0
- test/MonadSpec.hs +10/−0
- test/data/cabal-flags/cabal-flags.cabal +14/−0
- test/data/pattern-synonyms/A.hs +6/−0
- test/data/pattern-synonyms/B.hs +7/−0
- test/data/pattern-synonyms/Setup.hs +2/−0
- test/data/pattern-synonyms/pattern-synonyms.cabal +24/−0
ChangeLog view
@@ -1,3 +1,13 @@+2014-09-12 v5.1.0.0+ * GhcModError is now a recursive data type (`GMECabalConfigure`'s+ type changed)+ * GhcModT's MonadIO instance now converts IOError's to failures in+ the ErrorT part of GhcModT on `liftIO`.+ * Make `loadSymbolDb` polimorphic in the return types's monad.+ * Add `hoistGhcModT` to Language.Haskell.GhcMod.Internal+ * Fix `check` command for modules using `-XPatternSynonyms`+ * Merge #364, Support cabal configuration flags+ 2014-08-29 v5.0.1.2 * Merge #345, Try fixing duplicate errors * Merge #344, elisp: Use advice to check syntax on save-buffer
Language/Haskell/GhcMod.hs view
@@ -60,7 +60,7 @@ import Language.Haskell.GhcMod.Info import Language.Haskell.GhcMod.Lang import Language.Haskell.GhcMod.Lint-import Language.Haskell.GhcMod.List import Language.Haskell.GhcMod.Monad+import Language.Haskell.GhcMod.Modules import Language.Haskell.GhcMod.PkgDoc import Language.Haskell.GhcMod.Types
Language/Haskell/GhcMod/Boot.hs view
@@ -4,8 +4,8 @@ import Language.Haskell.GhcMod.Browse import Language.Haskell.GhcMod.Flag import Language.Haskell.GhcMod.Lang-import Language.Haskell.GhcMod.List import Language.Haskell.GhcMod.Monad+import Language.Haskell.GhcMod.Modules -- | Printing necessary information for front-end booting. boot :: IOish m => GhcModT m String
Language/Haskell/GhcMod/Browse.hs view
@@ -14,7 +14,7 @@ import Language.Haskell.GhcMod.Convert import Language.Haskell.GhcMod.Doc (showPage, styleUnqualified) import Language.Haskell.GhcMod.Gap-import Language.Haskell.GhcMod.Monad (IOish, GhcModT, options)+import Language.Haskell.GhcMod.Monad (GhcModT, options) import Language.Haskell.GhcMod.Target (setTargetFiles) import Language.Haskell.GhcMod.Types import Name (getOccString)
+ Language/Haskell/GhcMod/Cabal21.hs view
@@ -0,0 +1,73 @@+-- Copyright : Isaac Jones 2003-2004+{- All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Isaac Jones nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}++-- | ComponentLocalBuildInfo for Cabal >= 1.21+module Language.Haskell.GhcMod.Cabal21 (+ ComponentLocalBuildInfo+ , PackageIdentifier(..)+ , PackageName(..)+ , componentPackageDeps+ , componentLibraries+ ) where++import Distribution.Package (InstalledPackageId)+import Data.Version (Version)++data LibraryName = LibraryName String+ deriving (Read, Show)++newtype PackageName = PackageName { unPackageName :: String }+ deriving (Read, Show)++data PackageIdentifier+ = PackageIdentifier {+ pkgName :: PackageName,+ pkgVersion :: Version+ }+ deriving (Read, Show)++type PackageId = PackageIdentifier++data ComponentLocalBuildInfo+ = LibComponentLocalBuildInfo {+ componentPackageDeps :: [(InstalledPackageId, PackageId)],+ componentLibraries :: [LibraryName]+ }+ | ExeComponentLocalBuildInfo {+ componentPackageDeps :: [(InstalledPackageId, PackageId)]+ }+ | TestComponentLocalBuildInfo {+ componentPackageDeps :: [(InstalledPackageId, PackageId)]+ }+ | BenchComponentLocalBuildInfo {+ componentPackageDeps :: [(InstalledPackageId, PackageId)]+ }+ deriving (Read, Show)
Language/Haskell/GhcMod/CabalApi.hs view
@@ -11,16 +11,16 @@ ) where import Language.Haskell.GhcMod.CabalConfig+import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Gap (benchmarkBuildInfo, benchmarkTargets, toModuleString) import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Types -import MonadUtils (MonadIO, liftIO)+import MonadUtils (liftIO) import Control.Applicative ((<$>)) import qualified Control.Exception as E import Control.Monad (filterM)-import Control.Monad.Error.Class (Error, MonadError(..)) import Data.Maybe (maybeToList) import Data.Set (fromList, toList) import Distribution.Package (Dependency(Dependency)@@ -42,7 +42,7 @@ ---------------------------------------------------------------- -- | Getting necessary 'CompilerOptions' from three information sources.-getCompilerOptions :: (MonadIO m, MonadError GhcModError m, Functor m)+getCompilerOptions :: (IOish m, MonadError GhcModError m) => [GHCOption] -> Cradle -> PackageDescription@@ -73,20 +73,22 @@ ---------------------------------------------------------------- -- | Parse a cabal file and return a 'PackageDescription'.-parseCabalFile :: (MonadIO m, Error e, MonadError e m)- => FilePath+parseCabalFile :: (IOish m, MonadError GhcModError m)+ => Cradle+ -> FilePath -> m PackageDescription-parseCabalFile file = do+parseCabalFile cradle file = do cid <- liftIO getGHCId epgd <- liftIO $ readPackageDescription silent file- case toPkgDesc cid epgd of+ flags <- cabalConfigFlags cradle+ case toPkgDesc cid flags epgd of Left deps -> fail $ show deps ++ " are not installed" Right (pd,_) -> if nullPkg pd then fail $ file ++ " is broken" else return pd where- toPkgDesc cid =- finalizePackageDescription [] (const True) buildPlatform cid []+ toPkgDesc cid flags =+ finalizePackageDescription flags (const True) buildPlatform cid [] nullPkg pd = name == "" where PackageName name = C.pkgName (P.package pd)@@ -155,6 +157,7 @@ getGHC = do mv <- programFindVersion ghcProgram silent (programName ghcProgram) case mv of+ -- TODO: MonadError it up Nothing -> E.throwIO $ userError "ghc not found" Just v -> return v
Language/Haskell/GhcMod/CabalConfig.hs view
@@ -5,8 +5,10 @@ module Language.Haskell.GhcMod.CabalConfig ( CabalConfig , cabalConfigDependencies+ , cabalConfigFlags ) where +import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Utils import Language.Haskell.GhcMod.Read@@ -14,28 +16,30 @@ import qualified Language.Haskell.GhcMod.Cabal16 as C16 import qualified Language.Haskell.GhcMod.Cabal18 as C18+import qualified Language.Haskell.GhcMod.Cabal21 as C21 #ifndef MIN_VERSION_mtl #define MIN_VERSION_mtl(x,y,z) 1 #endif import Control.Applicative ((<$>))-import Control.Monad (mplus,void)+import Control.Monad (mplus) #if MIN_VERSION_mtl(2,2,1) import Control.Monad.Except () #else import Control.Monad.Error () #endif-import Control.Monad.Error (MonadError(..)) import Data.Maybe () import Data.Set () import Data.List (find,tails,isPrefixOf,isInfixOf,nub,stripPrefix) import Distribution.Package (InstalledPackageId(..)- , PackageIdentifier)+ , PackageIdentifier(..)+ , PackageName(..))+import Distribution.PackageDescription (FlagAssignment) import Distribution.Simple.BuildPaths (defaultDistPref) import Distribution.Simple.Configure (localBuildInfoFile) import Distribution.Simple.LocalBuildInfo (ComponentName)-import MonadUtils (MonadIO)+import MonadUtils (liftIO) import System.FilePath ((</>)) ----------------------------------------------------------------@@ -46,24 +50,26 @@ -- | Get contents of the file containing 'LocalBuildInfo' data. If it doesn't -- exist run @cabal configure@ i.e. configure with default options like @cabal -- build@ would do.-getConfig :: (MonadIO m, MonadError GhcModError m)+getConfig :: (IOish m, MonadError GhcModError m) => Cradle -> m CabalConfig-getConfig cradle = tryFix (liftIOExceptions (readFile path)) $ \_ ->- rethrowError (GMECabalConfigure . gmeMsg) configure+getConfig cradle = liftIO (readFile path) `tryFix` \_ ->+ configure `modifyError'` GMECabalConfigure where prjDir = cradleRootDir cradle path = prjDir </> configPath- configure = liftIOExceptions $ void $- withDirectory_ prjDir $ readProcess' "cabal" ["configure"] + configure :: (IOish m, MonadError GhcModError m) => m ()+ configure =+ withDirectory_ prjDir $ readProcess' "cabal" ["configure"] >> return () + -- | Path to 'LocalBuildInfo' file, usually @dist/setup-config@ configPath :: FilePath configPath = localBuildInfoFile defaultDistPref -- | Get list of 'Package's needed by all components of the current package-cabalConfigDependencies :: (MonadIO m, Functor m, MonadError GhcModError m)+cabalConfigDependencies :: (IOish m, MonadError GhcModError m) => Cradle -> PackageIdentifier -> m [Package]@@ -75,7 +81,7 @@ configDependencies thisPkg config = map fromInstalledPackageId deps where deps :: [InstalledPackageId]- deps = case deps18 `mplus` deps16 of+ deps = case deps21 `mplus` deps18 `mplus` deps16 of Right ps -> ps Left msg -> error msg @@ -83,7 +89,27 @@ -- defined in the same package). internal pkgid = pkgid == thisPkg - -- Cabal >= 1.18+ -- Cabal >= 1.21+ deps21 :: Either String [InstalledPackageId]+ deps21 =+ map fst+ <$> filterInternal21+ <$> (readEither =<< extractField config "componentsConfigs")++ filterInternal21+ :: [(ComponentName, C21.ComponentLocalBuildInfo, [ComponentName])]+ -> [(InstalledPackageId, C21.PackageIdentifier)]++ filterInternal21 ccfg = [ (ipkgid, pkgid)+ | (_,clbi,_) <- ccfg+ , (ipkgid, pkgid) <- C21.componentPackageDeps clbi+ , not (internal . packageIdentifierFrom21 $ pkgid) ]++ packageIdentifierFrom21 :: C21.PackageIdentifier -> PackageIdentifier+ packageIdentifierFrom21 (C21.PackageIdentifier (C21.PackageName myName) myVersion) =+ PackageIdentifier (PackageName myName) myVersion++ -- Cabal >= 1.18 && < 1.21 deps18 :: Either String [InstalledPackageId] deps18 = map fst@@ -127,6 +153,20 @@ readConfigs f s = case readEither s of Right x -> x Left msg -> error $ "reading config " ++ f ++ " failed ("++msg++")"++-- | Get the flag assignment from the local build info of the given cradle+cabalConfigFlags :: (IOish m, MonadError GhcModError m)+ => Cradle+ -> m FlagAssignment+cabalConfigFlags cradle = do+ config <- getConfig cradle+ case configFlags config of+ Right x -> return x+ Left msg -> throwError (GMECabalFlags (GMEString msg))++-- | Extract the cabal flags from the 'CabalConfig'+configFlags :: CabalConfig -> Either String FlagAssignment+configFlags config = readEither =<< flip extractField "configConfigurationsFlags" =<< extractField config "configFlags" -- | Find @field@ in 'CabalConfig'. Returns 'Left' containing a user readable -- error message with lots of context on failure.
Language/Haskell/GhcMod/Debug.hs view
@@ -31,7 +31,7 @@ simpleCompilerOption = options >>= \op -> return $ CompilerOptions (ghcUserOptions op) [] [] fromCabalFile c = options >>= \opts -> do- pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c+ pkgDesc <- parseCabalFile c $ fromJust $ cradleCabalFile c getCompilerOptions (ghcUserOptions opts) c pkgDesc ----------------------------------------------------------------
Language/Haskell/GhcMod/DynFlags.hs view
@@ -17,10 +17,10 @@ setEmptyLogger :: DynFlags -> DynFlags setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return () --- Fast--- Friendly to foreign export--- Not friendly to Template Haskell--- Uses small memory+-- * Fast+-- * Friendly to foreign export+-- * Not friendly to -XTemplateHaskell and -XPatternSynonyms+-- * Uses little memory setModeSimple :: DynFlags -> DynFlags setModeSimple df = df { ghcMode = CompManager@@ -29,10 +29,10 @@ , optLevel = 0 } --- Slow--- Not friendly to foreign export--- Friendly to Template Haskell--- Uses large memory+-- * Slow+-- * Not friendly to foreign export+-- * Friendly to -XTemplateHaskell and -XPatternSynonyms+-- * Uses lots of memory setModeIntelligent :: DynFlags -> DynFlags setModeIntelligent df = df { ghcMode = CompManager@@ -47,9 +47,9 @@ setBuildEnv :: Build -> DynFlags -> DynFlags setBuildEnv build = setHideAllPackages build . setCabalPackage build --- At the moment with this option set ghc only prints different error messages,--- suggesting the user to add a hidden package to the build-depends in his cabal--- file for example+-- | With ghc-7.8 this option simply makes GHC print a message suggesting users+-- add hiddend packages to the build-depends field in their cabal file when the+-- user tries to import a module form a hidden package. setCabalPackage :: Build -> DynFlags -> DynFlags setCabalPackage CabalPkg df = Gap.setCabalPkg df setCabalPackage _ df = df
+ Language/Haskell/GhcMod/Error.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE TypeFamilies, ScopedTypeVariables #-}+module Language.Haskell.GhcMod.Error (+ GhcModError(..)+ , modifyError+ , modifyError'+ , tryFix+ , module Control.Monad.Error+ , module Exception+ ) where++import Control.Monad.Error (MonadError(..), Error(..))+import Exception++data GhcModError = GMENoMsg+ -- ^ Unknown error+ | GMEString String+ -- ^ Some Error with a message. These are produced mostly by+ -- 'fail' calls on GhcModT.+ | GMECabalConfigure GhcModError+ -- ^ Configuring a cabal project failed.+ | GMECabalFlags GhcModError+ -- ^ Retrieval of the cabal configuration flags failed.+ | GMEProcess [String] GhcModError+ -- ^ Launching an operating system process failed. The first+ -- field is the command.+ deriving (Eq,Show)++instance Error GhcModError where+ noMsg = GMENoMsg+ strMsg = GMEString++modifyError :: MonadError e m => (e -> e) -> m a -> m a+modifyError f action = action `catchError` \e -> throwError $ f e++infixr 0 `modifyError'`+modifyError' :: MonadError e m => m a -> (e -> e) -> m a+modifyError' = flip modifyError++tryFix :: MonadError e m => m a -> (e -> m ()) -> m a+tryFix action fix = do+ action `catchError` \e -> fix e >> action
Language/Haskell/GhcMod/Find.hs view
@@ -16,7 +16,6 @@ import Config (cProjectVersion,cTargetPlatformString) import Control.Applicative ((<$>))-import Control.Exception (handle, SomeException(..)) import Control.Monad (when, void) import Control.Monad.Error.Class import Data.Function (on)@@ -78,7 +77,7 @@ -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\] -- which will be concatenated. 'loadSymbolDb' is called internally. findSymbol :: IOish m => Symbol -> GhcModT m String-findSymbol sym = liftIO loadSymbolDb >>= lookupSymbol sym+findSymbol sym = loadSymbolDb >>= lookupSymbol sym -- | Looking up 'SymbolDb' with 'Symbol' to \['ModuleString'\] -- which will be concatenated.@@ -91,7 +90,7 @@ --------------------------------------------------------------- -- | Loading a file and creates 'SymbolDb'.-loadSymbolDb :: IO SymbolDb+loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb loadSymbolDb = SymbolDb <$> readSymbolDb -- | Returns the path to the currently running ghc-mod executable. With ghc<7.6@@ -102,7 +101,9 @@ dir <- getExecutablePath' return $ dir </> "ghc-mod" #else-ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"+ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when+ -- compiling spec+ return "dist/build/ghc-mod/ghc-mod" #endif where getExecutablePath' :: IO FilePath@@ -112,11 +113,11 @@ getExecutablePath' = return "" # endif -readSymbolDb :: IO (Map Symbol [ModuleString])-readSymbolDb = handle (\(SomeException _) -> return M.empty) $ do- ghcMod <- ghcModExecutable+readSymbolDb :: (IOish m, MonadError GhcModError m) => m (Map Symbol [ModuleString])+readSymbolDb = do+ ghcMod <- liftIO ghcModExecutable file <- chop <$> readProcess' ghcMod ["dumpsym"]- M.fromAscList . map conv . lines <$> readFile file+ M.fromAscList . map conv . lines <$> liftIO (readFile file) where conv :: String -> (Symbol,[ModuleString]) conv = read
Language/Haskell/GhcMod/GHCApi.hs view
@@ -11,7 +11,7 @@ ) where import Language.Haskell.GhcMod.GhcPkg-import Language.Haskell.GhcMod.Monad (IOish, GhcModT)+import Language.Haskell.GhcMod.Monad (GhcModT) import Language.Haskell.GhcMod.Target (setTargetFiles) import Language.Haskell.GhcMod.Types
Language/Haskell/GhcMod/Internal.hs view
@@ -35,6 +35,7 @@ , GhcModLog -- * Monad utilities , runGhcModT'+ , hoistGhcModT -- ** Accessing 'GhcModEnv' and 'GhcModState' , options , cradle
− Language/Haskell/GhcMod/List.hs
@@ -1,32 +0,0 @@-module Language.Haskell.GhcMod.List (modules) where--import Control.Applicative ((<$>))-import Control.Exception (SomeException(..))-import Data.List (nub, sort)-import qualified GHC as G-import Language.Haskell.GhcMod.Convert-import Language.Haskell.GhcMod.Monad-import Language.Haskell.GhcMod.Types-import Packages (pkgIdMap, exposedModules, sourcePackageId, display)-import UniqFM (eltsUFM)---------------------------------------------------------------------- | Listing installed modules.-modules :: IOish m => GhcModT m String-modules = do- opt <- options- convert opt . arrange opt <$> (getModules `G.gcatch` handler)- where- getModules = getExposedModules <$> G.getSessionDynFlags- getExposedModules = concatMap exposedModules'- . eltsUFM . pkgIdMap . G.pkgState- exposedModules' p =- map G.moduleNameString (exposedModules p)- `zip`- repeat (display $ sourcePackageId p)- arrange opt = nub . sort . map (dropPkgs opt)- dropPkgs opt (name, pkg)- | detailed opt = name ++ " " ++ pkg- | otherwise = name- handler (SomeException _) = return []
+ Language/Haskell/GhcMod/Modules.hs view
@@ -0,0 +1,32 @@+module Language.Haskell.GhcMod.Modules (modules) where++import Control.Applicative ((<$>))+import Control.Exception (SomeException(..))+import Data.List (nub, sort)+import qualified GHC as G+import Language.Haskell.GhcMod.Convert+import Language.Haskell.GhcMod.Monad+import Language.Haskell.GhcMod.Types+import Packages (pkgIdMap, exposedModules, sourcePackageId, display)+import UniqFM (eltsUFM)++----------------------------------------------------------------++-- | Listing installed modules.+modules :: IOish m => GhcModT m String+modules = do+ opt <- options+ convert opt . arrange opt <$> (getModules `G.gcatch` handler)+ where+ getModules = getExposedModules <$> G.getSessionDynFlags+ getExposedModules = concatMap exposedModules'+ . eltsUFM . pkgIdMap . G.pkgState+ exposedModules' p =+ map G.moduleNameString (exposedModules p)+ `zip`+ repeat (display $ sourcePackageId p)+ arrange opt = nub . sort . map (dropPkgs opt)+ dropPkgs opt (name, pkg)+ | detailed opt = name ++ " " ++ pkg+ | otherwise = name+ handler (SomeException _) = return []
Language/Haskell/GhcMod/Monad.hs view
@@ -18,6 +18,7 @@ -- * Monad utilities , runGhcModT , runGhcModT'+ , hoistGhcModT -- ** Accessing 'GhcModEnv' and 'GhcModState' , gmsGet , gmsPut@@ -45,6 +46,7 @@ import Language.Haskell.GhcMod.Types+import Language.Haskell.GhcMod.Error import Language.Haskell.GhcMod.Cradle import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.GhcPkg@@ -52,7 +54,6 @@ import qualified Language.Haskell.GhcMod.Gap as Gap import DynFlags-import Exception import GHC import qualified GHC as G import GHC.Paths (libdir)@@ -87,7 +88,7 @@ import Control.Monad.Writer.Class (MonadWriter) import Control.Monad.State.Class (MonadState(..)) -import Control.Monad.Error (MonadError, ErrorT, runErrorT)+import Control.Monad.Error (ErrorT, runErrorT) import Control.Monad.Reader (ReaderT, runReaderT) import Control.Monad.State.Strict (StateT, runStateT) import Control.Monad.Trans.Journal (JournalT, runJournalT)@@ -100,6 +101,7 @@ import Data.Maybe (fromJust, isJust) import Data.IORef (IORef, readIORef, writeIORef, newIORef) import System.Directory (getCurrentDirectory)+import System.IO.Error (tryIOError) ---------------------------------------------------------------- @@ -122,21 +124,15 @@ ---------------------------------------------------------------- --- | A constraint alias (-XConstraintKinds) to make functions dealing with--- 'GhcModT' somewhat cleaner.------ Basicially an @IOish m => m@ is a 'Monad' supporting arbitrary 'IO' and--- exception handling. Usually this will simply be 'IO' but we parametrise it in--- the exported API so users have the option to use a custom inner monad.-type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m)---- | The GhcMod monad transformer data type. This is basically a newtype wrapper--- around 'StateT', 'ErrorT', 'JournalT' and 'ReaderT' with custom instances for--- 'GhcMonad' and it's constraints.+-- | This is basically a newtype wrapper around 'StateT', 'ErrorT', 'JournalT'+-- and 'ReaderT' with custom instances for 'GhcMonad' and it's constraints that+-- means you can run (almost) all functions from the GHC API on top of 'GhcModT'+-- transparently. ----- The inner monad should have instances for 'MonadIO' and 'MonadBaseControl'--- 'IO'. Most @mtl@ monads already have 'MonadBaseControl' 'IO' instances, see--- the @monad-control@ package.+-- The inner monad @m@ should have instances for 'MonadIO' and+-- 'MonadBaseControl' 'IO', in the common case this is simply 'IO'. Most @mtl@+-- monads already have 'MonadBaseControl' 'IO' instances, see the+-- @monad-control@ package. newtype GhcModT m a = GhcModT { unGhcModT :: StateT GhcModState (ErrorT GhcModError@@ -147,7 +143,6 @@ , Alternative , Monad , MonadPlus- , MonadIO #if DIFFERENT_MONADIO , Control.Monad.IO.Class.MonadIO #endif@@ -157,7 +152,16 @@ , MonadError GhcModError ) -instance MonadTrans GhcModT where+instance MonadIO m => MonadIO (GhcModT m) where+ liftIO action = do+ res <- GhcModT . liftIO . liftIO . liftIO . liftIO $ tryIOError action+ case res of+ Right a -> return a+ Left e -> case show e of+ "" -> throwError $ noMsg+ msg -> throwError $ strMsg msg++instance MonadTrans (GhcModT) where lift = GhcModT . lift . lift . lift . lift instance MonadState s m => MonadState s (GhcModT m) where@@ -188,7 +192,7 @@ -- | Initialize the 'DynFlags' relating to the compilation of a single -- file or GHC session according to the 'Cradle' and 'Options' -- provided.-initializeFlagsWithCradle :: (GhcMonad m, MonadError GhcModError m)+initializeFlagsWithCradle :: (IOish m, GhcMonad m, MonadError GhcModError m) => Options -> Cradle -> m ()@@ -200,7 +204,7 @@ cabal = isJust mCradleFile ghcopts = ghcUserOptions opt withCabal = do- pkgDesc <- parseCabalFile $ fromJust mCradleFile+ pkgDesc <- parseCabalFile c $ fromJust mCradleFile compOpts <- getCompilerOptions ghcopts c pkgDesc initSession CabalPkg opt compOpts withSandbox = initSession SingleFile opt compOpts@@ -253,6 +257,17 @@ initializeFlagsWithCradle opt (gmCradle env) action) +-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT+-- computation. Note that if the computation that returned @result@ modified the+-- state part of GhcModT this cannot be restored.+hoistGhcModT :: IOish m+ => (Either GhcModError a, GhcModLog)+ -> GhcModT m a+hoistGhcModT (r,l) = do+ GhcModT (lift $ lift $ journal l) >> case r of+ Left e -> throwError e+ Right a -> return a+ -- | Run a computation inside @GhcModT@ providing the RWST environment and -- initial state. This is a low level function, use it only if you know what to -- do with 'GhcModEnv' and 'GhcModState'.@@ -293,6 +308,9 @@ ---------------------------------------------------------------- +gmeAsk :: IOish m => GhcModT m GhcModEnv+gmeAsk = ask+ gmsGet :: IOish m => GhcModT m GhcModState gmsGet = GhcModT get @@ -300,10 +318,10 @@ gmsPut = GhcModT . put options :: IOish m => GhcModT m Options-options = gmOptions <$> ask+options = gmOptions <$> gmeAsk cradle :: IOish m => GhcModT m Cradle-cradle = gmCradle <$> ask+cradle = gmCradle <$> gmeAsk getCompilerMode :: IOish m => GhcModT m CompilerMode getCompilerMode = gmCompilerMode <$> gmsGet
Language/Haskell/GhcMod/PkgDoc.hs view
@@ -3,18 +3,19 @@ import Language.Haskell.GhcMod.Types import Language.Haskell.GhcMod.GhcPkg import Language.Haskell.GhcMod.Monad+import Language.Haskell.GhcMod.Utils import Control.Applicative ((<$>))-import System.Process (readProcess) -- | Obtaining the package name and the doc path of a module. pkgDoc :: IOish m => String -> GhcModT m String-pkgDoc mdl = cradle >>= \c -> liftIO $ do- pkg <- trim <$> readProcess "ghc-pkg" (toModuleOpts c) []+pkgDoc mdl = do+ c <- cradle+ pkg <- trim <$> readProcess' "ghc-pkg" (toModuleOpts c) if pkg == "" then return "\n" else do- htmlpath <- readProcess "ghc-pkg" (toDocDirOpts pkg c) []+ htmlpath <- readProcess' "ghc-pkg" (toDocDirOpts pkg c) let ret = pkg ++ " " ++ drop 14 htmlpath return ret where
Language/Haskell/GhcMod/SrcUtils.hs view
@@ -85,7 +85,10 @@ ---------------------------------------------------------------- -inModuleContext :: IOish m => FilePath -> (DynFlags -> PprStyle -> GhcModT m a) -> GhcModT m a+inModuleContext :: IOish m+ => FilePath+ -> (DynFlags -> PprStyle -> GhcModT m a)+ -> GhcModT m a inModuleContext file action = withDynFlags (setWarnTypedHoles . setDeferTypeErrors . setNoWarningFlags) $ do setTargetFiles [file]
Language/Haskell/GhcMod/Target.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module Language.Haskell.GhcMod.Target ( setTargetFiles ) where@@ -5,7 +6,7 @@ import Control.Applicative ((<$>)) import Control.Monad (forM, void, (>=>)) import DynFlags (ExtensionFlag(..), xopt)-import GHC (DynFlags(..), LoadHowMuch(..))+import GHC (LoadHowMuch(..)) import qualified GHC as G import Language.Haskell.GhcMod.DynFlags import Language.Haskell.GhcMod.Monad@@ -50,7 +51,10 @@ setCompilerMode Intelligent needsFallback :: G.ModuleGraph -> Bool-needsFallback = any (hasTHorQQ . G.ms_hspp_opts)- where- hasTHorQQ :: DynFlags -> Bool- hasTHorQQ dflags = any (`xopt` dflags) [Opt_TemplateHaskell, Opt_QuasiQuotes]+needsFallback = any $ \ms ->+ let df = G.ms_hspp_opts ms in+ Opt_TemplateHaskell `xopt` df+ || Opt_QuasiQuotes `xopt` df+#if __GLASGOW_HASKELL__ >= 708+ || (Opt_PatternSynonyms `xopt` df)+#endif
Language/Haskell/GhcMod/Types.hs view
@@ -1,23 +1,20 @@ module Language.Haskell.GhcMod.Types where +import Control.Monad.Trans.Control (MonadBaseControl) import Data.List (intercalate) import qualified Data.Map as M-import Control.Monad.Error (Error(..))+import Exception (ExceptionMonad)+import MonadUtils (MonadIO) import PackageConfig (PackageConfig) -data GhcModError = GMENoMsg- -- ^ Unknown error- | GMEString { gmeMsg :: String }- -- ^ Some Error with a message. These are produced mostly by- -- 'fail' calls on GhcModT.- | GMECabalConfigure { gmeMsg :: String }- -- ^ Configuring a cabal project failed.- deriving (Eq,Show)--instance Error GhcModError where- noMsg = GMENoMsg- strMsg = GMEString+-- | A constraint alias (-XConstraintKinds) to make functions dealing with+-- 'GhcModT' somewhat cleaner.+--+-- Basicially an @IOish m => m@ is a 'Monad' supporting arbitrary 'IO' and+-- exception handling. Usually this will simply be 'IO' but we parametrise it in+-- the exported API so users have the option to use a custom inner monad.+type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m, ExceptionMonad m) -- | Output style. data OutputStyle = LispStyle -- ^ S expression style.
Language/Haskell/GhcMod/Utils.hs view
@@ -1,12 +1,10 @@ module Language.Haskell.GhcMod.Utils where -import Control.Exception-import Control.Monad.Error (MonadError(..), Error(..))+import Language.Haskell.GhcMod.Error import MonadUtils (MonadIO, liftIO) import System.Directory (getCurrentDirectory, setCurrentDirectory) import System.Exit (ExitCode(..))-import System.IO.Error (tryIOError) import System.Process (readProcessWithExitCode) -- dropWhileEnd is not provided prior to base 4.5.0.0.@@ -25,39 +23,22 @@ | s `elem` "}])" = s : extractParens' ss (level-1) | otherwise = s : extractParens' ss level -readProcess' :: (MonadIO m, Error e, MonadError e m)+readProcess' :: (MonadIO m, MonadError GhcModError m) => String -> [String] -> m String readProcess' cmd opts = do- (rv,output,err) <- liftIO $ readProcessWithExitCode cmd opts ""+ (rv,output,err) <- liftIO (readProcessWithExitCode cmd opts "")+ `modifyError'` GMEProcess ([cmd] ++ opts) case rv of ExitFailure val -> do- throwError $ strMsg $+ throwError $ GMEProcess ([cmd] ++ opts) $ strMsg $ cmd ++ " " ++ unwords opts ++ " (exit " ++ show val ++ ")" ++ "\n" ++ err ExitSuccess -> return output -withDirectory_ :: FilePath -> IO a -> IO a+withDirectory_ :: (MonadIO m, ExceptionMonad m) => FilePath -> m a -> m a withDirectory_ dir action =- bracket getCurrentDirectory setCurrentDirectory- (\_ -> setCurrentDirectory dir >> action)--rethrowError :: MonadError e m => (e -> e) -> m a -> m a-rethrowError f action = action `catchError` \e -> throwError $ f e--tryFix :: MonadError e m => m a -> (e -> m ()) -> m a-tryFix action fix = do- action `catchError` \e -> fix e >> action---- | 'IOException's thrown in the computation passed to this function will be--- converted to 'MonadError' failures using 'throwError'.-liftIOExceptions :: (MonadIO m, Error e, MonadError e m) => IO a -> m a-liftIOExceptions action = do- res <- liftIO $ tryIOError action- case res of- Right a -> return a- Left e -> case show e of- "" -> throwError $ noMsg- msg -> throwError $ strMsg msg+ gbracket (liftIO getCurrentDirectory) (liftIO . setCurrentDirectory)+ (\_ -> liftIO (setCurrentDirectory dir) >> action)
elisp/ghc.el view
@@ -28,7 +28,7 @@ (< emacs-minor-version minor))) (error "ghc-mod requires at least Emacs %d.%d" major minor))) -(defconst ghc-version "5.0.1.2")+(defconst ghc-version "5.1.0.0") ;; (eval-when-compile ;; (require 'haskell-mode))
ghc-mod.cabal view
@@ -1,5 +1,5 @@ Name: ghc-mod-Version: 5.0.1.2+Version: 5.1.0.0 Author: Kazu Yamamoto <kazu@iij.ad.jp> Daniel Gröber <dxld@darkboxed.org> Alejandro Serrano <trupill@gmail.com>@@ -34,6 +34,7 @@ test/data/broken-cabal/cabal.sandbox.config.in test/data/broken-sandbox/*.cabal test/data/broken-sandbox/cabal.sandbox.config+ test/data/cabal-flags/*.cabal test/data/check-test-subdir/*.cabal test/data/check-test-subdir/src/Check/Test/*.hs test/data/check-test-subdir/test/*.hs@@ -45,6 +46,8 @@ test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-1.0-7c59d13f32294d1ef6dc6233c24df961.conf test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-14e543bdae2da4d2aeff5386892c9112.conf test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf+ test/data/pattern-synonyms/*.cabal+ test/data/pattern-synonyms/*.hs test/data/ghc-mod-check/*.cabal test/data/ghc-mod-check/*.hs test/data/ghc-mod-check/Data/*.hs@@ -61,6 +64,7 @@ Language.Haskell.GhcMod.Browse Language.Haskell.GhcMod.Cabal16 Language.Haskell.GhcMod.Cabal18+ Language.Haskell.GhcMod.Cabal21 Language.Haskell.GhcMod.CabalApi Language.Haskell.GhcMod.CabalConfig Language.Haskell.GhcMod.CaseSplit@@ -70,6 +74,7 @@ Language.Haskell.GhcMod.Debug Language.Haskell.GhcMod.Doc Language.Haskell.GhcMod.DynFlags+ Language.Haskell.GhcMod.Error Language.Haskell.GhcMod.FillSig Language.Haskell.GhcMod.Find Language.Haskell.GhcMod.Flag@@ -80,9 +85,9 @@ Language.Haskell.GhcMod.Info Language.Haskell.GhcMod.Lang Language.Haskell.GhcMod.Lint- Language.Haskell.GhcMod.List Language.Haskell.GhcMod.Logger Language.Haskell.GhcMod.Monad+ Language.Haskell.GhcMod.Modules Language.Haskell.GhcMod.PkgDoc Language.Haskell.GhcMod.Read Language.Haskell.GhcMod.SrcUtils@@ -99,7 +104,7 @@ , ghc-syb-utils , hlint >= 1.8.61 , io-choice- , monad-journal >= 0.2.2.0+ , monad-journal >= 0.2.2.0 && < 0.2.3.2 , old-time , process , syb@@ -144,6 +149,7 @@ Default-Extensions: ConstraintKinds, FlexibleContexts HS-Source-Dirs: src Build-Depends: base >= 4.0 && < 5+ , async , containers , directory , filepath@@ -191,7 +197,7 @@ , ghc-syb-utils , hlint >= 1.7.1 , io-choice- , monad-journal >= 0.2.2.0+ , monad-journal >= 0.2.2.0 && < 0.2.3.2 , old-time , process , syb
src/GHCMod.hs view
@@ -113,6 +113,7 @@ cmdArg4 = cmdArg !. 4 cmdArg5 = cmdArg !. 5 remainingArgs = tail cmdArg+ nArgs :: Int -> a -> a nArgs n f = if length remainingArgs == n then f else E.throw (ArgumentsMismatch cmdArg0)@@ -139,6 +140,7 @@ "version" -> return progVersion "help" -> return $ O.usageInfo usage argspec cmd -> E.throw (NoSuchCommand cmd)+ case res of Right s -> putStr s Left (GMENoMsg) ->@@ -146,7 +148,14 @@ Left (GMEString msg) -> hPutStrLn stderr msg Left (GMECabalConfigure msg) ->- hPutStrLn stderr $ "cabal configure failed: " ++ msg+ hPutStrLn stderr $ "cabal configure failed: " ++ show msg+ Left (GMECabalFlags msg) ->+ hPutStrLn stderr $ "retrieval of the cabal configuration flags failed: " ++ show msg+ Left (GMEProcess cmd msg) ->+ hPutStrLn stderr $+ "launching operating system process `"++c++"` failed: " ++ show msg+ where c = unwords cmd+ where handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)] handleThenExit handler e = handler e >> exitFailure
src/GHCModi.hs view
@@ -20,10 +20,10 @@ import Config (cProjectVersion) import Control.Applicative ((<$>))-import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, readMVar)+import Control.Concurrent.Async (Async, async, wait) import Control.Exception (SomeException(..), Exception) import qualified Control.Exception as E-import Control.Monad (when, void)+import Control.Monad (when) import CoreMonad (liftIO) import Data.List (find, intercalate) import Data.List.Split (splitOn)@@ -34,6 +34,7 @@ import Data.Version (showVersion) import qualified GHC as G import Language.Haskell.GhcMod+import Language.Haskell.GhcMod.Internal import Paths_ghc_mod import System.Console.GetOpt import System.Directory (setCurrentDirectory)@@ -100,14 +101,13 @@ let rootdir = cradleRootDir cradle0 -- c = cradle0 { cradleCurrentDir = rootdir } TODO: ????? setCurrentDirectory rootdir- mvar <- liftIO newEmptyMVar- void $ forkIO $ setupDB mvar- (res, _) <- runGhcModT opt $ loop S.empty mvar+ symDb <- async $ runGhcModT opt loadSymbolDb+ (res, _) <- runGhcModT opt $ loop S.empty symDb case res of Right () -> return () Left (GMECabalConfigure msg) -> do- putStrLn $ notGood $ "cabal configure failed: " ++ msg+ putStrLn $ notGood $ "cabal configure failed: " ++ show msg exitFailure Left e -> bug $ show e where@@ -132,19 +132,14 @@ ---------------------------------------------------------------- -setupDB :: MVar SymbolDb -> IO ()-setupDB mvar = loadSymbolDb >>= putMVar mvar--------------------------------------------------------------------loop :: IOish m => Set FilePath -> MVar SymbolDb -> GhcModT m ()-loop set mvar = do+loop :: IOish m => Set FilePath -> SymDbReq -> GhcModT m ()+loop set symDbReq = do cmdArg <- liftIO getLine let (cmd,arg') = break (== ' ') cmdArg arg = dropWhile (== ' ') arg' (ret,ok,set') <- case cmd of "check" -> checkStx set arg- "find" -> findSym set arg mvar+ "find" -> findSym set arg symDbReq "lint" -> lintStx set arg "info" -> showInfo set arg "type" -> showType set arg@@ -163,7 +158,7 @@ else do liftIO $ putStrLn $ notGood ret liftIO $ hFlush stdout- when ok $ loop set' mvar+ when ok $ loop set' symDbReq ---------------------------------------------------------------- @@ -207,10 +202,12 @@ ---------------------------------------------------------------- -findSym :: IOish m => Set FilePath -> String -> MVar SymbolDb+type SymDbReq = Async (Either GhcModError SymbolDb, GhcModLog)++findSym :: IOish m => Set FilePath -> String -> SymDbReq -> GhcModT m (String, Bool, Set FilePath)-findSym set sym mvar = do- db <- liftIO $ readMVar mvar+findSym set sym dbReq = do+ db <- hoistGhcModT =<< liftIO (wait dbReq) ret <- lookupSymbol sym db return (ret, True, set)
test/CabalApiSpec.hs view
@@ -10,6 +10,7 @@ import Test.Hspec import System.Directory import System.FilePath+import System.Process (readProcess) import Dir import TestUtils@@ -23,8 +24,10 @@ spec = do describe "parseCabalFile" $ do it "throws an exception if the cabal file is broken" $ do- shouldReturnError $- runD' $ parseCabalFile "test/data/broken-cabal/broken.cabal"+ shouldReturnError $ do+ withDirectory_ "test/data/broken-cabal" $ do+ crdl <- findCradle+ runD' $ parseCabalFile crdl "broken.cabal" describe "getCompilerOptions" $ do@@ -32,7 +35,7 @@ cwd <- getCurrentDirectory withDirectory "test/data/subdir1/subdir2" $ \dir -> do crdl <- findCradle- pkgDesc <- runD $ parseCabalFile $ fromJust $ cradleCabalFile crdl+ pkgDesc <- runD $ parseCabalFile crdl $ fromJust $ cradleCabalFile crdl res <- runD $ getCompilerOptions [] crdl pkgDesc let res' = res { ghcOptions = ghcOptions res@@ -47,18 +50,28 @@ describe "cabalDependPackages" $ do it "extracts dependent packages" $ do- pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")+ crdl <- findCradle' "test/data/"+ pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") pkgs `shouldBe` ["Cabal","base","template-haskell"]+ it "uses non default flags" $ do+ withDirectory_ "test/data/cabal-flags" $ do+ crdl <- findCradle+ _ <- readProcess "cabal" ["configure", "-ftest-flag"] ""+ pkgs <- cabalDependPackages . cabalAllBuildInfo <$> runD (parseCabalFile crdl "cabal-flags.cabal")+ pkgs `shouldBe` ["Cabal","base"] describe "cabalSourceDirs" $ do it "extracts all hs-source-dirs" $ do- dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/check-test-subdir/check-test-subdir.cabal")+ crdl <- findCradle' "test/data/check-test-subdir"+ dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/check-test-subdir/check-test-subdir.cabal") dirs `shouldBe` ["src", "test"] it "extracts all hs-source-dirs including \".\"" $ do- dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")+ crdl <- findCradle' "test/data/"+ dirs <- cabalSourceDirs . cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") dirs `shouldBe` [".", "test"] describe "cabalAllBuildInfo" $ do it "extracts build info" $ do- info <- cabalAllBuildInfo <$> runD (parseCabalFile "test/data/cabalapi.cabal")+ crdl <- findCradle' "test/data/"+ info <- cabalAllBuildInfo <$> runD (parseCabalFile crdl "test/data/cabalapi.cabal") show info `shouldBe` "[BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\".\"], otherModules = [ModuleName [\"Browse\"],ModuleName [\"CabalApi\"],ModuleName [\"Cabal\"],ModuleName [\"CabalDev\"],ModuleName [\"Check\"],ModuleName [\"ErrMsg\"],ModuleName [\"Flag\"],ModuleName [\"GHCApi\"],ModuleName [\"GHCChoice\"],ModuleName [\"Gap\"],ModuleName [\"Info\"],ModuleName [\"Lang\"],ModuleName [\"Lint\"],ModuleName [\"List\"],ModuleName [\"Paths_ghc_mod\"],ModuleName [\"Types\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [(GHC,[\"-Wall\"])], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []}))),Dependency (PackageName \"template-haskell\") AnyVersion]},BuildInfo {buildable = True, buildTools = [], cppOptions = [], ccOptions = [], ldOptions = [], pkgconfigDepends = [], frameworks = [], cSources = [], hsSourceDirs = [\"test\",\".\"], otherModules = [ModuleName [\"Expectation\"],ModuleName [\"BrowseSpec\"],ModuleName [\"CabalApiSpec\"],ModuleName [\"FlagSpec\"],ModuleName [\"LangSpec\"],ModuleName [\"LintSpec\"],ModuleName [\"ListSpec\"]], defaultLanguage = Nothing, otherLanguages = [], defaultExtensions = [], otherExtensions = [], oldExtensions = [], extraLibs = [], extraLibDirs = [], includeDirs = [], includes = [], installIncludes = [], options = [], ghcProfOptions = [], ghcSharedOptions = [], customFieldsBI = [], targetBuildDepends = [Dependency (PackageName \"Cabal\") (UnionVersionRanges (ThisVersion (Version {versionBranch = [1,10], versionTags = []})) (LaterVersion (Version {versionBranch = [1,10], versionTags = []}))),Dependency (PackageName \"base\") (IntersectVersionRanges (UnionVersionRanges (ThisVersion (Version {versionBranch = [4,0], versionTags = []})) (LaterVersion (Version {versionBranch = [4,0], versionTags = []}))) (EarlierVersion (Version {versionBranch = [5], versionTags = []})))]}]"
test/CheckSpec.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module CheckSpec where import Data.List (isSuffixOf, isInfixOf, isPrefixOf)@@ -30,6 +31,13 @@ withDirectory_ "test/data" $ do res <- runID $ checkSyntax ["Baz.hs"] res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)++#if __GLASGOW_HASKELL__ >= 708+ it "works with modules using PatternSynonyms" $ do+ withDirectory_ "test/data/pattern-synonyms" $ do+ res <- runID $ checkSyntax ["B.hs"]+ res `shouldSatisfy` ("B.hs:6:9:Warning:" `isPrefixOf`)+#endif it "works with foreign exports" $ do withDirectory_ "test/data" $ do
test/MonadSpec.hs view
@@ -5,6 +5,7 @@ import Dir import TestUtils import Control.Applicative+import Control.Exception import Control.Monad.Error.Class spec :: Spec@@ -27,3 +28,12 @@ it "work" $ do (runD $ gmsPut (GhcModState Intelligent) >> gmsGet) `shouldReturn` (GhcModState Intelligent)++ describe "liftIO" $ do+ it "converts user errors to GhcModError" $ do+ shouldReturnError $+ runD' $ liftIO $ throw (userError "hello") >> return ""++ it "converts a file not found exception to GhcModError" $ do+ shouldReturnError $+ runD' $ liftIO $ readFile "/DOES_NOT_EXIST" >> return ""
+ test/data/cabal-flags/cabal-flags.cabal view
@@ -0,0 +1,14 @@+name: cabal-flags+version: 0.1.0+build-type: Simple+cabal-version: >= 1.8++flag test-flag+ default: False++library+ build-depends: base == 4.*++ if flag(test-flag)+ build-depends: Cabal >= 1.10+
+ test/data/pattern-synonyms/A.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE PatternSynonyms #-}+module A where++data SomeType a b = SomeType (a,b)++pattern MyPat x y <- SomeType (x,y)
+ test/data/pattern-synonyms/B.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE PatternSynonyms #-}+module B where+import A++foo :: SomeType Int Char -> String+foo x = case x of+ MyPat a b -> show a ++ " " ++ [b]
+ test/data/pattern-synonyms/Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ test/data/pattern-synonyms/pattern-synonyms.cabal view
@@ -0,0 +1,24 @@+-- Initial pattern-synonyms.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: pattern-synonyms+version: 0.1.0.0+-- synopsis: +-- description: +-- license: +license-file: LICENSE+author: Daniel Gröber+maintainer: dxld@darkboxed.org+-- copyright: +-- category: +build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++library+ exposed-modules: A, B+ -- other-modules: + other-extensions: PatternSynonyms+ build-depends: base >=4.7 && <4.8+ -- hs-source-dirs: + default-language: Haskell2010