refactoring for testing.

Cradle.hs

@@ -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,18 +19,15 @@ 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
@@ -41,20 +35,17 @@ findCradle Nothing = do
             cradleCurrentDir  = wdir
           , cradleCabalDir    = Nothing
           , cradleCabalFile   = Nothing
-          , cradlePackageConfOpts = Nothing
-          , cradleGHCVersion      = strver
+          , 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
+              , 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"]

Debug.hs

@@ -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

GHCMod.hs

@@ -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"]

Types.hs

@@ -68,8 +68,7 @@ data Cradle = Cradle {
     cradleCurrentDir  :: FilePath
   , cradleCabalDir    :: Maybe FilePath
   , cradleCabalFile   :: Maybe FilePath
-  , cradlePackageConfOpts :: Maybe [String]
-  , cradleGHCVersion      :: String
+  , cradlePackageConf :: Maybe FilePath
   } deriving Show
 
 ----------------------------------------------------------------

test/CheckSpec.hs

@@ -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"

test/InfoSpec.hs

@@ -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"