Change the way cabal-helper is built a bit

2015-03-04 16:45:26 +01:00 · 2015-03-04 16:45:26 +01:00 · bc71877dcf
commit bc71877dcf
parent 82bb0090c0
9 changed files with 314 additions and 173 deletions
--- a/CabalHelper/Common.hs
+++ b/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
--- a/cabal-helper/Main.hs
+++ b/cabal-helper/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
-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 ../Types.hs
-
-
-- MUST be compatible to the one in GHC
-newtype ModuleName = ModuleName String
-  deriving (Eq, Ord, Read, Show)
+import CabalHelper.Common
+import CabalHelper.Types

 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 = ModuleName . intercalate "." . components
+gmModuleName :: C.ModuleName -> GmModuleName
+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
--- a/CabalHelper/Types.hs
+++ b/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)
--- a/cabal-helper/Wrapper.hs
+++ b/cabal-helper/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
-    Nothing -> do
-      let cabalFile = couldBeSrcDir </> "Cabal.cabal"
-      cabal <- doesFileExist cabalFile
-      if cabal
-        then do
-          ver <- cabalFileVersion <$> readFile cabalFile
-          compile $ Compile chdir (Just couldBeSrcDir) ver []
-        else errorNoCabal cabalVer
-    Just ver ->
-        compile $ Compile chdir Nothing ver [cabalPkgId ver]
+  -- First check if we already compiled this version of cabal
+  db_exists <- cabalPkgDbExists cabalVer
+  case db_exists of
+    True -> compileWithPkg chdir . Just =<< cabalPkgDb cabalVer
+    False -> do
+      -- Next check if this version is globally available
+      mver <- find (== cabalVer) <$> listCabalVersions
+      couldBeSrcDir <- takeDirectory <$> getDataDir
+      case mver of
+        Nothing -> do
+          -- 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 cabalVer = error $ printf "\
-\No appropriate Cabal package found, wanted version %s.\n\
-\- Check output of: $ ghc-pkg list Cabal\n\
-\- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s.*'" sver mjver
- where
-   sver = showVersion cabalVer
-   mjver = showVersion $ majorVer cabalVer
+-- errorNoCabal :: Version -> a
+-- errorNoCabal cabalVer = panic $ printf "\
+-- \No appropriate Cabal package found, wanted version %s.\n\
+-- \- Check output of: $ ghc-pkg list Cabal\n\
+-- \- Maybe try: $ cabal install Cabal --constraint 'Cabal == %s'" sver sver
+--  where
+--    sver = showVersion cabalVer

 errorNoMain :: FilePath -> a
-errorNoMain datadir = error $ printf "\
-\Could not find $datadir/cabal-helper/Main.hs!\n\
+errorNoMain datadir = panic $ printf "\
+\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
-           (proc "ghc" ghc_opts) { std_out = UseHandle stderr }
-         rv <- waitForProcess h
+         rv <- callProcessStderr' Nothing "ghc" ghc_opts
         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 = do
-  catMaybes . map (fmap snd . parsePkgId . fromString) . words
-          <$> readProcess "ghc-pkg" ["list", "--simple-output", "Cabal"] ""
+listCabalVersions' :: Maybe FilePath -> IO [Version]
+listCabalVersions' mdb = do
+  let mdbopt = ("--package-db="++) <$> mdb
+      opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt

-data Header = Header { hdrCabalVersion    :: Version
-                     , hdrCompilerVersion :: Version
-                     }
+  catMaybes . map (fmap snd . parsePkgId . fromString) . words
+          <$> 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
--- a/Language/Haskell/GhcMod/CabalHelper.hs
+++ b/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
--- a/Language/Haskell/GhcMod/PathsAndFiles.hs
+++ b/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
--- a/Language/Haskell/GhcMod/Types.hs
+++ b/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
--- a/cabal-helper/Common.hs
+++ b/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'
--- a/ghc-mod.cabal
+++ b/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