Move an interface function with Cabal package into CabalApi module.
This commit is contained in:
parent
ff9fa49141
commit
c74b58a47f
24
Cabal.hs
24
Cabal.hs
@ -2,16 +2,13 @@
|
||||
|
||||
module Cabal (initializeGHC) where
|
||||
|
||||
import CabalApi (dependPackages)
|
||||
import CabalApi (cabalBuildInfo, cabalDependPackages)
|
||||
import Control.Applicative
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import CoreMonad
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Distribution.PackageDescription
|
||||
import Distribution.PackageDescription.Parse (readPackageDescription)
|
||||
import Distribution.Verbosity (silent)
|
||||
import Distribution.PackageDescription (BuildInfo(..), usedExtensions)
|
||||
import ErrMsg
|
||||
import GHC
|
||||
import GHCApi
|
||||
@ -34,7 +31,7 @@ initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
|
||||
return (fileName,logReader)
|
||||
withCabal = do
|
||||
(owdir,cdir,cfile) <- liftIO getDirs
|
||||
binfo@BuildInfo{..} <- liftIO $ parseCabalFile cfile
|
||||
binfo@BuildInfo{..} <- liftIO $ cabalBuildInfo cfile
|
||||
let exts = map (addX . Gap.extensionToString) $ usedExtensions binfo
|
||||
lang = maybe "-XHaskell98" (addX . show) defaultLanguage
|
||||
libs = map ("-l" ++) extraLibs
|
||||
@ -43,26 +40,13 @@ initializeGHC opt fileName ghcOptions logging = withCabal ||> withoutCabal
|
||||
idirs = case hsSourceDirs of
|
||||
[] -> [cdir,owdir]
|
||||
dirs -> map (cdir </>) dirs ++ [owdir]
|
||||
depPkgs <- liftIO $ dependPackages cfile
|
||||
depPkgs <- liftIO $ cabalDependPackages cfile
|
||||
logReader <- initSession opt gopts idirs (Just depPkgs) logging
|
||||
return (fileName,logReader)
|
||||
addX = ("-X" ++)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- Causes error, catched in the upper function.
|
||||
parseCabalFile :: FilePath -> IO BuildInfo
|
||||
parseCabalFile file = do
|
||||
cabal <- readPackageDescription silent file
|
||||
return . fromJust $ fromLibrary cabal <|> fromExecutable cabal
|
||||
where
|
||||
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
|
||||
fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)
|
||||
toMaybe [] = Nothing
|
||||
toMaybe (x:_) = Just x
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- CurrentWorkingDir, CabalDir, CabalFile
|
||||
getDirs :: IO (FilePath,FilePath,FilePath)
|
||||
getDirs = do
|
||||
|
32
CabalApi.hs
32
CabalApi.hs
@ -1,6 +1,11 @@
|
||||
module CabalApi (dependPackages) where
|
||||
module CabalApi (
|
||||
cabalBuildInfo,
|
||||
cabalDependPackages
|
||||
) where
|
||||
|
||||
import Data.Maybe (maybeToList)
|
||||
import Control.Applicative
|
||||
|
||||
import Data.Maybe (fromJust, maybeToList)
|
||||
import Data.Set (fromList, toList)
|
||||
|
||||
import Distribution.Verbosity (silent)
|
||||
@ -8,11 +13,28 @@ import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
|
||||
import Distribution.PackageDescription
|
||||
(GenericPackageDescription,
|
||||
condLibrary, condExecutables, condTestSuites, condBenchmarks,
|
||||
CondTree, condTreeConstraints)
|
||||
BuildInfo, usedExtensions, libBuildInfo, buildInfo,
|
||||
CondTree, condTreeConstraints, condTreeData)
|
||||
import Distribution.PackageDescription.Parse (readPackageDescription)
|
||||
|
||||
-- import Distribution.PackageDescription
|
||||
-- (BuildInfo(..))
|
||||
-- import Distribution.PackageDescription.Parse (readPackageDescription)
|
||||
-- import Distribution.Verbosity (silent)
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
||||
-- Causes error, catched in the upper function.
|
||||
cabalBuildInfo :: FilePath -> IO BuildInfo
|
||||
cabalBuildInfo file = do
|
||||
cabal <- readPackageDescription silent file
|
||||
return . fromJust $ fromLibrary cabal <|> fromExecutable cabal
|
||||
where
|
||||
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
|
||||
fromExecutable c = buildInfo . condTreeData . snd <$> toMaybe (condExecutables c)
|
||||
toMaybe [] = Nothing
|
||||
toMaybe (x:_) = Just x
|
||||
|
||||
parseGenericDescription :: FilePath -> IO GenericPackageDescription
|
||||
parseGenericDescription = readPackageDescription silent
|
||||
|
||||
@ -31,8 +53,8 @@ allDependsOfDescription pd =
|
||||
getDependencyPackageName :: Dependency -> String
|
||||
getDependencyPackageName (Dependency (PackageName n) _) = n
|
||||
|
||||
dependPackages :: FilePath -> IO [String]
|
||||
dependPackages =
|
||||
cabalDependPackages :: FilePath -> IO [String]
|
||||
cabalDependPackages =
|
||||
fmap (toList . fromList
|
||||
. map getDependencyPackageName
|
||||
. allDependsOfDescription)
|
||||
|
Loading…
Reference in New Issue
Block a user