Change the way cabal-helper is built a bit

CabalHelper/Common.hs

@@ -0,0 +1,96 @@
+-- ghc-mod: Making Haskell development *more* fun
+-- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
+--
+-- This program is free software: you can redistribute it and/or modify
+-- it under the terms of the GNU Affero General Public License as published by
+-- the Free Software Foundation, either version 3 of the License, or
+-- (at your option) any later version.
+--
+-- This program is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+-- GNU Affero General Public License for more details.
+--
+-- You should have received a copy of the GNU Affero General Public License
+-- along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
+module CabalHelper.Common where
+
+import Control.Applicative
+import Control.Exception
+import Control.Monad
+import Data.List
+import Data.Maybe
+import Data.Version
+import Data.Typeable
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
+import System.Environment
+import System.IO
+import System.Exit
+import Text.ParserCombinators.ReadP
+
+data Panic = Panic String deriving (Typeable, Show)
+instance Exception Panic
+
+panic :: String -> a
+panic msg = throw $ Panic msg
+
+handlePanic :: IO a -> IO a
+handlePanic action =
+    action `catch` \(Panic msg) -> errMsg msg >> exitFailure
+
+errMsg :: String -> IO ()
+errMsg str = do
+  prog <- getProgName
+  hPutStrLn stderr $ prog ++ ": " ++ str
+
+align :: String -> String -> String -> String
+align n an str = let
+    h:rest = lines str
+    [hm]   = match n h
+    rest'  = [ move (hm - rm) r | r <- rest, rm <- match an r]
+    in
+      unlines (h:rest')
+ where
+   match p str' = maybeToList $
+     fst <$> find ((p `isPrefixOf`) . snd) ([0..] `zip` tails str')
+   move i str' | i > 0  = replicate i ' ' ++ str'
+   move i str' = drop i str'
+
+
+-- | @getCabalConfigHeader "dist/setup-config"@ returns the cabal version and
+-- compiler version
+getCabalConfigHeader :: FilePath -> IO (Maybe (Version, Version))
+getCabalConfigHeader file = bracket (openFile file ReadMode) hClose $ \h -> do
+  parseHeader <$> BS.hGetLine h
+
+parseHeader :: ByteString -> Maybe (Version, Version)
+parseHeader header = case BS8.words header of
+  ["Saved", "package", "config", "for", _pkgId ,
+   "written", "by", cabalId,
+   "using", compId]
+    -> liftM2 (,) (ver cabalId) (ver compId)
+  _ -> Nothing
+ where
+   ver i = snd <$> parsePkgId i
+
+parsePkgId :: ByteString -> Maybe (ByteString, Version)
+parsePkgId bs =
+    case BS8.split '-' bs of
+      [pkg, vers] -> Just (pkg, parseVer $ BS8.unpack vers)
+      _ -> Nothing
+
+parseVer :: String -> Version
+parseVer vers = runReadP parseVersion vers
+
+-- majorVer :: Version -> Version
+-- majorVer (Version b _) = Version (take 2 b) []
+
+-- sameMajorVersion :: Version -> Version -> Bool
+-- sameMajorVersion a b = majorVer a == majorVer b
+
+runReadP :: ReadP t -> String -> t
+runReadP p i = let (a,""):[] = filter ((=="") . snd) $ readP_to_S p i in a

CabalHelper/Main.hs

@@ -33,6 +33,8 @@ import Distribution.PackageDescription (PackageDescription,
 import Distribution.PackageDescription.Parse (readPackageDescription)
 import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 
+import Distribution.Simple.Program (requireProgram, ghcProgram)
+import Distribution.Simple.Program.Types (ConfiguredProgram(..))
 import Distribution.Simple.Configure (getPersistBuildConfig)
 import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),
                                            Component(..),
@@ -70,26 +72,9 @@ import System.Exit
 import System.IO
 import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
 import Text.Printf
-import Common
 
---- \ / These types MUST be in sync with the copies in lib:ghc-mod
+import CabalHelper.Common
-data GmComponentName = GmSetupHsName
+import CabalHelper.Types
-                     | GmLibName
-                     | GmExeName String
-                     | GmTestName String
-                     | GmBenchName String
-  deriving (Eq, Ord, Read, Show)
-data GmCabalHelperResponse
-    = GmCabalHelperStrings [(GmComponentName, [String])]
-    | GmCabalHelperEntrypoints [(GmComponentName, Either FilePath [ModuleName])]
-    | GmCabalHelperLbi String
-  deriving (Read, Show)
---- ^ These types MUST be in sync with the copies in ../Types.hs
-
-
--- MUST be compatible to the one in GHC
-newtype ModuleName = ModuleName String
-  deriving (Eq, Ord, Read, Show)
 
 usage = do
   prog <- getProgName
@@ -177,7 +162,7 @@ main = do
                                [] -> removeInplaceDeps pd clbi
            opts = componentGhcOptions v lbi bi clbi' outdir
            in
-              renderGhcOptions (compiler lbi) $ opts `mappend` adopts
+              renderGhcOptions' lbi v $ opts `mappend` adopts
 
     "ghc-src-options":flags ->
       Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
@@ -200,7 +185,7 @@ main = do
                ghcOptSourcePath      = ghcOptSourcePath opts
               }
             in
-              renderGhcOptions comp $ opts `mappend` adopts
+              renderGhcOptions' lbi v $ opts `mappend` adopts
 
     "ghc-pkg-options":flags ->
       Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
@@ -218,19 +203,19 @@ main = do
                        ghcOptHideAllPackages = ghcOptHideAllPackages opts
                    }
            in
-             renderGhcOptions (compiler lbi) $ opts' `mappend` adopts
+             renderGhcOptions' lbi v $ opts' `mappend` adopts
 
     "entrypoints":[] -> do
       eps <- componentsMap lbi v distdir $ \c clbi bi ->
-               componentEntrypoints c
+               return $ componentEntrypoints c
       -- MUST append Setup component at the end otherwise CabalHelper gets
       -- confused
-      let eps' = eps ++ [(GmSetupHsName, Right [ModuleName "Setup"])]
+      let eps' = eps ++ [(GmSetupHsName, Right [GmModuleName "Setup"])]
       return $ Just $ GmCabalHelperEntrypoints eps'
 
     "source-dirs":[] ->
       Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$
-      \c clbi bi -> hsSourceDirs bi
+      \c clbi bi -> return $ hsSourceDirs bi
 
     "print-lbi":[] ->
       return $ Just $ GmCabalHelperLbi $ show lbi
@@ -253,7 +238,7 @@ componentsMap :: LocalBuildInfo
               -> (   Component
                   -> ComponentLocalBuildInfo
                   -> BuildInfo
-                  -> a)
+                  -> IO a)
               -> IO [(GmComponentName, a)]
 componentsMap lbi v distdir f = do
     let pd = localPkgDescr lbi
@@ -265,7 +250,8 @@ componentsMap lbi v distdir f = do
             name = componentNameFromComponent c
 
         l' <- readIORef lr
-        writeIORef lr $ (componentNameToGm name, f c clbi bi):l'
+        r <- f c clbi bi
+        writeIORef lr $ (componentNameToGm name, r):l'
     reverse <$> readIORef lr
 
 componentNameToGm CLibName = GmLibName
@@ -287,10 +273,10 @@ componentOutDir lbi (CTest TestSuite { testInterface = TestSuiteLibV09 _ _, ..})
 componentOutDir lbi (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ _, ..})=
     exeOutDir lbi benchmarkName
 
-gmModuleName :: C.ModuleName -> ModuleName
+gmModuleName :: C.ModuleName -> GmModuleName
-gmModuleName = ModuleName . intercalate "." . components
+gmModuleName = GmModuleName . intercalate "." . components
 
-componentEntrypoints :: Component -> Either FilePath [ModuleName]
+componentEntrypoints :: Component -> Either FilePath [GmModuleName]
 componentEntrypoints (CLib Library {..})
     = Right $ map gmModuleName exposedModules
 componentEntrypoints (CExe Executable {..})
@@ -343,3 +329,12 @@ removeInplaceDeps pd clbi = let
  where
    isInplaceDep :: (InstalledPackageId, PackageId) -> Bool
    isInplaceDep (ipid, pid) = inplacePackageId pid == ipid
+
+renderGhcOptions' lbi v opts = do
+#if CABAL_MAJOR == 1 && CABAL_MINOR < 20
+  (ghcProg, _) <- requireProgram v ghcProgram (withPrograms lbi)
+  let Just ghcVer = programVersion ghcProg
+  return $ renderGhcOptions ghcVer opts
+#else
+  return $ renderGhcOptions (compiler lbi) opts
+#endif

CabalHelper/Types.hs

@@ -0,0 +1,18 @@
+{-# LANGUAGE CPP #-}
+module CabalHelper.Types where
+
+newtype GmModuleName = GmModuleName String
+    deriving (Read, Show)
+
+data GmComponentName = GmSetupHsName
+                     | GmLibName
+                     | GmExeName String
+                     | GmTestName String
+                     | GmBenchName String
+  deriving (Eq, Ord, Read, Show)
+
+data GmCabalHelperResponse
+    = GmCabalHelperStrings [(GmComponentName, [String])]
+    | GmCabalHelperEntrypoints [(GmComponentName, Either FilePath [GmModuleName])]
+    | GmCabalHelperLbi String
+  deriving (Read, Show)

CabalHelper/Wrapper.hs

@@ -14,7 +14,7 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
-{-# LANGUAGE TemplateHaskell, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell, RecordWildCards #-}
 module Main where
 
 import Control.Applicative
@@ -26,11 +26,7 @@ import Data.List
 import Data.Maybe
 import Data.String
 import Data.Version
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS8
 import Text.Printf
-import Text.ParserCombinators.ReadP
 import System.Environment
 import System.Directory
 import System.FilePath
@@ -44,7 +40,7 @@ import Distribution.Text (display)
 import NotCPP.Declarations
 
 import Paths_ghc_mod
-import Common
+import CabalHelper.Common
 import Utils
 
 ifD [d| getExecutablePath = getProgName |]
@@ -61,21 +57,21 @@ usage = do
 \)\n"
 
 main :: IO ()
-main = do
+main = handlePanic $ do
   args <- getArgs
   case args of
     "print-appdatadir":[] -> putStrLn =<< appDataDir
     "print-build-platform":[] -> putStrLn $ display buildPlatform
     distdir:_ -> do
       cfgf <- canonicalizePath (distdir </> "setup-config")
-      mhdr <- (parseHeader =<<) . listToMaybe . BS8.lines <$> BS.readFile cfgf
+      mhdr <- getCabalConfigHeader cfgf
       case mhdr of
-        Nothing -> error $ printf "\
+        Nothing -> panic $ printf "\
 \Could not read Cabal's persistent setup configuration header\n\
 \- Check first line of: %s\n\
 \- Maybe try: $ cabal configure" cfgf
 
-        Just Header {..} -> do
+        Just (hdrCabalVersion, _hdrCompilerVersion) -> do
           eexe <- compileHelper hdrCabalVersion
           case eexe of
               Left e -> exitWith e
@@ -92,17 +88,17 @@ tryFindSrcDirInGhcModTree :: IO (Maybe FilePath)
 tryFindSrcDirInGhcModTree  = do
   dir <- (!!4) . iterate takeDirectory <$> getExecutablePath
   exists <- doesFileExist $ dir </> "ghc-mod.cabal"
-  src_exists <- doesFileExist $ dir </> "cabal-helper/Main.hs"
+  src_exists <- doesFileExist $ dir </> "CabalHelper/Main.hs"
   if exists && src_exists
-     then return $ Just (dir </> "cabal-helper")
+     then return $ Just dir
      else return Nothing
 
 tryFindRealSrcDir :: IO (Maybe FilePath)
 tryFindRealSrcDir = do
     datadir <- getDataDir
-    exists <- doesFileExist $ datadir </> "cabal-helper/Main.hs"
+    exists <- doesFileExist $ datadir </> "CabalHelper/Main.hs"
     return $ if exists
-               then Just $ datadir </> "cabal-helper"
+               then Just datadir
                else Nothing
 
 findCabalHelperSourceDir :: IO FilePath
@@ -116,35 +112,52 @@ findCabalHelperSourceDir = do
 compileHelper :: Version -> IO (Either ExitCode FilePath)
 compileHelper cabalVer = do
   chdir <- findCabalHelperSourceDir
-  mver <- find (sameMajorVersion cabalVer) <$> listCabalVersions
-  couldBeSrcDir <- takeDirectory <$> getDataDir
 
-  case mver of
+  -- First check if we already compiled this version of cabal
-    Nothing -> do
+  db_exists <- cabalPkgDbExists cabalVer
-      let cabalFile = couldBeSrcDir </> "Cabal.cabal"
+  case db_exists of
-      cabal <- doesFileExist cabalFile
+    True -> compileWithPkg chdir . Just =<< cabalPkgDb cabalVer
-      if cabal
+    False -> do
-        then do
+      -- Next check if this version is globally available
-          ver <- cabalFileVersion <$> readFile cabalFile
+      mver <- find (== cabalVer) <$> listCabalVersions
-          compile $ Compile chdir (Just couldBeSrcDir) ver []
+      couldBeSrcDir <- takeDirectory <$> getDataDir
-        else errorNoCabal cabalVer
+      case mver of
-    Just ver ->
+        Nothing -> do
-        compile $ Compile chdir Nothing ver [cabalPkgId ver]
+          -- If not see if we're in a cabal source tree
+          let cabalFile = couldBeSrcDir </> "Cabal.cabal"
+          cabal <- doesFileExist cabalFile
+          if cabal
+            then do
+              ver <- cabalFileVersion <$> readFile cabalFile
+              compileWithCabalTree chdir ver couldBeSrcDir
+            else do
+              -- otherwise compile the requested cabal version into an isolated
+              -- package-db
+              db <- installCabal cabalVer
+              compileWithPkg chdir (Just db)
+        Just _ ->
+          compileWithPkg chdir Nothing
+
  where
+   compileWithCabalTree chdir ver srcDir =
+       compile $ Compile chdir (Just srcDir) Nothing ver []
+
+   compileWithPkg chdir mdb =
+       compile $ Compile chdir Nothing mdb cabalVer [cabalPkgId cabalVer]
+
    cabalPkgId v = "Cabal-" ++ showVersion v
 
-errorNoCabal :: Version -> a
+-- errorNoCabal :: Version -> a
-errorNoCabal cabalVer = error $ printf "\
+-- errorNoCabal cabalVer = panic $ printf "\
-\No appropriate Cabal package found, wanted version %s.\n\
+-- \No appropriate Cabal package found, wanted version %s.\n\
-\- Check output of: $ ghc-pkg list Cabal\n\
+-- \- Check output of: $ ghc-pkg list Cabal\n\
-\- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s.*'" sver mjver
+-- \- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s'" sver sver
- where
+--  where
-   sver = showVersion cabalVer
+--    sver = showVersion cabalVer
-   mjver = showVersion $ majorVer cabalVer
 
 errorNoMain :: FilePath -> a
-errorNoMain datadir = error $ printf "\
+errorNoMain datadir = panic $ printf "\
-\Could not find $datadir/cabal-helper/Main.hs!\n\
+\Could not find $datadir/CabalHelper/Main.hs!\n\
 \\n\
 \If you are a developer you can use the environment variable `ghc_mod_datadir'\n\
 \to override $datadir[1], `$ export ghc_mod_datadir=$PWD' will work in the\n\
@@ -158,6 +171,7 @@ errorNoMain datadir = error $ printf "\
 data Compile = Compile {
       cabalHelperSourceDir :: FilePath,
       cabalSourceDir :: Maybe FilePath,
+      packageDb      :: Maybe FilePath,
       cabalVersion   :: Version,
       packageDeps    :: [String]
     }
@@ -167,7 +181,7 @@ compile Compile {..} = do
     outdir <- appDataDir
     createDirectoryIfMissing True outdir
 
-    let exe = outdir </> "cabal-helper-" ++ showVersion (majorVer cabalVersion)
+    let exe = outdir </> "cabal-helper-" ++ showVersion cabalVersion
 
     recompile <-
       case cabalSourceDir of
@@ -182,24 +196,43 @@ compile Compile {..} = do
              concat [
           [ "-outputdir", outdir
           , "-o", exe
+          , "-optP-DCABAL_HELPER=1"
           , "-optP-DCABAL_MAJOR=" ++ show mj
           , "-optP-DCABAL_MINOR=" ++ show mi
           ],
+          maybeToList $ ("-package-db="++) <$> packageDb,
           map ("-i"++) $ cabalHelperSourceDir:maybeToList cabalSourceDir,
           concatMap (\p -> ["-package", p]) packageDeps,
-          [ "--make",  cabalHelperSourceDir </> "Main.hs" ]
+          [ "--make",  cabalHelperSourceDir </> "CabalHelper/Main.hs" ]
          ]
 
     if recompile
        then do
-         (_, _, _, h) <- createProcess
+         rv <- callProcessStderr' Nothing "ghc" ghc_opts
-           (proc "ghc" ghc_opts) { std_out = UseHandle stderr }
-         rv <- waitForProcess h
          return $ case rv of
                     ExitSuccess -> Right exe
                     e@(ExitFailure _) -> Left e
       else return $ Right exe
 
+callProcessStderr' :: Maybe FilePath -> FilePath -> [String] -> IO ExitCode
+callProcessStderr' mwd exe args = do
+  (_, _, _, h) <- createProcess (proc exe args) { std_out = UseHandle stderr
+                                                , cwd = mwd }
+  waitForProcess h
+
+callProcessStderr :: Maybe FilePath -> FilePath -> [String] -> IO ()
+callProcessStderr mwd exe args = do
+  rv <- callProcessStderr' mwd exe args
+  case rv of
+    ExitSuccess -> return ()
+    ExitFailure v -> processFailedException "callProcessStderr" exe args v
+
+processFailedException :: String -> String -> [String] -> Int -> IO a
+processFailedException fn exe args rv =
+      panic $ concat [fn, ": ", exe, " "
+                     , intercalate " " (map show args)
+                     , " (exit " ++ show rv ++ ")"]
+
 timeHsFiles :: FilePath -> IO [TimedFile]
 timeHsFiles dir = do
     fs <- map (dir</>) <$> getDirectoryContents dir
@@ -209,17 +242,50 @@ timeHsFiles dir = do
      exists <- doesFileExist f
      return $ exists && ".hs" `isSuffixOf` f
 
+installCabal :: Version -> IO FilePath
+installCabal ver = do
+  db <- createPkgDb ver
+  callProcessStderr (Just "/") "cabal" [ "--package-db=clear"
+                                       , "--package-db=global"
+                                       , "--package-db=" ++ db
+                                       , "-j1"
+                                       , "install", "Cabal-"++showVersion ver
+                                       ]
+  return db
 
+createPkgDb :: Version -> IO FilePath
+createPkgDb ver = do
+  db <- cabalPkgDb ver
+  exists <- doesDirectoryExist db
+  when (not exists) $ callProcessStderr Nothing "ghc-pkg" ["init", db]
+  return db
+
+cabalPkgDb :: Version -> IO FilePath
+cabalPkgDb ver = do
+  appdir <- appDataDir
+  return $ appdir </> "cabal-" ++ showVersion ver ++ "-db"
+
+cabalPkgDbExists :: Version -> IO Bool
+cabalPkgDbExists ver = do
+  db <- cabalPkgDb ver
+  dexists <- doesDirectoryExist db
+  case dexists of
+    False -> return False
+    True -> do
+      vers <- listCabalVersions' (Just db)
+      return $ ver `elem` vers
+
+listCabalVersions :: IO [Version]
+listCabalVersions = listCabalVersions' Nothing
 
 -- TODO: Include sandbox? Probably only relevant for build-type:custom projects.
-listCabalVersions :: IO [Version]
+listCabalVersions' :: Maybe FilePath -> IO [Version]
-listCabalVersions = do
+listCabalVersions' mdb = do
-  catMaybes . map (fmap snd . parsePkgId . fromString) . words
+  let mdbopt = ("--package-db="++) <$> mdb
-          <$> readProcess "ghc-pkg" ["list", "--simple-output", "Cabal"] ""
+      opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt
 
-data Header = Header { hdrCabalVersion    :: Version
+  catMaybes . map (fmap snd . parsePkgId . fromString) . words
-                     , hdrCompilerVersion :: Version
+          <$> readProcess "ghc-pkg" opts ""
-                     }
 
 -- | Find @version: XXX@ delcaration in a cabal file
 cabalFileVersion :: String -> Version
@@ -228,31 +294,3 @@ cabalFileVersion cabalFile = do
  where
   ls = map (map toLower) $ lines cabalFile
   extract = dropWhile (/=':') >>> dropWhile isSpace >>> takeWhile (not . isSpace)
-
-parseHeader :: ByteString -> Maybe Header
-parseHeader header = case BS8.words header of
-  ["Saved", "package", "config", "for", _pkgId ,
-   "written", "by", cabalId,
-   "using", compId]
-    -> liftM2 Header (ver cabalId) (ver compId)
-  _ -> error "parsing setup-config header failed"
- where
-   ver i = snd <$> parsePkgId i
-
-parsePkgId :: ByteString -> Maybe (ByteString, Version)
-parsePkgId bs =
-    case BS8.split '-' bs of
-      [pkg, vers] -> Just (pkg, parseVer $ BS8.unpack vers)
-      _ -> Nothing
-
-parseVer :: String -> Version
-parseVer vers = runReadP parseVersion vers
-
-majorVer :: Version -> Version
-majorVer (Version b _) = Version (take 2 b) []
-
-sameMajorVersion :: Version -> Version -> Bool
-sameMajorVersion a b = majorVer a == majorVer b
-
-runReadP :: ReadP t -> String -> t
-runReadP p i = let (a,""):[] = filter ((=="") . snd) $ readP_to_S p i in a

Language/Haskell/GhcMod/CabalHelper.hs

@@ -23,6 +23,7 @@ module Language.Haskell.GhcMod.CabalHelper (
   ) where
 
 import Control.Applicative
+import Control.Arrow
 import Control.Monad
 import Data.Monoid
 import Data.List
@@ -100,5 +101,9 @@ cabalHelper = withCabal $ do
         Just (GmCabalHelperStrings ghcOpts),
         Just (GmCabalHelperStrings ghcSrcOpts),
         Just (GmCabalHelperStrings ghcPkgOpts) ] = res
+      eps' = map (second $ fmap $ map md) eps
 
-  return $ CabalHelper eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts
+  return $ CabalHelper eps' srcDirs ghcOpts ghcSrcOpts ghcPkgOpts
+
+ where
+   md (GmModuleName mn) = mkModuleName mn

Language/Haskell/GhcMod/PathsAndFiles.hs

@@ -24,7 +24,6 @@ import Data.List
 import Data.Char
 import Data.Maybe
 import Data.Traversable (traverse)
-import Types
 import System.Directory
 import System.FilePath
 import System.IO.Unsafe

Language/Haskell/GhcMod/Types.hs

@@ -2,7 +2,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Language.Haskell.GhcMod.Types (
     module Language.Haskell.GhcMod.Types
-  , module Types
+  , module CabalHelper.Types
   , ModuleName
   , mkModuleName
   , moduleNameString
@@ -11,6 +11,7 @@ module Language.Haskell.GhcMod.Types (
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Monad.Error (Error(..))
 import Control.Exception (Exception)
+import Data.List (intercalate)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Set (Set)
@@ -22,7 +23,7 @@ import MonadUtils (MonadIO)
 import GHC (ModuleName, moduleNameString, mkModuleName)
 import PackageConfig (PackageConfig)
 
-import Types
+import CabalHelper.Types
 
 -- | A constraint alias (-XConstraintKinds) to make functions dealing with
 -- 'GhcModT' somewhat cleaner.
@@ -95,6 +96,52 @@ data Cradle = Cradle {
 
 ----------------------------------------------------------------
 
+-- | GHC package database flags.
+data GhcPkgDb = GlobalDb | UserDb | PackageDb String deriving (Eq, Show)
+
+-- | A single GHC command line option.
+type GHCOption  = String
+
+-- | An include directory for modules.
+type IncludeDir = FilePath
+
+-- | A package name.
+type PackageBaseName = String
+
+-- | A package version.
+type PackageVersion  = String
+
+-- | A package id.
+type PackageId  = String
+
+-- | A package's name, verson and id.
+type Package    = (PackageBaseName, PackageVersion, PackageId)
+
+pkgName :: Package -> PackageBaseName
+pkgName (n,_,_) = n
+
+pkgVer :: Package -> PackageVersion
+pkgVer (_,v,_) = v
+
+pkgId :: Package -> PackageId
+pkgId (_,_,i) = i
+
+showPkg :: Package -> String
+showPkg (n,v,_) = intercalate "-" [n,v]
+
+showPkgId :: Package -> String
+showPkgId (n,v,i) = intercalate "-" [n,v,i]
+
+-- | Haskell expression.
+type Expression = String
+
+-- | Module name.
+type ModuleString = String
+
+-- | A Module
+type Module = [String]
+
+
 data GmLogLevel = GmPanic
                 | GmException
                 | GmError
@@ -140,21 +187,6 @@ instance Read ModuleName where
                                  (m,t) <- readsPrec (app_prec+1) s]) r
         where app_prec = 10
 
-
---- \ / These types MUST be in sync with the copies in cabal-helper/Main.hs
-data GmComponentName = GmSetupHsName
-                     | GmLibName
-                     | GmExeName String
-                     | GmTestName String
-                     | GmBenchName String
-  deriving (Eq, Ord, Read, Show)
-data GmCabalHelperResponse
-    = GmCabalHelperStrings [(GmComponentName, [String])]
-    | GmCabalHelperEntrypoints [(GmComponentName, Either FilePath [ModuleName])]
-    | GmCabalHelperLbi String
-  deriving (Read, Show)
---- ^ These types MUST be in sync with the copies in cabal-helper/Main.hs
-
 data GhcModError
     = GMENoMsg
     -- ^ Unknown error

cabal-helper/Common.hs

@@ -1,41 +0,0 @@
--- ghc-mod: Making Haskell development *more* fun
--- Copyright (C) 2015  Daniel Gröber <dxld ÄT darkboxed DOT org>
---
--- This program is free software: you can redistribute it and/or modify
--- it under the terms of the GNU Affero General Public License as published by
--- the Free Software Foundation, either version 3 of the License, or
--- (at your option) any later version.
---
--- This program is distributed in the hope that it will be useful,
--- but WITHOUT ANY WARRANTY; without even the implied warranty of
--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--- GNU Affero General Public License for more details.
---
--- You should have received a copy of the GNU Affero General Public License
--- along with this program.  If not, see <http://www.gnu.org/licenses/>.
-
-module Common where
-
-import Control.Applicative
-import Data.List
-import Data.Maybe
-import System.Environment
-import System.IO
-
-errMsg :: String -> IO ()
-errMsg str = do
-  prog <- getProgName
-  hPutStrLn stderr $ prog ++ ": " ++ str
-
-align :: String -> String -> String -> String
-align n an str = let
-    h:rest = lines str
-    [hm]   = match n h
-    rest'  = [ move (hm - rm) r | r <- rest, rm <- match an r]
-    in
-      unlines (h:rest')
- where
-   match p str' = maybeToList $
-     fst <$> find ((p `isPrefixOf`) . snd) ([0..] `zip` tails str')
-   move i str' | i > 0  = replicate i ' ' ++ str'
-   move i str' = drop i str'

ghc-mod.cabal

@@ -23,7 +23,7 @@ Cabal-Version:          >= 1.16
 Build-Type:             Custom
 Data-Files:             elisp/Makefile
                         elisp/*.el
-                        cabal-helper/*.hs
+                        CabalHelper/*.hs
 
 Extra-Source-Files:     ChangeLog
                         SetupCompat.hs
@@ -65,8 +65,8 @@ Library
   Exposed-Modules:      Language.Haskell.GhcMod
                         Language.Haskell.GhcMod.Internal
   Other-Modules:        Paths_ghc_mod
-                        Types
                         Utils
+                        CabalHelper.Types
                         Language.Haskell.GhcMod.Boot
                         Language.Haskell.GhcMod.Browse
                         Language.Haskell.GhcMod.CaseSplit
@@ -177,10 +177,10 @@ Executable ghc-modi
 Executable cabal-helper-wrapper
   Default-Language:     Haskell2010
   Other-Extensions:     TemplateHaskell
-  Main-Is:              Wrapper.hs
+  Main-Is:              CabalHelper/Wrapper.hs
   Other-Modules:        Paths_ghc_mod
   GHC-Options:          -Wall
-  HS-Source-Dirs:       cabal-helper, .
+  HS-Source-Dirs:       .
   X-Install-Target:     $libexecdir
   Build-Depends:        base >= 4.0 && < 5
                       , bytestring
@@ -207,14 +207,13 @@ Test-Suite doctest
 Test-Suite spec
   Default-Language:     Haskell2010
   Default-Extensions:   ScopedTypeVariables, RecordWildCards, NamedFieldPuns,
-                        ConstraintKinds, FlexibleContexts, OverloadedStrings
+                        ConstraintKinds, FlexibleContexts
   Main-Is:              Main.hs
   Hs-Source-Dirs:       test, .
   Ghc-Options:          -Wall -fno-warn-deprecations
   CPP-Options:          -DSPEC=1
   Type:                 exitcode-stdio-1.0
   Other-Modules:        Paths_ghc_mod
-                        Types
                         Dir
                         Spec
                         TestUtils