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

refactoring for testing.

This commit is contained in:
Kazu Yamamoto 2013-03-04 18:11:09 +09:00
parent 69cc0f8ce4
commit 1047c76906
6 changed files with 47 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
Cradle.hs
View File

@ -1,6 +1,5 @@
module Cradle where
import CabalApi (getGHCVersion)
import Control.Applicative ((<$>))
import Control.Exception (throwIO)
import Control.Monad
@ -10,11 +9,9 @@ import System.FilePath ((</>),takeDirectory)
import Types
-- An error would be thrown
findCradle :: Maybe FilePath -> IO Cradle
findCradle (Just sbox) = do
(strver, ver) <- getGHCVersion
conf <- checkPackageConf sbox strver
let confOpts = ghcPackageConfOptions ver conf
findCradle :: Maybe FilePath -> String -> IO Cradle
findCradle (Just sbox) strver = do
pkgConf <- checkPackageConf sbox strver
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
return $ case cfiles of
@ -22,39 +19,33 @@ findCradle (Just sbox) = do
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConfOpts = Just confOpts
, cradleGHCVersion = strver
, cradlePackageConf = Just pkgConf
}
Just (cdir,cfile) -> Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConfOpts = Just confOpts
, cradleGHCVersion = strver
, cradlePackageConf = Just pkgConf
}
findCradle Nothing = do
(strver, ver) <- getGHCVersion
findCradle Nothing strver = do
wdir <- getCurrentDirectory
cfiles <- cabalDir wdir
case cfiles of
Nothing -> return Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConfOpts = Nothing
, cradleGHCVersion = strver
cradleCurrentDir = wdir
, cradleCabalDir = Nothing
, cradleCabalFile = Nothing
, cradlePackageConf = Nothing
}
Just (cdir,cfile) -> do
let sbox = cdir </> "cabal-dev/"
conf = packageConfName sbox strver
confOpts = ghcPackageConfOptions ver conf
exist <- doesFileExist conf
pkgConf = packageConfName sbox strver
exist <- doesFileExist pkgConf
return Cradle {
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConfOpts = if exist then Just confOpts else Nothing
, cradleGHCVersion = strver
cradleCurrentDir = wdir
, cradleCabalDir = Just cdir
, cradleCabalFile = Just cfile
, cradlePackageConf = if exist then Just pkgConf else Nothing
}
cabalDir :: FilePath -> IO (Maybe (FilePath,FilePath))
@ -80,8 +71,3 @@ checkPackageConf path ver = do
return conf
else
throwIO $ userError $ conf ++ " not found"
ghcPackageConfOptions :: Int -> String -> [String]
ghcPackageConfOptions ver file
| ver >= 706 = ["-package-db", file, "-no-user-package-conf"]
| otherwise = ["-package-conf", file, "-no-user-package-conf"]

11
Debug.hs
View File

@ -10,11 +10,11 @@ import Types
----------------------------------------------------------------
debugInfo :: Options -> Cradle -> String -> IO String
debugInfo opt cradle fileName = unlines <$> debug opt cradle fileName
debugInfo :: Options -> Cradle -> String -> String -> IO String
debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName
debug :: Options -> Cradle -> String -> IO [String]
debug opt cradle fileName = do
debug :: Options -> Cradle -> String -> String -> IO [String]
debug opt cradle ver fileName = do
(gopts, incDir, pkgs, langext) <-
if cabal then
fromCabalFile (ghcOpts opt) cradle
@ -23,7 +23,7 @@ debug opt cradle fileName = do
dflags <- getDynamicFlags
fast <- getFastCheck dflags fileName (Just langext)
return [
"GHC version: " ++ ghcVer
"GHC version: " ++ ver
, "Current directory: " ++ currentDir
, "Cabal file: " ++ cabalFile
, "GHC options: " ++ intercalate " " gopts
@ -32,7 +32,6 @@ debug opt cradle fileName = do
, "Fast check: " ++ if fast then "Yes" else "No"
]
where
ghcVer = cradleGHCVersion cradle
currentDir = cradleCurrentDir cradle
cabal = isJust $ cradleCabalFile cradle
cabalFile = fromMaybe "" $ cradleCabalFile cradle

22
GHCMod.hs
View File

@ -3,6 +3,7 @@
module Main where
import Browse
import CabalApi
import Check
import Control.Applicative
import Control.Exception
@ -87,8 +88,9 @@ main :: IO ()
main = flip catches handlers $ do
args <- getArgs
let (opt',cmdArg) = parseArgs argspec args
cradle <- findCradle $ sandbox opt'
let opt = ajustOpts opt' cradle
(strVer,ver) <- getGHCVersion
cradle <- findCradle (sandbox opt') strVer
let opt = adjustOpts opt' cradle ver
cmdArg0 = cmdArg !. 0
cmdArg1 = cmdArg !. 1
cmdArg2 = cmdArg !. 2
@ -99,7 +101,7 @@ main = flip catches handlers $ do
"list" -> listModules opt
"check" -> withFile (checkSyntax opt cradle) cmdArg1
"expand" -> withFile (checkSyntax opt { expandSplice = True } cradle) cmdArg1
"debug" -> withFile (debugInfo opt cradle) cmdArg1
"debug" -> withFile (debugInfo opt cradle strVer) cmdArg1
"type" -> withFile (typeExpr opt cradle cmdArg2 (read cmdArg3) (read cmdArg4)) cmdArg1
"info" -> withFile (infoExpr opt cradle cmdArg2 cmdArg3) cmdArg1
"lint" -> withFile (lintSyntax opt) cmdArg1
@ -137,11 +139,13 @@ main = flip catches handlers $ do
xs !. idx
| length xs <= idx = throw SafeList
| otherwise = xs !! idx
ajustOpts opt cradle = case mpkgopts of
adjustOpts opt cradle ver = case mPkgConf of
Nothing -> opt
Just pkgopts -> opt { ghcOpts = pkgopts ++ ghcOpts opt }
Just pkgConf -> opt {
ghcOpts = ghcPackageConfOptions ver pkgConf ++ ghcOpts opt
}
where
mpkgopts = cradlePackageConfOpts cradle
mPkgConf = cradlePackageConf cradle
----------------------------------------------------------------
@ -156,3 +160,9 @@ preBrowsedModules = [
, "Data.Maybe"
, "System.IO"
]
ghcPackageConfOptions :: Int -> String -> [String]
ghcPackageConfOptions ver file
| ver >= 706 = ["-package-db", file, "-no-user-package-conf"]
| otherwise = ["-package-conf", file, "-no-user-package-conf"]

9
Types.hs
View File

@ -65,11 +65,10 @@ addNewLine = (++ "\n")
----------------------------------------------------------------
data Cradle = Cradle {
cradleCurrentDir :: FilePath
, cradleCabalDir :: Maybe FilePath
, cradleCabalFile :: Maybe FilePath
, cradlePackageConfOpts :: Maybe [String]
, cradleGHCVersion :: String
cradleCurrentDir :: FilePath
, cradleCabalDir :: Maybe FilePath
, cradleCabalFile :: Maybe FilePath
, cradlePackageConf :: Maybe FilePath
} deriving Show
----------------------------------------------------------------

4
test/CheckSpec.hs
View File

@ -1,5 +1,6 @@
module CheckSpec where
import CabalApi
import Check
import Cradle
import Expectation
@ -11,6 +12,7 @@ spec = do
describe "checkSyntax" $ do
it "can check even if an executable depends on its library" $ do
withDirectory "test/data/ghc-mod-check" $ do
cradle <- findCradle Nothing
(strVer,_) <- getGHCVersion
cradle <- findCradle Nothing strVer
res <- checkSyntax defaultOptions cradle "main.hs"
res `shouldBe` "main.hs:5:1:Warning: Top-level binding with no type signature: main :: IO ()\NUL\n"

4
test/InfoSpec.hs
View File

@ -1,5 +1,6 @@
module InfoSpec where
import CabalApi
import Cradle
import Expectation
import Info
@ -11,6 +12,7 @@ spec = do
describe "typeExpr" $ do
it "shows types of the expression and its outers" $ do
withDirectory "test/data/ghc-mod-check" $ do
cradle <- findCradle Nothing
(strVer,_) <- getGHCVersion
cradle <- findCradle Nothing strVer
res <- typeExpr defaultOptions cradle "Data.Foo" 9 5 "Data/Foo.hs"
res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"