ghc-mod/Cabal.hs

84 lines
2.9 KiB
Haskell
Raw Normal View History

2012-03-23 17:05:38 +00:00
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
2012-02-06 09:07:32 +00:00
2011-05-24 07:18:22 +00:00
module Cabal (initializeGHC) where
2011-11-29 18:02:55 +00:00
import Control.Applicative
import Control.Exception
2011-10-18 03:09:25 +00:00
import Control.Monad
2011-08-24 06:58:12 +00:00
import CoreMonad
2011-05-24 07:18:22 +00:00
import Data.List
import Data.Maybe
2012-02-06 09:07:32 +00:00
import Distribution.PackageDescription
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Verbosity (silent)
2011-08-24 07:50:26 +00:00
import ErrMsg
2011-05-24 07:18:22 +00:00
import GHC
2012-02-14 07:09:53 +00:00
import GHCApi
2012-02-16 05:44:20 +00:00
import GHCChoice
import qualified Gap
2011-05-24 07:18:22 +00:00
import System.Directory
import System.FilePath
import Types
----------------------------------------------------------------
2011-10-18 03:22:48 +00:00
importDirs :: [String]
2011-12-19 06:54:46 +00:00
importDirs = [".","..","../..","../../..","../../../..","../../../../.."]
2011-10-18 03:22:48 +00:00
2011-08-24 06:58:12 +00:00
initializeGHC :: Options -> FilePath -> [String] -> Bool -> Ghc (FilePath,LogReader)
2012-02-16 05:44:20 +00:00
initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
where
2012-02-15 05:52:48 +00:00
withoutCabal = do
logReader <- initSession opt ghcOptions importDirs logging
return (fileName,logReader)
withCabal = do
(owdir,cdir,cfile) <- liftIO getDirs
2012-03-23 17:05:38 +00:00
binfo@BuildInfo{..} <- liftIO $ parseCabalFile cfile
let exts = map (addX . Gap.extensionToString) $ usedExtensions binfo
lang = maybe "-XHaskell98" (addX . show) defaultLanguage
libs = map ("-l" ++) extraLibs
libDirs = map ("-L" ++) extraLibDirs
gopts = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
idirs = case hsSourceDirs of
[] -> [cdir,owdir]
2012-03-19 07:36:54 +00:00
dirs -> map (cdir </>) dirs ++ [owdir]
logReader <- initSession opt gopts idirs logging
2012-03-19 07:36:54 +00:00
return (fileName,logReader)
addX = ("-X" ++)
2011-05-24 07:18:22 +00:00
----------------------------------------------------------------
-- Causes error, catched in the upper function.
2012-02-15 04:58:04 +00:00
parseCabalFile :: FilePath -> IO BuildInfo
2012-02-06 09:07:32 +00:00
parseCabalFile file = do
2012-02-15 04:58:04 +00:00
cabal <- readPackageDescription silent file
return . fromJust $ fromLibrary cabal <|> fromExecutable cabal
2012-02-06 09:07:32 +00:00
where
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)
toMaybe [] = Nothing
toMaybe (x:_) = Just x
2011-05-24 07:18:22 +00:00
----------------------------------------------------------------
-- CurrentWorkingDir, CabalDir, CabalFile
getDirs :: IO (FilePath,FilePath,FilePath)
2011-05-24 07:18:22 +00:00
getDirs = do
2011-08-24 06:58:12 +00:00
wdir <- getCurrentDirectory
(cdir,cfile) <- cabalDir wdir
return (wdir,cdir,cfile)
2011-05-24 07:18:22 +00:00
-- Causes error, catched in the upper function.
-- CabalDir, CabalFile
cabalDir :: FilePath -> IO (FilePath,FilePath)
2011-05-24 07:18:22 +00:00
cabalDir dir = do
2011-10-18 03:09:25 +00:00
cnts <- (filter isCabal <$> getDirectoryContents dir)
2011-10-19 05:22:28 +00:00
>>= filterM (\file -> doesFileExist (dir </> file))
let dir' = takeDirectory dir
2011-10-18 03:09:25 +00:00
case cnts of
[] | dir' == dir -> throwIO $ userError "No cabal file"
| otherwise -> cabalDir dir'
cfile:_ -> return (dir,dir </> cfile)
2011-05-24 07:18:22 +00:00
where
isCabal name = ".cabal" `isSuffixOf` name && length name > 6