diff --git a/Cabal.hs b/Cabal.hs --- a/Cabal.hs +++ b/Cabal.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings, RecordWildCards #-} -module Cabal (initializeGHC) where +module Cabal (initializeGHC, getDirs, fromCabal) where import CabalApi (cabalParseFile, cabalBuildInfo, cabalDependPackages) import Control.Applicative @@ -9,11 +9,11 @@ import CoreMonad import Data.List import Distribution.PackageDescription (BuildInfo(..), usedExtensions) +import Distribution.Text (display) import ErrMsg import GHC import GHCApi import GHCChoice -import qualified Gap import System.Directory import System.FilePath import Types @@ -30,21 +30,30 @@ logReader <- initSession opt ghcOptions importDirs Nothing logging return (fileName,logReader) withCabal = do - (owdir,cdir,cfile) <- liftIO getDirs - cabal <- liftIO $ cabalParseFile cfile - binfo@BuildInfo{..} <- liftIO $ cabalBuildInfo cabal - let exts = map (addX . Gap.extensionToString) $ usedExtensions binfo - lang = maybe "-XHaskell98" (addX . show) defaultLanguage - libs = map ("-l" ++) extraLibs - libDirs = map ("-L" ++) extraLibDirs - gopts = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs - idirs = case hsSourceDirs of - [] -> [cdir,owdir] - dirs -> map (cdir ) dirs ++ [owdir] - depPkgs <- liftIO $ cabalDependPackages cabal + (gopts,idirs,depPkgs) <- liftIO $ fromCabal ghcOptions logReader <- initSession opt gopts idirs (Just depPkgs) logging return (fileName,logReader) - addX = ("-X" ++) + +fromCabal :: [String] -> IO ([String], [FilePath], [String]) +fromCabal ghcOptions = do + (owdir,cdir,cfile) <- getDirs + cabal <- cabalParseFile cfile + binfo@BuildInfo{..} <- cabalBuildInfo cabal + let exts = map (("-X" ++) . display) $ usedExtensions binfo + lang = maybe "-XHaskell98" (("-X" ++) . display) defaultLanguage + libs = map ("-l" ++) extraLibs + libDirs = map ("-L" ++) extraLibDirs + gopts = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs + idirs = case hsSourceDirs of + [] -> [cdir,owdir] + dirs -> map (cdir ) dirs ++ [owdir] + depPkgs <- removeMe cfile <$> cabalDependPackages cabal + return (gopts,idirs,depPkgs) + +removeMe :: FilePath -> [String] -> [String] +removeMe cabalfile depPkgs = filter (/= me) depPkgs + where + me = dropExtension $ takeFileName cabalfile ---------------------------------------------------------------- diff --git a/CabalApi.hs b/CabalApi.hs --- a/CabalApi.hs +++ b/CabalApi.hs @@ -25,7 +25,7 @@ -- Causes error, catched in the upper function. cabalBuildInfo :: GenericPackageDescription -> IO BuildInfo -cabalBuildInfo pd = do +cabalBuildInfo pd = return . fromJust $ fromLibrary pd <|> fromExecutable pd where fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c diff --git a/CabalDev.hs b/CabalDev.hs --- a/CabalDev.hs +++ b/CabalDev.hs @@ -21,29 +21,30 @@ notFound = return opts findCabalDev :: Maybe String -> IO FilePath +findCabalDev Nothing = getCurrentDirectory >>= searchIt . splitPath findCabalDev (Just path) = do exist <- doesDirectoryExist path if exist then findConf path else findCabalDev Nothing -findCabalDev Nothing = getCurrentDirectory >>= searchIt . splitPath addPath :: Options -> String -> Options -addPath orig_opts path = do - let orig_ghcopt = ghcOpts orig_opts - orig_opts { ghcOpts = orig_ghcopt ++ ["-package-conf", path, "-no-user-package-conf"] } +addPath orig_opts path = orig_opts { ghcOpts = opts' } + where + orig_ghcopt = ghcOpts orig_opts + opts' = orig_ghcopt ++ ["-package-conf", path, "-no-user-package-conf"] searchIt :: [FilePath] -> IO FilePath searchIt [] = throwIO $ userError "Not found" searchIt path = do - let cabalDir = mpath path exist <- doesDirectoryExist cabalDir if exist then findConf cabalDir else searchIt $ init path where + cabalDir = mpath path mpath a = joinPath a "cabal-dev/" findConf :: FilePath -> IO FilePath diff --git a/Check.hs b/Check.hs --- a/Check.hs +++ b/Check.hs @@ -26,5 +26,5 @@ _ <- load LoadAllTargets liftIO readLog options - | expandSplice opt = ["-w:"] ++ ghcOpts opt - | otherwise = ["-Wall"] ++ ghcOpts opt + | expandSplice opt = "-w:" : ghcOpts opt + | otherwise = "-Wall" : ghcOpts opt diff --git a/Gap.hs b/Gap.hs --- a/Gap.hs +++ b/Gap.hs @@ -15,7 +15,6 @@ , fOptions , toStringBuffer , liftIO - , extensionToString , showSeverityCaption #if __GLASGOW_HASKELL__ >= 702 #else @@ -31,7 +30,6 @@ import FastString import GHC import GHCChoice -import Language.Haskell.Extension import Outputable import StringBuffer @@ -205,19 +203,8 @@ showSeverityCaption :: Severity -> String #if __GLASGOW_HASKELL__ >= 706 -showSeverityCaption SevWarning = "Warning:" +showSeverityCaption SevWarning = "Warning: " showSeverityCaption _ = "" #else showSeverityCaption = const "" -#endif ----------------------------------------------------------------- --- This is Cabal, not GHC API - -extensionToString :: Extension -> String -#if __GLASGOW_HASKELL__ == 704 -extensionToString (EnableExtension ext) = show ext -extensionToString (DisableExtension ext) = show ext -- FIXME -extensionToString (UnknownExtension ext) = ext -#else -extensionToString = show #endif diff --git a/ghc-mod.cabal b/ghc-mod.cabal --- a/ghc-mod.cabal +++ b/ghc-mod.cabal @@ -1,5 +1,5 @@ Name: ghc-mod -Version: 1.11.3 +Version: 1.11.4 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -19,13 +19,20 @@ see or Category: Development -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.10 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 +Extra-Source-Files: test/data/*.cabal + test/data/*.hs + test/data/ghc-mod-check/*.hs + test/data/ghc-mod-check/*.cabal + test/data/ghc-mod-check/Data/*.hs + test/data/subdir1/subdir2/dummy Executable ghc-mod + Default-Language: Haskell2010 Main-Is: GHCMod.hs Other-Modules: Browse CabalApi @@ -61,6 +68,40 @@ , syb , time , transformers + +Test-Suite spec + Default-Language: Haskell2010 + Main-Is: Spec.hs + Hs-Source-Dirs: test, . + Type: exitcode-stdio-1.0 + Other-Modules: Expectation + BrowseSpec + CabalSpec + CabalApiSpec + CheckSpec + FlagSpec + InfoSpec + LangSpec + LintSpec + ListSpec + Build-Depends: base >= 4.0 && < 5 + , Cabal >= 1.10 + , containers + , convertible + , directory + , filepath + , ghc + , ghc-paths + , ghc-syb-utils + , hlint >= 1.7.1 + , io-choice + , old-time + , process + , regex-posix + , syb + , time + , transformers + , hspec Source-Repository head Type: git diff --git a/test/BrowseSpec.hs b/test/BrowseSpec.hs new file mode 100644 --- /dev/null +++ b/test/BrowseSpec.hs @@ -0,0 +1,14 @@ +module BrowseSpec where + +import Control.Applicative +import Test.Hspec +import Browse +import Expectation +import Types + +spec :: Spec +spec = do + describe "browseModule" $ do + it "lists up symbols in the module" $ do + syms <- lines <$> browseModule defaultOptions "Data.Map" + syms `shouldContain` "differenceWithKey" diff --git a/test/CabalApiSpec.hs b/test/CabalApiSpec.hs new file mode 100644 --- /dev/null +++ b/test/CabalApiSpec.hs @@ -0,0 +1,17 @@ +module CabalApiSpec where + +import Test.Hspec +import CabalApi + +spec :: Spec +spec = do + describe "cabalDependPackages" $ do + it "extracts dependent packages" $ do + pkgs <- cabalParseFile "test/data/cabalapi.cabal" >>= cabalDependPackages + pkgs `shouldBe` ["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"] + + describe "cabalBuildInfo" $ do + it "extracts build info" $ do + info <- cabalParseFile "test/data/cabalapi.cabal" >>= cabalBuildInfo + let infoStr = show info + infoStr `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 = []}" diff --git a/test/CabalSpec.hs b/test/CabalSpec.hs new file mode 100644 --- /dev/null +++ b/test/CabalSpec.hs @@ -0,0 +1,23 @@ +module CabalSpec where + +import Control.Applicative +import System.Directory +import Test.Hspec +import Cabal +import Expectation + +spec :: Spec +spec = do + describe "getDirs" $ do + it "obtains two directories and a cabal file" $ do + len <- length <$> getCurrentDirectory + withDirectory "test/data/subdir1/subdir2" $ do + (x,y,z) <- getDirs + (drop len x, drop len y, drop len z) `shouldBe` ("/test/data/subdir1/subdir2","/test/data","/test/data/cabalapi.cabal") + + describe "getDirs" $ do + it "obtains two directories and a cabal file" $ do + len <- length <$> getCurrentDirectory + withDirectory "test/data/subdir1/subdir2" $ do + (x,y,z) <- fromCabal [] + (x, map (drop len) y, z) `shouldBe` (["-XHaskell98"],["/test/data","/test/data/subdir1/subdir2"],["Cabal","base","containers","convertible","directory","filepath","ghc","ghc-paths","ghc-syb-utils","hlint","hspec","io-choice","old-time","process","regex-posix","syb","time","transformers"]) diff --git a/test/CheckSpec.hs b/test/CheckSpec.hs new file mode 100644 --- /dev/null +++ b/test/CheckSpec.hs @@ -0,0 +1,14 @@ +module CheckSpec where + +import Test.Hspec +import Check +import Expectation +import Types + +spec :: Spec +spec = do + describe "checkSyntax" $ do + it "can check even if an executable depends on its library" $ do + withDirectory "test/data/ghc-mod-check" $ do + res <- checkSyntax defaultOptions "main.hs" + res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n" diff --git a/test/Expectation.hs b/test/Expectation.hs new file mode 100644 --- /dev/null +++ b/test/Expectation.hs @@ -0,0 +1,15 @@ +module Expectation where + +import Test.Hspec +import System.Directory +import Control.Exception as E + +shouldContain :: Eq a => [a] -> a -> Expectation +shouldContain containers element = do + let res = element `elem` containers + res `shouldBe` True + +withDirectory :: FilePath -> IO a -> IO a +withDirectory dir action = bracket getCurrentDirectory + setCurrentDirectory + (\_ -> setCurrentDirectory dir >> action) diff --git a/test/FlagSpec.hs b/test/FlagSpec.hs new file mode 100644 --- /dev/null +++ b/test/FlagSpec.hs @@ -0,0 +1,14 @@ +module FlagSpec where + +import Control.Applicative +import Test.Hspec +import Expectation +import Flag +import Types + +spec :: Spec +spec = do + describe "listFlags" $ do + it "lists up GHC flags" $ do + flags <- lines <$> listFlags defaultOptions + flags `shouldContain` "-fno-warn-orphans" diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs new file mode 100644 --- /dev/null +++ b/test/InfoSpec.hs @@ -0,0 +1,14 @@ +module InfoSpec where + +import Test.Hspec +import Expectation +import Info +import Types + +spec :: Spec +spec = do + describe "typeExpr" $ do + it "shows types of the expression and its outers" $ do + withDirectory "test/data/ghc-mod-check" $ do + res <- typeExpr defaultOptions "Data.Foo" 9 5 "Data/Foo.hs" + res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n" diff --git a/test/LangSpec.hs b/test/LangSpec.hs new file mode 100644 --- /dev/null +++ b/test/LangSpec.hs @@ -0,0 +1,14 @@ +module LangSpec where + +import Control.Applicative +import Test.Hspec +import Expectation +import Lang +import Types + +spec :: Spec +spec = do + describe "listLanguages" $ do + it "lists up language extensions" $ do + exts <- lines <$> listLanguages defaultOptions + exts `shouldContain` "OverloadedStrings" diff --git a/test/LintSpec.hs b/test/LintSpec.hs new file mode 100644 --- /dev/null +++ b/test/LintSpec.hs @@ -0,0 +1,13 @@ +module LintSpec where + +import Test.Hspec +import Lint +import Types + +spec :: Spec +spec = do + describe "lintSyntax" $ do + it "check syntax with HList" $ do + res <- lintSyntax defaultOptions "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" + diff --git a/test/ListSpec.hs b/test/ListSpec.hs new file mode 100644 --- /dev/null +++ b/test/ListSpec.hs @@ -0,0 +1,14 @@ +module ListSpec where + +import Control.Applicative +import Test.Hspec +import Expectation +import List +import Types + +spec :: Spec +spec = do + describe "listModules" $ do + it "lists up module names" $ do + modules <- lines <$> listModules defaultOptions + modules `shouldContain` "Data.Map" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/data/cabalapi.cabal b/test/data/cabalapi.cabal new file mode 100644 --- /dev/null +++ b/test/data/cabalapi.cabal @@ -0,0 +1,97 @@ +Name: ghc-mod +Version: 1.11.3 +Author: Kazu Yamamoto +Maintainer: Kazu Yamamoto +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 or + +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 + , containers + , convertible + , directory + , filepath + , ghc + , ghc-paths + , ghc-syb-utils + , hlint >= 1.7.1 + , io-choice + , old-time + , process + , regex-posix + , syb + , time + , transformers + +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 + , containers + , convertible + , directory + , filepath + , ghc + , ghc-paths + , ghc-syb-utils + , hlint >= 1.7.1 + , io-choice + , old-time + , process + , regex-posix + , syb + , time + , transformers + , hspec + +Source-Repository head + Type: git + Location: git://github.com/kazu-yamamoto/ghc-mod.git diff --git a/test/data/ghc-mod-check/Data/Foo.hs b/test/data/ghc-mod-check/Data/Foo.hs new file mode 100644 --- /dev/null +++ b/test/data/ghc-mod-check/Data/Foo.hs @@ -0,0 +1,11 @@ +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) diff --git a/test/data/ghc-mod-check/ghc-mod-check.cabal b/test/data/ghc-mod-check/ghc-mod-check.cabal new file mode 100644 --- /dev/null +++ b/test/data/ghc-mod-check/ghc-mod-check.cabal @@ -0,0 +1,27 @@ +-- Initial ghc-mod-check.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: ghc-mod-check +version: 0.1.0.0 +synopsis: check test +-- description: +license: BSD3 +license-file: LICENSE +author: Kazu Yamamoto +maintainer: kazu@iij.ad.jp +-- copyright: +category: Data +build-type: Simple +cabal-version: >=1.8 + +library + -- exposed-modules: + -- other-modules: + build-depends: base + exposed-modules: Data.Foo + +executable foo + Main-Is: main.hs + GHC-Options: -Wall + Build-Depends: base >= 4 && < 5 + , ghc-mod-check diff --git a/test/data/ghc-mod-check/main.hs b/test/data/ghc-mod-check/main.hs new file mode 100644 --- /dev/null +++ b/test/data/ghc-mod-check/main.hs @@ -0,0 +1,5 @@ +module Main where + +import Data.Foo + +main = print foo diff --git a/test/data/hlint.hs b/test/data/hlint.hs new file mode 100644 --- /dev/null +++ b/test/data/hlint.hs @@ -0,0 +1,5 @@ +module Hlist where + +main :: IO () +main = do + putStrLn "Hello, world!" diff --git a/test/data/subdir1/subdir2/dummy b/test/data/subdir1/subdir2/dummy new file mode 100644 --- /dev/null +++ b/test/data/subdir1/subdir2/dummy @@ -0,0 +1,1 @@ +dummy