ghc-mod/Language/Haskell/GhcMod/CabalApi.hs

143 lines
5.1 KiB
Haskell
Raw Normal View History

2013-03-05 01:21:55 +00:00
{-# LANGUAGE OverloadedStrings #-}
2013-03-03 06:47:03 +00:00
2013-05-17 01:00:01 +00:00
module Language.Haskell.GhcMod.CabalApi (
2013-03-03 06:50:09 +00:00
fromCabalFile
, parseCabalFile
2013-03-01 06:25:43 +00:00
, cabalAllDependPackages
, cabalAllSourceDirs
, cabalAllBuildInfo
2013-03-04 04:55:03 +00:00
, getGHCVersion
) where
import Control.Applicative ((<$>))
2013-03-04 04:55:03 +00:00
import Control.Exception (throwIO)
import Data.List (intercalate)
import Data.Maybe (maybeToList)
import Data.Set (fromList, toList)
import Distribution.Package (Dependency(Dependency)
, PackageName(PackageName)
, PackageIdentifier(pkgName))
import Distribution.PackageDescription
import Distribution.PackageDescription.Configuration (finalizePackageDescription)
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.Simple.Compiler (CompilerId(..), CompilerFlavor(..))
2013-03-04 04:55:03 +00:00
import Distribution.Simple.Program (ghcProgram)
import Distribution.Simple.Program.Types (programName, programFindVersion)
import Distribution.System (buildPlatform)
2013-03-01 06:25:43 +00:00
import Distribution.Text (display)
import Distribution.Verbosity (silent)
import Distribution.Version (versionBranch, Version)
2013-05-17 01:00:01 +00:00
import Language.Haskell.GhcMod.Types
2013-03-03 06:47:03 +00:00
import System.FilePath
----------------------------------------------------------------
2013-03-03 06:50:09 +00:00
fromCabalFile :: [GHCOption]
-> Cradle
2013-03-13 04:17:22 +00:00
-> IO ([GHCOption],[IncludeDir],[Package])
fromCabalFile ghcOptions cradle = do
cabal <- parseCabalFile cfile
return $ cookInfo ghcOptions cradle cabal
2013-03-05 01:21:55 +00:00
where
Just cfile = cradleCabalFile cradle
2013-03-05 01:21:55 +00:00
cookInfo :: [String] -> Cradle -> PackageDescription
-> ([GHCOption],[IncludeDir],[Package])
cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs)
2013-03-03 06:47:03 +00:00
where
2013-05-13 03:57:58 +00:00
wdir = cradleCurrentDir cradle
2013-03-04 01:39:39 +00:00
Just cdir = cradleCabalDir cradle
Just cfile = cradleCabalFile cradle
buildInfos = cabalAllBuildInfo cabal
gopts = getGHCOptions ghcOptions $ head buildInfos
idirs = includeDirectories cdir wdir $ cabalAllSourceDirs buildInfos
depPkgs = removeMe cfile $ cabalAllDependPackages buildInfos
2013-03-03 06:47:03 +00:00
removeMe :: FilePath -> [String] -> [String]
removeMe cabalfile = filter (/= me)
where
me = dropExtension $ takeFileName cabalfile
includeDirectories :: String -> String -> [FilePath] -> [String]
includeDirectories cdir wdir [] = uniqueAndSort [cdir,wdir]
includeDirectories cdir wdir dirs = uniqueAndSort (map (cdir </>) dirs ++ [cdir,wdir])
2013-03-03 06:47:03 +00:00
----------------------------------------------------------------
parseCabalFile :: FilePath -> IO PackageDescription
parseCabalFile file = do
cid <- getGHCId
epgd <- readPackageDescription silent file
case toPkgDesc cid epgd of
Left deps -> throwIO $ userError $ show deps ++ " are not installed"
Right (pd,_) -> if nullPkg pd
then throwIO $ userError $ file ++ " is broken"
else return pd
where
toPkgDesc cid = finalizePackageDescription [] (const True) buildPlatform cid []
nullPkg pd = name == ""
where
PackageName name = pkgName (package pd)
----------------------------------------------------------------
2013-03-05 01:21:55 +00:00
getGHCOptions :: [String] -> BuildInfo -> [String]
getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
where
exts = map (("-X" ++) . display) $ usedExtensions binfo
lang = maybe "-XHaskell98" (("-X" ++) . display) $ defaultLanguage binfo
libs = map ("-l" ++) $ extraLibs binfo
libDirs = map ("-L" ++) $ extraLibDirs binfo
----------------------------------------------------------------
cabalAllBuildInfo :: PackageDescription -> [BuildInfo]
cabalAllBuildInfo pd = libBI ++ execBI ++ testBI ++ benchBI
where
libBI = map libBuildInfo $ maybeToList $ library pd
execBI = map buildInfo $ executables pd
testBI = map testBuildInfo $ testSuites pd
benchBI = map benchmarkBuildInfo $ benchmarks pd
----------------------------------------------------------------
cabalAllSourceDirs :: [BuildInfo] -> [FilePath]
cabalAllSourceDirs bis = uniqueAndSort $ concatMap hsSourceDirs bis
2013-03-01 06:25:43 +00:00
----------------------------------------------------------------
cabalAllDependPackages :: [BuildInfo] -> [Package]
cabalAllDependPackages bis = uniqueAndSort $ pkgs
where
pkgs = map getDependencyPackageName $ concatMap targetBuildDepends bis
getDependencyPackageName (Dependency (PackageName nm) _) = nm
2013-03-05 01:21:55 +00:00
----------------------------------------------------------------
2013-03-01 06:25:43 +00:00
uniqueAndSort :: [String] -> [String]
uniqueAndSort = toList . fromList
2013-03-04 04:55:03 +00:00
----------------------------------------------------------------
2013-05-20 05:28:56 +00:00
-- | Getting GHC version. 7.6.3 becames 706 in the second of the result.
getGHCVersion :: IO (GHCVersion, Int)
getGHCVersion = toTupple <$> getGHC
2013-03-04 04:55:03 +00:00
where
toTupple v
| length vs < 2 = (verstr, 0)
| otherwise = (verstr, ver)
2013-03-04 04:55:03 +00:00
where
vs = versionBranch v
ver = (vs !! 0) * 100 + (vs !! 1)
verstr = intercalate "." . map show $ vs
getGHCId :: IO CompilerId
getGHCId = CompilerId GHC <$> getGHC
getGHC :: IO Version
getGHC = do
mv <- programFindVersion ghcProgram silent (programName ghcProgram)
case mv of
Nothing -> throwIO $ userError "ghc not found"
Just v -> return $ v