hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' (early part) into release

Browse Source 
Conflicts:
	Language/Haskell/GhcMod/Utils.hs
This commit is contained in:
Daniel Gröber 2014-10-30 01:12:28 +01:00
commit ceeea5d19f
10 changed files with 109 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Language/Haskell/GhcMod/Cradle.hs
View File

@ -2,6 +2,7 @@ module Language.Haskell.GhcMod.Cradle (
findCradle
, findCradle'
, findCradleWithoutSandbox
, cleanupCradle
) where
import Language.Haskell.GhcMod.Types
@ -12,8 +13,10 @@ import qualified Control.Exception as E
import Control.Exception.IOChoice ((||>))
import Control.Monad (filterM)
import Data.List (isSuffixOf)
import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist)
import System.Directory (getCurrentDirectory, getDirectoryContents, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive)
import System.FilePath ((</>), takeDirectory)
import System.IO.Temp
----------------------------------------------------------------
@ -27,13 +30,26 @@ findCradle = findCradle' =<< getCurrentDirectory
findCradle' :: FilePath -> IO Cradle
findCradle' dir = cabalCradle dir ||> sandboxCradle dir ||> plainCradle dir
newTempDir :: FilePath -> IO FilePath
newTempDir dir =
flip createTempDirectory uniqPathName =<< getTemporaryDirectory
where
uniqPathName = "ghc-mod" ++ map escapeSlash dir
escapeSlash '/' = '-'
escapeSlash c = c
cleanupCradle :: Cradle -> IO ()
cleanupCradle crdl = removeDirectoryRecursive $ cradleTempDir crdl
cabalCradle :: FilePath -> IO Cradle
cabalCradle wdir = do
(rdir,cfile) <- cabalDir wdir
pkgDbStack <- getPackageDbStack rdir
tmpDir <- newTempDir rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleTempDir = tmpDir
, cradleCabalFile = Just cfile
, cradlePkgDbStack = pkgDbStack
}
@ -42,17 +58,22 @@ sandboxCradle :: FilePath -> IO Cradle
sandboxCradle wdir = do
rdir <- getSandboxDir wdir
pkgDbStack <- getPackageDbStack rdir
tmpDir <- newTempDir rdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = rdir
, cradleTempDir = tmpDir
, cradleCabalFile = Nothing
, cradlePkgDbStack = pkgDbStack
}
plainCradle :: FilePath -> IO Cradle
plainCradle wdir = return Cradle {
plainCradle wdir = do
tmpDir <- newTempDir wdir
return Cradle {
cradleCurrentDir = wdir
, cradleRootDir = wdir
, cradleTempDir = tmpDir
, cradleCabalFile = Nothing
, cradlePkgDbStack = [GlobalDb, UserDb]
}

12
Language/Haskell/GhcMod/Find.hs
View File

@ -17,7 +17,6 @@ module Language.Haskell.GhcMod.Find
import Control.Applicative ((<$>))
import Control.Monad (when, void)
import Control.Monad.Error.Class
import Data.Function (on)
import Data.List (groupBy, sort)
import Data.Maybe (fromMaybe)
@ -87,10 +86,11 @@ lookupSym sym db = fromMaybe [] $ M.lookup sym $ table db
---------------------------------------------------------------
-- | Loading a file and creates 'SymbolDb'.
loadSymbolDb :: (IOish m, MonadError GhcModError m) => m SymbolDb
loadSymbolDb :: IOish m => GhcModT m SymbolDb
loadSymbolDb = do
ghcMod <- liftIO ghcModExecutable
file <- chop <$> readProcess' ghcMod ["dumpsym"]
tmpdir <- liftIO . getPackageCachePath =<< cradle
file <- chop <$> readProcess' ghcMod ["dumpsym", tmpdir]
!db <- M.fromAscList . map conv . lines <$> liftIO (readFile file)
return $ SymbolDb {
table = db
@ -110,10 +110,8 @@ loadSymbolDb = do
-- if the file does not exist or is invalid.
-- The file name is printed.
dumpSymbol :: IOish m => GhcModT m String
dumpSymbol = do
crdl <- cradle
dir <- liftIO $ getPackageCachePath crdl
dumpSymbol :: IOish m => FilePath -> GhcModT m String
dumpSymbol dir = do
let cache = dir </> symbolCache
pkgdb = dir </> packageCache

13
Language/Haskell/GhcMod/GhcPkg.hs
View File

@ -16,16 +16,19 @@ module Language.Haskell.GhcMod.GhcPkg (
import Config (cProjectVersion, cTargetPlatformString, cProjectVersionInt)
import Control.Applicative ((<$>))
import Control.Exception (SomeException(..))
import Control.Monad
import qualified Control.Exception as E
import Data.Char (isSpace)
import Data.List (isPrefixOf, intercalate)
import Data.List.Split (splitOn)
import Data.Maybe
import Distribution.Package (InstalledPackageId(..))
import Exception (handleIO)
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.Utils
import System.Directory (doesDirectoryExist, getAppUserDataDirectory)
import System.FilePath ((</>))
import qualified Data.Traversable as T
ghcVersion :: Int
ghcVersion = read cProjectVersionInt
@ -117,12 +120,14 @@ packageCache = "package.cache"
packageConfDir :: String
packageConfDir = "package.conf.d"
-- fixme: error handling
getPackageCachePath :: Cradle -> IO FilePath
getPackageCachePath crdl = do
let u:_ = filter (/= GlobalDb) $ cradlePkgDbStack crdl
Just db <- resolvePath u
return db
let mu = listToMaybe $ filter (/= GlobalDb) $ cradlePkgDbStack crdl
mdb <- join <$> resolvePath `T.traverse` mu
let dir = case mdb of
Just db -> db
Nothing -> cradleTempDir crdl
return dir
--- Copied from ghc module `Packages' unfortunately it's not exported :/
resolvePath :: GhcPkgDb -> IO (Maybe FilePath)

7
Language/Haskell/GhcMod/Monad.hs
View File

@ -244,6 +244,9 @@ newGhcModEnv opt dir = do
, gmCradle = c
}
cleanupGhcModEnv :: GhcModEnv -> IO ()
cleanupGhcModEnv env = cleanupCradle $ gmCradle env
-- | Run a @GhcModT m@ computation.
runGhcModT :: IOish m
=> Options
@ -251,11 +254,13 @@ runGhcModT :: IOish m
-> m (Either GhcModError a, GhcModLog)
runGhcModT opt action = do
env <- liftBase $ newGhcModEnv opt =<< getCurrentDirectory
first (fst <$>) <$> (runGhcModT' env defaultState $ do
r <- first (fst <$>) <$> (runGhcModT' env defaultState $ do
dflags <- getSessionDynFlags
defaultCleanupHandler dflags $ do
initializeFlagsWithCradle opt (gmCradle env)
action)
liftBase $ cleanupGhcModEnv env
return r
-- | @hoistGhcModT result@. Embed a GhcModT computation's result into a GhcModT
-- computation. Note that if the computation that returned @result@ modified the

7
Language/Haskell/GhcMod/Types.hs
View File

@ -19,9 +19,10 @@ type IOish m = (Functor m, MonadIO m, MonadBaseControl IO m, ExceptionMonad m)
-- | Output style.
data OutputStyle = LispStyle -- ^ S expression style.
| PlainStyle -- ^ Plain textstyle.
deriving (Show)
-- | The type for line separator. Historically, a Null string is used.
newtype LineSeparator = LineSeparator String
newtype LineSeparator = LineSeparator String deriving (Show)
data Options = Options {
outputStyle :: OutputStyle
@ -40,7 +41,7 @@ data Options = Options {
-- | If 'True', 'browse' will return fully qualified name
, qualified :: Bool
, hlintOpts :: [String]
}
} deriving (Show)
-- | A default 'Options'.
@ -65,6 +66,8 @@ data Cradle = Cradle {
cradleCurrentDir :: FilePath
-- | The project root directory.
, cradleRootDir :: FilePath
-- | Per-Project temporary directory
, cradleTempDir :: FilePath
-- | The file name of the found cabal file.
, cradleCabalFile :: Maybe FilePath
-- | Package database stack

15
Language/Haskell/GhcMod/Utils.hs
View File

@ -1,16 +1,15 @@
{-# LANGUAGE CPP #-}
module Language.Haskell.GhcMod.Utils where
import Control.Applicative ((<$>))
import Language.Haskell.GhcMod.Error
import MonadUtils (MonadIO, liftIO)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import System.Exit (ExitCode(..))
import System.Process (readProcessWithExitCode)
import System.FilePath (takeDirectory)
import System.Environment
#ifndef SPEC
import System.FilePath ((</>))
import Control.Applicative ((<$>))
import System.Environment
import System.FilePath ((</>),takeDirectory)
#endif
-- dropWhileEnd is not provided prior to base 4.5.0.0.
@ -56,11 +55,6 @@ ghcModExecutable :: IO FilePath
ghcModExecutable = do
dir <- getExecutablePath'
return $ dir </> "ghc-mod"
#else
ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
-- compiling spec
return "dist/build/ghc-mod/ghc-mod"
#endif
where
getExecutablePath' :: IO FilePath
# if __GLASGOW_HASKELL__ >= 706
@ -68,3 +62,6 @@ ghcModExecutable = do _ <- getExecutablePath' -- get rid of unused warning when
# else
getExecutablePath' = return ""
# endif
#else
ghcModExecutable = return "dist/build/ghc-mod/ghc-mod"
#endif

2
ghc-mod.cabal
View File

@ -109,6 +109,7 @@ Library
, pretty
, process
, syb
, temporary
, time
, transformers
, transformers-base
@ -212,6 +213,7 @@ Test-Suite spec
, pretty
, process
, syb
, temporary
, time
, transformers
, transformers-base

43
hcar-ghc-mod.tex
View File

@ -1,40 +1,25 @@
% ghcmodHappyHaskellProgram-Kg.tex
\begin{hcarentry}[updated]{ghc-mod --- Happy Haskell Programming}
\report{Kazu Yamamoto}%05/14
\report{Kazu Yamamoto}%11/14
\status{open source, actively developed}
\makeheader
{\tt ghc-mod} is a package to enrich Haskell programming on editors including Emacs, Vim and Sublime. The {\tt ghc-mod} package on Hackage includes the {\tt ghc-mod} command, new {\tt ghc-modi} command and Emacs front-end.
For a long time, Kazu Yamamoto was the only active developer of ghc-mod, now two
new developers have joined:
Emacs front-end provides the following features:
Alejandro Serrano merged the results of his Google Summer of Code project. He
implemented case splitting and sophisticated typed hole handling. Daniel Gröber
brushed up the internal code and introduced the GhcModT monad now used
throughout the exported API. As a result the API of \texttt{ghc-mod} drastically
changed with version 5.0.0.
\begin{description}
\item[Completion] You can complete a name of keyword, module, class, function, types, language extensions, etc.
\texttt{ghc-modi} used to suffer from various consistency related issues
triggered by changes in the environment, for instance: changing file names of
modules, adding dependencies to the cabal file and installing new libraries.
\texttt{ghc-modi} v5.1.1 or later handles changes in the environment by
restarting the GHC session when this is detected.
\item[Code template] You can insert a code template according to the position of the cursor. For instance, {\tt import Foo (bar)} is inserted if {\tt bar} is missing.
\item[Syntax check] Code lines with error messages are automatically highlighted. You can display the error message of the current line in another window. {\tt hlint} %\cref{hlint}
can be used instead of GHC to check Haskell syntax.
\item[Document browsing] You can browse the module document of the current line either locally or on Hackage.
\item[Expression type] You can display the type/information of the expression on the cursor.
\end{description}
\noindent
There are two Vim plugins:
\begin{itemize}
\item ghcmod-vim
\item syntastic
\end{itemize}
\noindent
Here are new features:
\begin{itemize}
\item New {\tt ghc-modi} command provides a persistent session to make response time drastically faster. So, now you can use Emacs front-end without stress.
\item Emacs front-end provides a way to solve the import hell.
\item GHC 7.8 is supported.
\end{itemize}
Kazu stepped down as release manager and Daniel took over.
\FurtherReading
\url{http://www.mew.org/~kazu/proj/ghc-mod/en/}

39
src/GHCMod.hs
View File

@ -3,7 +3,6 @@
module Main where
import Config (cProjectVersion)
import Control.Arrow
import Control.Applicative
import Control.Exception (Exception, Handler(..), catches, throw)
import Data.Typeable (Typeable)
@ -295,13 +294,13 @@ main = handler $ do
hSetEncoding stdout utf8
args <- getArgs
let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args
_realGhcArgs = filter (/="--ghc-mod") ghcArgs
-- let (ghcArgs, modArgs) = second stripSeperator $ span (/="--") args
-- _realGhcArgs = filter (/="--ghc-mod") ghcArgs
(globalOptions,_cmdArgs) = parseGlobalArgs modArgs
-- (globalOptions,_cmdArgs) = parseGlobalArgs modArgs
stripSeperator ("--":rest) = rest
stripSeperator l = l
-- stripSeperator ("--":rest) = rest
-- stripSeperator l = l
case args of
_
@ -323,9 +322,14 @@ main = handler $ do
| otherwise -> do
(res, _) <- runGhcModT globalOptions $ commands args
case res of
Right s -> putStr s
let (globalOptions,cmdArgs) = parseGlobalArgs args
res <- simpleCommands cmdArgs
putStr =<< case res of
Just s -> return s
Nothing -> do
(res',_) <- runGhcModT globalOptions $ ghcCommands cmdArgs
case res' of
Right s -> return s
Left e -> exitError $ render (gmeDoc e)
-- Obtain ghc options by letting ourselfs be executed by
@ -339,14 +343,19 @@ main = handler $ do
-- rawSystem "cabal" cabalArgs >>= exitWith
commands :: IOish m => [String] -> GhcModT m String
commands [] = fatalError "No command given (try --help)\n"
commands (cmd:args) = fn args
simpleCommands :: [String] -> IO (Maybe String)
simpleCommands [] = return Nothing
simpleCommands (cmd:_) = return $ case cmd of
_ | cmd == "help" || cmd == "--help" -> Just usage
"version" -> Just progVersion
_ -> Nothing
ghcCommands :: IOish m => [String] -> GhcModT m String
ghcCommands [] = fatalError "No command given (try --help)\n"
ghcCommands (cmd:args) = fn args
where
fn = case cmd of
_ | cmd == "list" || cmd == "modules" -> modulesCmd
_ | cmd == "help" || cmd == "--help" -> const $ return usage
"version" -> const $ return progVersion
"lang" -> languagesCmd
"flag" -> flagsCmd
"browse" -> browseCmd
@ -400,9 +409,9 @@ flagsCmd = withParseCmd [] $ \[] -> flags
debugInfoCmd = withParseCmd [] $ \[] -> debugInfo
rootInfoCmd = withParseCmd [] $ \[] -> rootInfo
-- internal
dumpSymbolCmd = withParseCmd [] $ \[] -> dumpSymbol
bootCmd = withParseCmd [] $ \[] -> boot
dumpSymbolCmd = withParseCmd [] $ \[tmpdir] -> dumpSymbol tmpdir
findSymbolCmd = withParseCmd [] $ \[sym] -> findSymbol sym
pkgDocCmd = withParseCmd [] $ \[mdl] -> pkgDoc mdl
lintCmd = withParseCmd s $ \[file] -> lint file

32
test/CradleSpec.hs
View File

@ -17,31 +17,27 @@ spec = do
withDirectory_ "/" $ do
curDir <- stripLastDot <$> canonicalizePath "/"
res <- findCradle
res `shouldBe` Cradle {
cradleCurrentDir = curDir
, cradleRootDir = curDir
, cradleCabalFile = Nothing
, cradlePkgDbStack = [GlobalDb,UserDb]
}
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
res `shouldBe` Cradle {
cradleCurrentDir = "test" </> "data" </> "subdir1" </> "subdir2"
, cradleRootDir = "test" </> "data"
, cradleCabalFile = Just ("test" </> "data" </> "cabalapi.cabal")
, cradlePkgDbStack = [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
}
cradleCurrentDir res `shouldBe` "test" </> "data" </> "subdir1" </> "subdir2"
cradleRootDir res `shouldBe` "test" </> "data"
cradleCabalFile res `shouldBe` Just ("test" </> "data" </> "cabalapi.cabal")
cradlePkgDbStack res `shouldBe` [GlobalDb, PackageDb (cwd </> "test/data/.cabal-sandbox/i386-osx-ghc-7.6.3-packages.conf.d")]
it "works even if a sandbox config file is broken" $ do
withDirectory "test/data/broken-sandbox" $ \dir -> do
res <- relativeCradle dir <$> findCradle
res `shouldBe` Cradle {
cradleCurrentDir = "test" </> "data" </> "broken-sandbox"
, cradleRootDir = "test" </> "data" </> "broken-sandbox"
, cradleCabalFile = Just ("test" </> "data" </> "broken-sandbox" </> "dummy.cabal")
, cradlePkgDbStack = [GlobalDb, UserDb]
}
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]
relativeCradle :: FilePath -> Cradle -> Cradle
relativeCradle dir cradle = cradle {