Cleanup errors and logging a bit
This commit is contained in:
Daniel Gröber
parent
bc71877dcf
commit
f0ea445a9b
|
|
@ -6,7 +6,11 @@ ghc:
|
|||
|
||||
install:
|
||||
- cabal update
|
||||
# - ( $CABAL122 && cabal install cabal-install --constraint "Cabal >= 1.22" && ghc-pkg unregister Cabal ) || true
|
||||
- echo $PATH
|
||||
- which cabal
|
||||
- cabal install happy --constraint 'transformers <= 0.3.0.0'
|
||||
- cabal install Cabal --constraint "Cabal == $(cabal --version | grep 'Cabal library' | awk '{ print $3 }' | awk -vFS=. '{ print $1 "." $2 }' | tail -n1).*"
|
||||
- happy --version
|
||||
- cabal install -j --only-dependencies --enable-tests
|
||||
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ module Language.Haskell.GhcMod.Error (
|
|||
|
||||
import Control.Arrow
|
||||
import Control.Exception
|
||||
import Control.Monad.Error
|
||||
import Control.Monad.Error hiding (MonadIO, liftIO)
|
||||
import qualified Data.Set as Set
|
||||
import Data.List
|
||||
import Data.Version
|
||||
|
|
@ -49,9 +49,9 @@ import Config (cProjectVersion, cHostPlatformString)
|
|||
import Paths_ghc_mod (version)
|
||||
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Monad.Types
|
||||
import Language.Haskell.GhcMod.Pretty
|
||||
|
||||
|
||||
type GmError m = MonadError GhcModError m
|
||||
|
||||
gmCsfeDoc :: GMConfigStateFileError -> Doc
|
||||
|
|
@ -101,10 +101,15 @@ gmeDoc e = case e of
|
|||
GMECabalCompAssignment ctx ->
|
||||
text "Could not find a consistent component assignment for modules:" $$
|
||||
(nest 4 $ foldr ($+$) empty $ map ctxDoc ctx) $$
|
||||
empty $$
|
||||
text "Try this and that"
|
||||
text "" $$
|
||||
text "- Are you sure all these modules exist?" $$
|
||||
text "- Maybe try enabling test suites and or benchmarks:" $$
|
||||
nest 4 (backticks $ text "cabal configure --enable-tests --enable-benchmarks") $$
|
||||
text "- To find out which components ghc-mod knows about try:" $$
|
||||
nest 4 (backticks $ text "ghc-mod debug")
|
||||
|
||||
where
|
||||
backticks d = char '`' <> d <> char '`'
|
||||
ctxDoc = moduleDoc *** compsDoc
|
||||
>>> first (<> colon) >>> uncurry (flip hang 4)
|
||||
|
||||
|
|
@ -177,10 +182,11 @@ tryFix action f = do
|
|||
|
||||
data GHandler m a = forall e . Exception e => GHandler (e -> m a)
|
||||
|
||||
gcatches :: ExceptionMonad m => m a -> [GHandler m a] -> m a
|
||||
gcatches :: (MonadIO m, ExceptionMonad m) => m a -> [GHandler m a] -> m a
|
||||
gcatches io handlers = io `gcatch` gcatchesHandler handlers
|
||||
|
||||
gcatchesHandler :: ExceptionMonad m => [GHandler m a] -> SomeException -> m a
|
||||
gcatchesHandler :: (MonadIO m, ExceptionMonad m)
|
||||
=> [GHandler m a] -> SomeException -> m a
|
||||
gcatchesHandler handlers e = foldr tryHandler (liftIO $ throw e) handlers
|
||||
where tryHandler (GHandler handler) res
|
||||
= case fromException e of
|
||||
|
|
|
|||
|
|
@ -54,5 +54,5 @@ gmLog level loc' doc = do
|
|||
msg = gmRenderDoc $ gmLogLevelDoc level <+> loc <+> doc
|
||||
|
||||
when (Just level <= level') $
|
||||
liftIO $ hPutStrLn stderr msg
|
||||
liftIO $ hPutStr stderr msg
|
||||
gmlJournal (GhcModLog Nothing [(level, render loc, msg)])
|
||||
|
|
|
|||
|
|
@ -29,6 +29,7 @@ import System.FilePath
|
|||
import System.IO.Unsafe
|
||||
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Language.Haskell.GhcMod.Monad.Types
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.Read
|
||||
import Language.Haskell.GhcMod.Utils hiding (dropWhileEnd)
|
||||
|
|
|
|||
|
|
@ -17,6 +17,8 @@
|
|||
module Language.Haskell.GhcMod.Pretty where
|
||||
|
||||
import Control.Arrow hiding ((<+>))
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Text.PrettyPrint
|
||||
|
||||
import Language.Haskell.GhcMod.Types
|
||||
|
|
@ -56,7 +58,7 @@ warnDoc :: Doc -> Doc
|
|||
warnDoc d = text "Warning" <+>: d
|
||||
|
||||
strDoc :: String -> Doc
|
||||
strDoc str = doc str
|
||||
strDoc str = doc (dropWhileEnd isSpace str)
|
||||
where
|
||||
doc :: String -> Doc
|
||||
doc = lines
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ defaultOptions :: Options
|
|||
defaultOptions = Options {
|
||||
outputStyle = PlainStyle
|
||||
, lineSeparator = LineSeparator "\0"
|
||||
, logLevel = GmPanic
|
||||
, logLevel = GmException
|
||||
-- , ghcProgram = "ghc"
|
||||
, cabalProgram = "cabal"
|
||||
, ghcUserOptions= []
|
||||
|
|
|
|||
|
|
@ -25,6 +25,7 @@ import Control.Arrow
|
|||
import Control.Applicative
|
||||
import Data.Char
|
||||
import Language.Haskell.GhcMod.Error
|
||||
import Language.Haskell.GhcMod.Monad.Types
|
||||
import Exception
|
||||
import System.Directory (getCurrentDirectory, setCurrentDirectory, doesFileExist)
|
||||
import System.Process (readProcess)
|
||||
|
|
|
|||
|
|
@ -15,12 +15,23 @@ import Distribution.Simple.Setup
|
|||
import Distribution.Simple.Install
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Map (Map)
|
||||
|
||||
|
||||
import NotCPP.Declarations
|
||||
import Language.Haskell.TH
|
||||
|
||||
$(ifndefD "componentsConfigs" [d| deriving instance (Ord ComponentName) |] )
|
||||
-- $(ifdefD "componentsConfigs" [d| deriving instance (Ord ComponentName) |] )
|
||||
|
||||
$(ifD [d|
|
||||
|
||||
showComponentName :: ComponentName -> String
|
||||
showComponentName CLibName = "library"
|
||||
showComponentName (CExeName name) = "executable '" ++ name ++ "'"
|
||||
showComponentName (CTestName name) = "test suite '" ++ name ++ "'"
|
||||
showComponentName (CBenchName name) = "benchmark '" ++ name ++ "'"
|
||||
|
||||
|])
|
||||
|
||||
$(ifelsedefD "componentsConfigs" [d|
|
||||
|
||||
|
|
@ -38,8 +49,7 @@ $(ifelsedefD "componentsConfigs" [d|
|
|||
-> LocalBuildInfo
|
||||
setComponentsConfigs lbi cs = flip execState lbi $ mapM setClbis gcs
|
||||
where
|
||||
-- gcs :: [ [(ComponentLocalBuildInfo, ComponentName, a)] ]
|
||||
gcs = groupBy (sameKind `on` fst3) $ sortBy (compare `on` fst3) cs
|
||||
gcs = groupBy (sameKind `on` fst3) $ sortBy (compare `on` showComponentName . fst3) cs
|
||||
|
||||
fst3 (x,_,_) = x
|
||||
|
||||
|
|
@ -130,16 +140,17 @@ $(ifD [d|
|
|||
|
||||
|
||||
$(ifelsedefD "componentPackageRenaming" [d|
|
||||
-- M.Map PackageName
|
||||
newtype Deps = Deps { unDeps :: ([(InstalledPackageId, PackageId)], Map PackageName $(cT "ModuleRenaming")) }
|
||||
-- $(return $ TySynD $(mkName "Deps") [] [t| |] )
|
||||
|
||||
type Deps = ([(InstalledPackageId, PackageId)], M.Map PackageName $(cT "ModuleRenaming"))
|
||||
|
||||
noDeps = ([], M.empty)
|
||||
noDeps = Deps ([], M.empty)
|
||||
|
||||
getDeps :: ComponentLocalBuildInfo -> Deps
|
||||
getDeps = componentPackageDeps &&& $(nE "componentPackageRenaming")
|
||||
getDeps = componentPackageDeps &&& $(nE "componentPackageRenaming") >>> Deps
|
||||
|
||||
setUnionDeps :: Deps -> ComponentLocalBuildInfo -> ComponentLocalBuildInfo
|
||||
setUnionDeps (deps, rns) clbi = let
|
||||
setUnionDeps (Deps (deps, rns)) clbi = let
|
||||
clbi' = setComponentPackageRenaming clbi rns
|
||||
cpdeps = componentPackageDeps clbi
|
||||
in
|
||||
|
|
@ -166,15 +177,15 @@ $(ifelsedefD "componentPackageRenaming" [d|
|
|||
|
||||
|] [d|
|
||||
|
||||
type Deps = [(InstalledPackageId, PackageId)]
|
||||
newtype Deps = Deps { unDeps :: [(InstalledPackageId, PackageId)] }
|
||||
|
||||
noDeps = []
|
||||
noDeps = Deps []
|
||||
|
||||
getDeps :: ComponentLocalBuildInfo -> Deps
|
||||
getDeps lbi = componentPackageDeps lbi
|
||||
getDeps lbi = Deps $ componentPackageDeps lbi
|
||||
|
||||
setUnionDeps :: Deps -> ComponentLocalBuildInfo -> ComponentLocalBuildInfo
|
||||
setUnionDeps deps clbi = let
|
||||
setUnionDeps (Deps deps) clbi = let
|
||||
cpdeps = componentPackageDeps clbi
|
||||
in
|
||||
clbi {
|
||||
|
|
|
|||
|
|
@ -5,6 +5,7 @@ Author: Kazu Yamamoto <kazu@iij.ad.jp>
|
|||
Alejandro Serrano <trupill@gmail.com>
|
||||
Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>
|
||||
License: AGPL-3
|
||||
License-File: LICENSE
|
||||
License-Files: COPYING.BSD3 COPYING.AGPL3
|
||||
Homepage: http://www.mew.org/~kazu/proj/ghc-mod/
|
||||
Synopsis: Happy Haskell Programming
|
||||
|
|
@ -28,34 +29,42 @@ Data-Files: elisp/Makefile
|
|||
Extra-Source-Files: ChangeLog
|
||||
SetupCompat.hs
|
||||
NotCPP/*.hs
|
||||
test/data/*.cabal
|
||||
test/data/*.hs
|
||||
test/data/cabal.sandbox.config.in
|
||||
test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b.conf
|
||||
test/data/annotations/*.hs
|
||||
test/data/broken-cabal/*.cabal
|
||||
test/data/broken-cabal/cabal.sandbox.config.in
|
||||
test/data/broken-sandbox/*.cabal
|
||||
test/data/broken-sandbox/cabal.sandbox.config
|
||||
test/data/broken-sandbox/dummy.cabal
|
||||
test/data/cabal-flags/cabal-flags.cabal
|
||||
test/data/cabal-project/*.cabal
|
||||
test/data/cabal-project/*.hs
|
||||
test/data/cabal-project/cabal.sandbox.config.in
|
||||
test/data/cabal-project/subdir1/subdir2/dummy
|
||||
test/data/case-split/*.hs
|
||||
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
|
||||
test/data/check-test-subdir/test/Bar/*.hs
|
||||
test/data/check-packageid/cabal.sandbox.config.in
|
||||
test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d/template-haskell-2.8.0.0-32d4f24abdbb6bf41272b183b2e23e9c.conf
|
||||
test/data/check-test-subdir/*.cabal
|
||||
test/data/check-test-subdir/src/Check/Test/*.hs
|
||||
test/data/duplicate-pkgver/cabal.sandbox.config.in
|
||||
test/data/duplicate-pkgver/duplicate-pkgver.cabal
|
||||
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/foreign-export/*.hs
|
||||
test/data/ghc-mod-check/*.cabal
|
||||
test/data/ghc-mod-check/*.hs
|
||||
test/data/ghc-mod-check/Data/*.hs
|
||||
test/data/subdir1/subdir2/dummy
|
||||
test/data/.cabal-sandbox/packages/00-index.tar
|
||||
test/data/ghc-mod-check/lib/Data/*.hs
|
||||
test/data/hlint/*.hs
|
||||
test/data/home-module-graph/cpp/*.hs
|
||||
test/data/home-module-graph/cycle/*.hs
|
||||
test/data/home-module-graph/errors/*.hs
|
||||
test/data/home-module-graph/indirect/*.hs
|
||||
test/data/home-module-graph/indirect-update/*.hs
|
||||
test/data/import-cycle/*.hs
|
||||
test/data/non-exported/*.hs
|
||||
test/data/pattern-synonyms/*.cabal
|
||||
test/data/pattern-synonyms/*.hs
|
||||
test/data/quasi-quotes/*.hs
|
||||
test/data/template-haskell/*.hs
|
||||
|
||||
Library
|
||||
Default-Language: Haskell2010
|
||||
|
|
|
|||
|
|
@ -26,7 +26,8 @@ spec = do
|
|||
syms `shouldContain` ["Left :: a -> Either a b"]
|
||||
|
||||
describe "`browse' in a project directory" $ do
|
||||
it "lists symbols defined in a a local module (e.g. `Baz.baz)" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
syms <- runD $ lines <$> browse "Baz"
|
||||
syms `shouldContain` ["baz"]
|
||||
it "can list symbols defined in a a local module" $ do
|
||||
withDirectory_ "test/data/ghc-mod-check/lib" $ do
|
||||
syms <- runD $ lines <$> browse "Data.Foo"
|
||||
syms `shouldContain` ["foo"]
|
||||
syms `shouldContain` ["fibonacci"]
|
||||
|
|
|
|||
|
|
@ -1,88 +0,0 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module CabalApiSpec where
|
||||
|
||||
import Control.Applicative
|
||||
import Language.Haskell.GhcMod.CabalApi
|
||||
import Language.Haskell.GhcMod.Cradle
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import Test.Hspec
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
||||
import Dir
|
||||
import TestUtils
|
||||
|
||||
import Config (cProjectVersionInt) -- ghc version
|
||||
|
||||
ghcVersion :: Int
|
||||
ghcVersion = read cProjectVersionInt
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "parseCabalFile" $ do
|
||||
it "throws an exception if the cabal file is broken" $ do
|
||||
shouldReturnError $ do
|
||||
withDirectory_ "test/data/broken-cabal" $ do
|
||||
crdl <- findCradle
|
||||
runD' $ parseCabalFile crdl "broken.cabal"
|
||||
|
||||
|
||||
describe "getCompilerOptions" $ do
|
||||
it "gets necessary CompilerOptions" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
|
||||
crdl <- findCradle
|
||||
let Just cabalFile = cradleCabalFile crdl
|
||||
pkgDesc <- runD $ parseCabalFile crdl cabalFile
|
||||
res <- runD $ getCompilerOptions [] crdl pkgDesc
|
||||
let res' = res {
|
||||
ghcOptions = ghcOptions res
|
||||
, includeDirs = map (toRelativeDir dir) (includeDirs res)
|
||||
}
|
||||
|
||||
let [fGlobalPkg, fNoUserPkg, fPkg, sb, _] = ghcOptions res'
|
||||
|
||||
sb `shouldSatisfy`
|
||||
isPkgConfDAt (cwd </> "test/data/.cabal-sandbox")
|
||||
|
||||
if ghcVersion < 706
|
||||
then do
|
||||
fGlobalPkg `shouldBe` "-global-package-conf"
|
||||
fNoUserPkg `shouldBe` "-no-user-package-conf"
|
||||
fPkg `shouldBe` "-package-conf"
|
||||
|
||||
else do
|
||||
fGlobalPkg `shouldBe` "-global-package-db"
|
||||
fNoUserPkg `shouldBe` "-no-user-package-db"
|
||||
fPkg `shouldBe` "-package-db"
|
||||
|
||||
includeDirs res' `shouldBe` [
|
||||
"test/data",
|
||||
"test/data/dist/build",
|
||||
"test/data/dist/build/autogen",
|
||||
"test/data/subdir1/subdir2",
|
||||
"test/data/test"]
|
||||
|
||||
(pkgName `map` depPackages res') `shouldContain` ["Cabal"]
|
||||
|
||||
describe "cabalSourceDirs" $ do
|
||||
it "extracts all hs-source-dirs" $ do
|
||||
crdl <- findCradle' "test/data/check-test-subdir"
|
||||
let cabalFile = "test/data/check-test-subdir/check-test-subdir.cabal"
|
||||
dirs <- cabalSourceDirs . cabalAllBuildInfo
|
||||
<$> runD (parseCabalFile crdl cabalFile)
|
||||
|
||||
dirs `shouldBe` ["src", "test"]
|
||||
|
||||
it "extracts all hs-source-dirs including \".\"" $ do
|
||||
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
|
||||
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 = []})))]}]"
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
module CheckSpec where
|
||||
|
||||
import Data.List (isSuffixOf, isInfixOf, isPrefixOf)
|
||||
import Data.List (isInfixOf, isPrefixOf) --isSuffixOf,
|
||||
import Language.Haskell.GhcMod
|
||||
import System.FilePath
|
||||
--import System.FilePath
|
||||
import Test.Hspec
|
||||
|
||||
import TestUtils
|
||||
|
|
@ -17,20 +17,21 @@ spec = do
|
|||
res <- runD $ checkSyntax ["main.hs"]
|
||||
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\n"
|
||||
|
||||
|
||||
it "works even if a module imports another module from a different directory" $ do
|
||||
withDirectory_ "test/data/check-test-subdir" $ do
|
||||
res <- runD $ checkSyntax ["test/Bar/Baz.hs"]
|
||||
res `shouldSatisfy` (("test" </> "Foo.hs:3:1:Warning: Top-level binding with no type signature: foo :: [Char]\n") `isSuffixOf`)
|
||||
|
||||
it "detects cyclic imports" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
withDirectory_ "test/data/import-cycle" $ do
|
||||
res <- runD $ checkSyntax ["Mutual1.hs"]
|
||||
res `shouldSatisfy` ("Module imports form a cycle" `isInfixOf`)
|
||||
|
||||
it "works with modules using QuasiQuotes" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ checkSyntax ["Baz.hs"]
|
||||
res `shouldSatisfy` ("Baz.hs:5:1:Warning:" `isPrefixOf`)
|
||||
withDirectory_ "test/data/quasi-quotes" $ do
|
||||
res <- runD $ checkSyntax ["QuasiQuotes.hs"]
|
||||
res `shouldSatisfy` ("QuasiQuotes.hs:6:1:Warning:" `isInfixOf`)
|
||||
|
||||
#if __GLASGOW_HASKELL__ >= 708
|
||||
it "works with modules using PatternSynonyms" $ do
|
||||
|
|
@ -40,12 +41,12 @@ spec = do
|
|||
#endif
|
||||
|
||||
it "works with foreign exports" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
withDirectory_ "test/data/foreign-export" $ do
|
||||
res <- runD $ checkSyntax ["ForeignExport.hs"]
|
||||
res `shouldBe` ""
|
||||
|
||||
context "when no errors are found" $ do
|
||||
it "doesn't output an empty line" $ do
|
||||
withDirectory_ "test/data/ghc-mod-check/Data" $ do
|
||||
withDirectory_ "test/data/ghc-mod-check/lib/Data" $ do
|
||||
res <- runD $ checkSyntax ["Foo.hs"]
|
||||
res `shouldBe` ""
|
||||
|
|
|
|||
|
|
@ -4,54 +4,18 @@ import Control.Applicative
|
|||
import Data.List (isSuffixOf)
|
||||
import Language.Haskell.GhcMod.Cradle
|
||||
import Language.Haskell.GhcMod.Types
|
||||
import System.Directory (canonicalizePath,getCurrentDirectory)
|
||||
import System.FilePath ((</>), pathSeparator)
|
||||
import System.Directory (canonicalizePath)
|
||||
import System.FilePath (pathSeparator)
|
||||
import Test.Hspec
|
||||
|
||||
import Dir
|
||||
import TestUtils
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "findCradle" $ do
|
||||
it "returns the current directory" $ do
|
||||
withDirectory_ "/" $ do
|
||||
curDir <- stripLastDot <$> canonicalizePath "/"
|
||||
res <- findCradle
|
||||
cradleCurrentDir res `shouldBe` curDir
|
||||
cradleRootDir res `shouldBe` curDir
|
||||
cradleCabalFile res `shouldBe` Nothing
|
||||
cradlePkgDbStack res `shouldBe` [GlobalDb,UserDb]
|
||||
|
||||
it "finds a cabal file and a sandbox" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
withDirectory "test/data/subdir1/subdir2" $ \dir -> do
|
||||
res <- relativeCradle dir <$> findCradle
|
||||
|
||||
cradleCurrentDir res `shouldBe`
|
||||
"test" </> "data" </> "subdir1" </> "subdir2"
|
||||
|
||||
cradleRootDir res `shouldBe` "test" </> "data"
|
||||
|
||||
cradleCabalFile res `shouldBe`
|
||||
Just ("test" </> "data" </> "cabalapi.cabal")
|
||||
|
||||
let [GlobalDb, sb] = cradlePkgDbStack res
|
||||
sb `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
|
||||
|
||||
it "works even if a sandbox config file is broken" $ do
|
||||
withDirectory "test/data/broken-sandbox" $ \dir -> do
|
||||
res <- relativeCradle dir <$> findCradle
|
||||
cradleCurrentDir res `shouldBe`
|
||||
"test" </> "data" </> "broken-sandbox"
|
||||
|
||||
cradleRootDir res `shouldBe`
|
||||
"test" </> "data" </> "broken-sandbox"
|
||||
|
||||
cradleCabalFile res `shouldBe`
|
||||
Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
|
||||
|
||||
cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb]
|
||||
clean_ :: IO Cradle -> IO Cradle
|
||||
clean_ f = do
|
||||
crdl <- f
|
||||
cleanupCradle crdl
|
||||
return crdl
|
||||
|
||||
relativeCradle :: FilePath -> Cradle -> Cradle
|
||||
relativeCradle dir crdl = crdl {
|
||||
|
|
@ -65,3 +29,46 @@ stripLastDot :: FilePath -> FilePath
|
|||
stripLastDot path
|
||||
| (pathSeparator:'.':"") `isSuffixOf` path = init path
|
||||
| otherwise = path
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "findCradle" $ do
|
||||
it "returns the current directory" $ do
|
||||
withDirectory_ "/" $ do
|
||||
curDir <- stripLastDot <$> canonicalizePath "/"
|
||||
res <- clean_ findCradle
|
||||
cradleCurrentDir res `shouldBe` curDir
|
||||
cradleRootDir res `shouldBe` curDir
|
||||
cradleCabalFile res `shouldBe` Nothing
|
||||
cradlePkgDbStack res `shouldBe` [GlobalDb,UserDb]
|
||||
|
||||
it "finds a cabal file and a sandbox" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
withDirectory "test/data/cabal-project/subdir1/subdir2" $ \dir -> do
|
||||
res <- relativeCradle dir <$> clean_ findCradle
|
||||
|
||||
cradleCurrentDir res `shouldBe`
|
||||
"test/data/cabal-project/subdir1/subdir2"
|
||||
|
||||
cradleRootDir res `shouldBe` "test/data/cabal-project"
|
||||
|
||||
cradleCabalFile res `shouldBe`
|
||||
Just ("test/data/cabal-project/cabalapi.cabal")
|
||||
|
||||
let [GlobalDb, sb] = cradlePkgDbStack res
|
||||
sb `shouldSatisfy`
|
||||
isPkgDbAt (cwd </> "test/data/cabal-project/.cabal-sandbox")
|
||||
|
||||
it "works even if a sandbox config file is broken" $ do
|
||||
withDirectory "test/data/broken-sandbox" $ \dir -> do
|
||||
res <- relativeCradle dir <$> clean_ findCradle
|
||||
cradleCurrentDir res `shouldBe`
|
||||
"test" </> "data" </> "broken-sandbox"
|
||||
|
||||
cradleRootDir res `shouldBe`
|
||||
"test" </> "data" </> "broken-sandbox"
|
||||
|
||||
cradleCabalFile res `shouldBe`
|
||||
Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
|
||||
|
||||
cradlePkgDbStack res `shouldBe` [GlobalDb, UserDb]
|
||||
|
|
|
|||
10
test/Dir.hs
10
test/Dir.hs
|
|
@ -1,9 +1,15 @@
|
|||
module Dir where
|
||||
module Dir (
|
||||
module Dir
|
||||
, getCurrentDirectory
|
||||
, (</>)
|
||||
) where
|
||||
|
||||
import Control.Exception as E
|
||||
import Data.List (isPrefixOf)
|
||||
import System.Directory
|
||||
import System.FilePath (addTrailingPathSeparator)
|
||||
import System.FilePath (addTrailingPathSeparator,(</>))
|
||||
|
||||
|
||||
|
||||
withDirectory_ :: FilePath -> IO a -> IO a
|
||||
withDirectory_ dir action = bracket getCurrentDirectory
|
||||
|
|
|
|||
|
|
@ -9,51 +9,43 @@ import System.Environment.Executable (getExecutablePath)
|
|||
#else
|
||||
import System.Environment (getExecutablePath)
|
||||
#endif
|
||||
import System.Exit
|
||||
import System.FilePath
|
||||
import System.Process
|
||||
import Test.Hspec
|
||||
import TestUtils
|
||||
import Dir
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "types" $ do
|
||||
it "shows types of the expression and its outers" $ do
|
||||
withDirectory_ "test/data/ghc-mod-check" $ do
|
||||
res <- runD $ types "Data/Foo.hs" 9 5
|
||||
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||
let tdir = "test/data/ghc-mod-check"
|
||||
res <- runD' tdir $ types "lib/Data/Foo.hs" 9 5
|
||||
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
|
||||
|
||||
it "works with a module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ types "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ types "Bar.hs" 5 1
|
||||
res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
|
||||
|
||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ types "Main.hs" 3 8
|
||||
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ types "ImportsTH.hs" 3 8
|
||||
res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
|
||||
|
||||
describe "info" $ do
|
||||
it "works for non-export functions" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ info "Info.hs" "fib"
|
||||
res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
|
||||
it "works for non exported functions" $ do
|
||||
let tdir = "test/data/non-exported"
|
||||
res <- runD' tdir $ info "Fib.hs" "fib"
|
||||
res `shouldSatisfy` ("fib :: Int -> Int" `isPrefixOf`)
|
||||
|
||||
it "works with a module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ info "Bar.hs" "foo"
|
||||
res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ info "Bar.hs" "foo"
|
||||
res `shouldSatisfy` ("foo :: ExpQ" `isPrefixOf`)
|
||||
|
||||
it "works with a module that imports another module using TemplateHaskell" $ do
|
||||
withDirectory_ "test/data" $ do
|
||||
res <- runD $ info "Main.hs" "bar"
|
||||
res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
|
||||
|
||||
it "doesn't fail on unicode output" $ do
|
||||
dir <- getDistDir
|
||||
code <- rawSystem (dir </> "build/ghc-mod/ghc-mod") ["info", "test/data/Unicode.hs", "Unicode", "unicode"]
|
||||
code `shouldSatisfy` (== ExitSuccess)
|
||||
let tdir = "test/data/template-haskell"
|
||||
res <- runD' tdir $ info "ImportsTH.hs" "bar"
|
||||
res `shouldSatisfy` ("bar :: [Char]" `isPrefixOf`)
|
||||
|
||||
getDistDir :: IO FilePath
|
||||
getDistDir = takeDirectory . takeDirectory . takeDirectory <$> getExecutablePath
|
||||
|
|
|
|||
|
|
@ -8,10 +8,10 @@ spec :: Spec
|
|||
spec = do
|
||||
describe "lint" $ do
|
||||
it "can detect a redundant import" $ do
|
||||
res <- runD $ lint "test/data/hlint.hs"
|
||||
res `shouldBe` "test/data/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n"
|
||||
res <- runD $ lint "test/data/hlint/hlint.hs"
|
||||
res `shouldBe` "test/data/hlint/hlint.hs:4:8: Error: Redundant do\NULFound:\NUL do putStrLn \"Hello, world!\"\NULWhy not:\NUL putStrLn \"Hello, world!\"\n"
|
||||
|
||||
context "when no suggestions are given" $ do
|
||||
it "doesn't output an empty line" $ do
|
||||
res <- runD $ lint "test/data/ghc-mod-check/Data/Foo.hs"
|
||||
res <- runD $ lint "test/data/ghc-mod-check/lib/Data/Foo.hs"
|
||||
res `shouldBe` ""
|
||||
|
|
|
|||
22
test/Main.hs
22
test/Main.hs
|
|
@ -4,6 +4,7 @@ import Dir
|
|||
|
||||
import Control.Exception as E
|
||||
import Control.Monad (void)
|
||||
import Data.List
|
||||
import Language.Haskell.GhcMod (debugInfo)
|
||||
import System.Process
|
||||
import Test.Hspec
|
||||
|
|
@ -11,20 +12,35 @@ import TestUtils
|
|||
|
||||
main :: IO ()
|
||||
main = do
|
||||
let sandboxes = [ "test/data", "test/data/check-packageid"
|
||||
let sandboxes = [ "test/data/cabal-project"
|
||||
, "test/data/check-packageid"
|
||||
, "test/data/duplicate-pkgver/"
|
||||
, "test/data/broken-cabal/"
|
||||
]
|
||||
genSandboxCfg dir = withDirectory dir $ \cwdir -> do
|
||||
system ("sed 's|@CWD@|" ++ cwdir ++ "|g' cabal.sandbox.config.in > cabal.sandbox.config")
|
||||
pkgDirs =
|
||||
[ "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
|
||||
[ "test/data/cabal-project/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
|
||||
, "test/data/check-packageid/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"
|
||||
, "test/data/duplicate-pkgver/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d"]
|
||||
genGhcPkgCache dir = system $ "ghc-pkg recache --force -f" ++ dir
|
||||
|
||||
genSandboxCfg `mapM_` sandboxes
|
||||
genGhcPkgCache `mapM_` pkgDirs
|
||||
void $ system "find test \\( -name setup-config -o -name ghc-mod.cache \\) -exec rm {} \\;"
|
||||
|
||||
let caches = [ "setup-config"
|
||||
, "setup-config.ghc-mod.cabal-ghc-options"
|
||||
, "setup-config.ghc-mod.cabal-helper.ghc-options"
|
||||
, "setup-config.ghc-mod.cabal-helper"
|
||||
, "ghc-mod.cache"
|
||||
]
|
||||
cachesFindExp :: String
|
||||
cachesFindExp = unwords $ intersperse "-o " $ map ("-name "++) caches
|
||||
|
||||
cleanCmd = "find test \\( "++ cachesFindExp ++" \\) -exec rm {} \\;"
|
||||
|
||||
print cleanCmd
|
||||
void $ system cleanCmd
|
||||
void $ system "cabal --version"
|
||||
putStrLn $ "ghc-mod was built with Cabal version " ++ VERSION_Cabal
|
||||
void $ system "ghc --version"
|
||||
|
|
|
|||
|
|
@ -1,39 +1,17 @@
|
|||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module MonadSpec where
|
||||
|
||||
import Test.Hspec
|
||||
import Dir
|
||||
import TestUtils
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Control.Monad.Error.Class
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "When using GhcModT in a do block" $
|
||||
it "a pattern match failure causes a call to `fail` on ErrorT in the monad stack" $ do
|
||||
(a, _)
|
||||
(a, _h)
|
||||
<- runGhcModT defaultOptions $
|
||||
do
|
||||
Just _ <- return Nothing
|
||||
return "hello"
|
||||
`catchError` (const $ fail "oh noes")
|
||||
a `shouldBe` (Left $ GMEString "oh noes")
|
||||
|
||||
describe "runGhcModT" $
|
||||
it "complains if the cabal file fails to parse while a sandbox is present" $ withDirectory_ "test/data/broken-cabal" $ do
|
||||
shouldReturnError $ runD' (gmCradle <$> ask)
|
||||
|
||||
describe "gmsGet/Put" $
|
||||
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 ""
|
||||
|
|
|
|||
|
|
@ -1,10 +1,6 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
module PathsAndFilesSpec where
|
||||
|
||||
import Language.Haskell.GhcMod.PathsAndFiles
|
||||
#if __GLASGOW_HASKELL__ <= 706
|
||||
import Language.Haskell.GhcMod.GhcPkg
|
||||
#endif
|
||||
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
|
@ -14,32 +10,24 @@ import TestUtils
|
|||
spec :: Spec
|
||||
spec = do
|
||||
describe "getSandboxDb" $ do
|
||||
-- ghc < 7.8
|
||||
#if __GLASGOW_HASKELL__ <= 706
|
||||
it "does include a sandbox with ghc < 7.8" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
[GlobalDb, sbPkgDb] <- getPackageDbStack "test/data/"
|
||||
sbPkgDb `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
|
||||
#endif
|
||||
|
||||
it "can parse a config file and extract the sandbox package-db" $ do
|
||||
cwd <- getCurrentDirectory
|
||||
Just db <- getSandboxDb "test/data/"
|
||||
db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/.cabal-sandbox")
|
||||
Just db <- getSandboxDb "test/data/cabal-project"
|
||||
db `shouldSatisfy` isPkgDbAt (cwd </> "test/data/cabal-project/.cabal-sandbox")
|
||||
|
||||
it "returns Nothing if the sandbox config file is broken" $ do
|
||||
getSandboxDb "test/data/broken-sandbox" `shouldReturn` Nothing
|
||||
|
||||
describe "findCabalFile" $ do
|
||||
it "works" $ do
|
||||
findCabalFile "test/data" `shouldReturn` Just "test/data/cabalapi.cabal"
|
||||
findCabalFile "test/data/cabal-project" `shouldReturn` Just "test/data/cabal-project/cabalapi.cabal"
|
||||
|
||||
it "finds cabal files in parent directories" $ do
|
||||
findCabalFile "test/data/subdir1/subdir2" `shouldReturn` Just "test/data/cabalapi.cabal"
|
||||
findCabalFile "test/data/cabal-project/subdir1/subdir2" `shouldReturn` Just "test/data/cabal-project/cabalapi.cabal"
|
||||
|
||||
describe "findCabalSandboxDir" $ do
|
||||
it "works" $ do
|
||||
findCabalSandboxDir "test/data" `shouldReturn` Just "test/data"
|
||||
findCabalSandboxDir "test/data/cabal-project" `shouldReturn` Just "test/data/cabal-project"
|
||||
|
||||
it "finds sandboxes in parent directories" $ do
|
||||
findCabalSandboxDir "test/data/subdir1/subdir2" `shouldReturn` Just "test/data"
|
||||
findCabalSandboxDir "test/data/cabal-project/subdir1/subdir2" `shouldReturn` Just "test/data/cabal-project"
|
||||
|
|
|
|||
|
|
@ -1,11 +1,10 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module TestUtils (
|
||||
run
|
||||
, runD
|
||||
, runD'
|
||||
, runI
|
||||
-- , runID
|
||||
, runIsolatedGhcMod
|
||||
, isolateCradle
|
||||
, runE
|
||||
, runNullLog
|
||||
, shouldReturnError
|
||||
, isPkgDbAt
|
||||
, isPkgConfDAt
|
||||
|
|
@ -13,18 +12,26 @@ module TestUtils (
|
|||
, module Language.Haskell.GhcMod.Types
|
||||
) where
|
||||
|
||||
import Language.Haskell.GhcMod.Logging
|
||||
import Language.Haskell.GhcMod.Monad
|
||||
import Language.Haskell.GhcMod.Cradle
|
||||
import Language.Haskell.GhcMod.Types
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Applicative
|
||||
import Control.Monad (when)
|
||||
import Control.Monad.Error (ErrorT, runErrorT)
|
||||
import Control.Monad.Trans.Journal
|
||||
import Data.List.Split
|
||||
import Data.String
|
||||
import System.FilePath
|
||||
import System.Directory
|
||||
import Test.Hspec
|
||||
|
||||
isolateCradle :: IOish m => GhcModT m a -> GhcModT m a
|
||||
isolateCradle action =
|
||||
local modifyEnv $ action
|
||||
where
|
||||
modifyEnv e = e { gmCradle = (gmCradle e) { cradlePkgDbStack = [GlobalDb] } }
|
||||
import Exception
|
||||
|
||||
testLogLevel :: GmLogLevel
|
||||
testLogLevel = GmException
|
||||
|
||||
extract :: Show e => IO (Either e a, w) -> IO a
|
||||
extract action = do
|
||||
|
|
@ -33,28 +40,46 @@ extract action = do
|
|||
Right a -> return a
|
||||
Left e -> error $ show e
|
||||
|
||||
runIsolatedGhcMod :: Options -> GhcModT IO a -> IO a
|
||||
runIsolatedGhcMod opt action = do
|
||||
extract $ runGhcModT opt $ isolateCradle action
|
||||
withSpecCradle :: IOish m => FilePath -> (Cradle -> m a) -> m a
|
||||
withSpecCradle cradledir f =
|
||||
gbracket (liftIO $ findSpecCradle cradledir) (liftIO . cleanupCradle) f
|
||||
|
||||
-- | Run GhcMod in isolated cradle with default options
|
||||
--runID :: GhcModT IO a -> IO a
|
||||
--runID = runIsolatedGhcMod defaultOptions
|
||||
withGhcModEnvSpec :: IOish m => FilePath -> Options -> (GhcModEnv -> m a) -> m a
|
||||
withGhcModEnvSpec dir opt f = withSpecCradle dir $ withGhcModEnv' opt f
|
||||
|
||||
-- | Run GhcMod in isolated cradle
|
||||
runI :: Options -> GhcModT IO a -> IO a
|
||||
runI = runIsolatedGhcMod
|
||||
runGhcModTSpec :: Options -> GhcModT IO a -> IO (Either GhcModError a, GhcModLog)
|
||||
runGhcModTSpec opt action = do
|
||||
dir <- getCurrentDirectory
|
||||
runGhcModTSpec' dir opt action
|
||||
|
||||
runGhcModTSpec' :: IOish m
|
||||
=> FilePath -> Options -> GhcModT m b -> m (Either GhcModError b, GhcModLog)
|
||||
runGhcModTSpec' dir opt action = liftIO (canonicalizePath dir) >>= \dir' ->
|
||||
withGhcModEnvSpec dir' opt $ \env -> do
|
||||
first (fst <$>) <$> runGhcModT'' env defaultGhcModState
|
||||
(gmSetLogLevel (logLevel opt) >> action)
|
||||
|
||||
-- | Run GhcMod
|
||||
run :: Options -> GhcModT IO a -> IO a
|
||||
run opt a = extract $ runGhcModT opt a
|
||||
run opt a = extract $ runGhcModTSpec opt a
|
||||
|
||||
-- | Run GhcMod with default options
|
||||
runD :: GhcModT IO a -> IO a
|
||||
runD = extract . runGhcModT defaultOptions
|
||||
runD =
|
||||
extract . runGhcModTSpec defaultOptions { logLevel = testLogLevel }
|
||||
|
||||
runD' :: GhcModT IO a -> IO (Either GhcModError a, GhcModLog)
|
||||
runD' = runGhcModT defaultOptions
|
||||
runD' :: FilePath -> GhcModT IO a -> IO a
|
||||
runD' dir =
|
||||
extract . runGhcModTSpec' dir defaultOptions { logLevel = testLogLevel }
|
||||
|
||||
runE :: ErrorT e IO a -> IO (Either e a)
|
||||
runE = runErrorT
|
||||
|
||||
runNullLog :: MonadIO m => JournalT GhcModLog m a -> m a
|
||||
runNullLog action = do
|
||||
(a,w) <- runJournalT action
|
||||
when (w /= mempty) $ liftIO $ print w
|
||||
return a
|
||||
|
||||
shouldReturnError :: Show a
|
||||
=> IO (Either GhcModError a, GhcModLog)
|
||||
|
|
@ -80,3 +105,6 @@ isPkgConfDAt _ _ = False
|
|||
isPkgDbAt :: FilePath -> GhcPkgDb -> Bool
|
||||
isPkgDbAt d (PackageDb dir) = isPkgConfDAt d dir
|
||||
isPkgDbAt _ _ = False
|
||||
|
||||
instance IsString ModuleName where
|
||||
fromString = mkModuleName
|
||||
|
|
|
|||
|
|
@ -11,13 +11,3 @@ spec = do
|
|||
it "extracts the part of a string surrounded by parentheses" $ do
|
||||
extractParens "asdasdasd ( hello [ world ] )()() kljlkjlkjlk" `shouldBe` "( hello [ world ] )"
|
||||
extractParens "[(PackageName \"template-haskell\",InstalledPackageId \"template-haskell-2.9.0.0-8e2a49468f3b663b671c437d8579cd28\"),(PackageName \"base\",InstalledPackageId \"base-4.7.0.0-e4567cc9a8ef85f78696b03f3547b6d5\"),(PackageName \"Cabal\",InstalledPackageId \"Cabal-1.18.1.3-b9a44a5b15a8bce47d40128ac326e369\")][][]" `shouldBe` "[(PackageName \"template-haskell\",InstalledPackageId \"template-haskell-2.9.0.0-8e2a49468f3b663b671c437d8579cd28\"),(PackageName \"base\",InstalledPackageId \"base-4.7.0.0-e4567cc9a8ef85f78696b03f3547b6d5\"),(PackageName \"Cabal\",InstalledPackageId \"Cabal-1.18.1.3-b9a44a5b15a8bce47d40128ac326e369\")]"
|
||||
|
||||
describe "liftMonadError" $ do
|
||||
it "converts IOErrors to GhcModError" $ do
|
||||
shouldReturnError $
|
||||
runD' $ liftIO $ throw (userError "hello") >> return ""
|
||||
|
||||
shouldReturnError $
|
||||
runD' $ liftIO $ readFile "/DOES_NOT_EXIST" >> return ""
|
||||
|
||||
-- readProcessWithExitCode cmd opts ""
|
||||
|
|
|
|||
|
|
@ -1,4 +0,0 @@
|
|||
name: Cabal
|
||||
version: 1.18.1.3
|
||||
id: Cabal-1.18.1.3-2b161c6bf77657aa17e1681d83cb051b
|
||||
exposed: True
|
||||
Binary file not shown.
|
|
@ -1,5 +0,0 @@
|
|||
{-# LANGUAGE TemplateHaskell #-}
|
||||
module Bar (bar) where
|
||||
import Foo (foo)
|
||||
|
||||
bar = $foo ++ "bar"
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Baz (baz) where
|
||||
import Foo (fooQ)
|
||||
|
||||
baz = [fooQ| foo bar baz |]
|
||||
|
|
@ -1,9 +0,0 @@
|
|||
module Foo (foo, fooQ) where
|
||||
import Language.Haskell.TH
|
||||
import Language.Haskell.TH.Quote (QuasiQuoter(..))
|
||||
|
||||
foo :: ExpQ
|
||||
foo = stringE "foo"
|
||||
|
||||
fooQ :: QuasiQuoter
|
||||
fooQ = QuasiQuoter (litE . stringL) undefined undefined undefined
|
||||
|
|
@ -1,10 +0,0 @@
|
|||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
module ForeignExport where
|
||||
|
||||
import Foreign.C.Types
|
||||
|
||||
foreign export ccall foo :: CUInt
|
||||
|
||||
foo :: CUInt
|
||||
foo = 123
|
||||
|
|
@ -1,8 +0,0 @@
|
|||
{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
|
||||
|
||||
module Info () where
|
||||
|
||||
fib :: Int -> Int
|
||||
fib 0 = 0
|
||||
fib 1 = 1
|
||||
fib n = fib (n - 1) + fib (n - 2)
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
import Bar (bar)
|
||||
|
||||
main = putStrLn bar
|
||||
|
|
@ -1,5 +0,0 @@
|
|||
{-# LANGUAGE TemplateHaskell #-} -- for HscInterpreted
|
||||
|
||||
module Mutual1 where
|
||||
|
||||
import Mutual2
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
module Mutual2 where
|
||||
|
||||
import Mutual1
|
||||
|
|
@ -1,4 +0,0 @@
|
|||
module Unicode where
|
||||
|
||||
unicode :: α -> α
|
||||
unicode = id
|
||||
|
|
@ -1 +0,0 @@
|
|||
broken
|
||||
|
|
@ -1,25 +0,0 @@
|
|||
-- This is a Cabal package environment file.
|
||||
-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY.
|
||||
-- Please create a 'cabal.config' file in the same directory
|
||||
-- if you want to change the default settings for this sandbox.
|
||||
|
||||
|
||||
local-repo: @CWD@/test/data/.cabal-sandbox/packages
|
||||
logs-dir: @CWD@/test/data/.cabal-sandbox/logs
|
||||
world-file: @CWD@/test/data/.cabal-sandbox/world
|
||||
user-install: False
|
||||
package-db: @CWD@/test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d
|
||||
build-summary: @CWD@/test/data/.cabal-sandbox/logs/build.log
|
||||
|
||||
install-dirs
|
||||
prefix: @CWD@/test/data/.cabal-sandbox
|
||||
bindir: $prefix/bin
|
||||
libdir: $prefix/lib
|
||||
libsubdir: $arch-$os-$compiler/$pkgid
|
||||
libexecdir: $prefix/libexec
|
||||
datadir: $prefix/share
|
||||
datasubdir: $arch-$os-$compiler/$pkgid
|
||||
docdir: $datadir/doc/$arch-$os-$compiler/$pkgid
|
||||
htmldir: $docdir/html
|
||||
haddockdir: $htmldir
|
||||
sysconfdir: $prefix/etc
|
||||
|
|
@ -1,67 +0,0 @@
|
|||
Name: ghc-mod
|
||||
Version: 1.11.3
|
||||
Author: Kazu Yamamoto <kazu@iij.ad.jp>
|
||||
Maintainer: Kazu Yamamoto <kazu@iij.ad.jp>
|
||||
License: BSD3
|
||||
License-File: LICENSE
|
||||
Homepage: http://www.mew.org/~kazu/proj/ghc-mod/
|
||||
Synopsis: Happy Haskell programming on Emacs/Vim
|
||||
Description: This packages includes Elisp files
|
||||
and a Haskell command, "ghc-mod".
|
||||
"ghc*.el" enable completion of
|
||||
Haskell symbols on Emacs.
|
||||
Flymake is also integrated.
|
||||
"ghc-mod" is a backend of "ghc*.el".
|
||||
It lists up all installed modules
|
||||
or extracts names of functions, classes,
|
||||
and data declarations.
|
||||
To use "ghc-mod" on Vim,
|
||||
see <https://github.com/eagletmt/ghcmod-vim> or
|
||||
<https://github.com/scrooloose/syntastic>
|
||||
Category: Development
|
||||
Cabal-Version: >= 1.6
|
||||
Build-Type: Simple
|
||||
Data-Dir: elisp
|
||||
Data-Files: Makefile ghc.el ghc-func.el ghc-doc.el ghc-comp.el
|
||||
ghc-flymake.el ghc-command.el ghc-info.el
|
||||
ghc-ins-mod.el ghc-indent.el
|
||||
Executable ghc-mod
|
||||
Main-Is: GHCMod.hs
|
||||
Other-Modules: Browse
|
||||
CabalApi
|
||||
Cabal
|
||||
CabalDev
|
||||
Check
|
||||
ErrMsg
|
||||
Flag
|
||||
GHCApi
|
||||
GHCChoice
|
||||
Gap
|
||||
Info
|
||||
Lang
|
||||
Lint
|
||||
List
|
||||
Paths_ghc_mod
|
||||
Types
|
||||
GHC-Options: -Wall
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, Cabal >= 1.10
|
||||
, template-haskell
|
||||
|
||||
Test-Suite spec
|
||||
Main-Is: Spec.hs
|
||||
Hs-Source-Dirs: test, .
|
||||
Type: exitcode-stdio-1.0
|
||||
Other-Modules: Expectation
|
||||
BrowseSpec
|
||||
CabalApiSpec
|
||||
FlagSpec
|
||||
LangSpec
|
||||
LintSpec
|
||||
ListSpec
|
||||
Build-Depends: base >= 4.0 && < 5
|
||||
, Cabal >= 1.10
|
||||
|
||||
Source-Repository head
|
||||
Type: git
|
||||
Location: git://github.com/kazu-yamamoto/ghc-mod.git
|
||||
|
|
@ -1,11 +0,0 @@
|
|||
module Data.Foo where
|
||||
|
||||
foo :: Int
|
||||
foo = undefined
|
||||
|
||||
fibonacci :: Int -> Integer
|
||||
fibonacci n = fib 1 0 1
|
||||
where
|
||||
fib m x y
|
||||
| n == m = y
|
||||
| otherwise = fib (m+1) y (x + y)
|
||||
|
|
@ -15,8 +15,7 @@ build-type: Simple
|
|||
cabal-version: >=1.8
|
||||
|
||||
library
|
||||
-- exposed-modules:
|
||||
-- other-modules:
|
||||
HS-Source-Dirs: lib
|
||||
build-depends: base
|
||||
exposed-modules: Data.Foo
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +0,0 @@
|
|||
module Hlist where
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Hello, world!"
|
||||
|
|
@ -1 +0,0 @@
|
|||
dummy
|
||||
|
|
@ -6,7 +6,7 @@ main :: IO ()
|
|||
main = doctest [
|
||||
"-package"
|
||||
, "ghc"
|
||||
, "-XConstraintKinds", "-XFlexibleContexts"
|
||||
, "-XConstraintKinds", "-XFlexibleContexts", "-XScopedTypeVariables", "-XRecordWildCards", "-XNamedFieldPuns"
|
||||
, "-idist/build/autogen/"
|
||||
, "-optP-include"
|
||||
, "-optPdist/build/autogen/cabal_macros.h"
|
||||
|
|
|
|||
Loading…
Reference in New Issue