hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

fixing #118.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-04-10 15:02:49 +09:00
parent 0c84d9464a
commit 7ec9fc1ffb
2 changed files with 13 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CabalApi.hs
View File

@ -12,7 +12,7 @@ module CabalApi (
import Control.Applicative import Control.Applicative
import Control.Exception (throwIO) import Control.Exception (throwIO)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Maybe (maybeToList, listToMaybe, fromMaybe) import Data.Maybe (maybeToList, listToMaybe, fromJust)
import Data.Set (fromList, toList) import Data.Set (fromList, toList)
import Distribution.Package (Dependency(Dependency), PackageName(PackageName)) import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
import Distribution.PackageDescription import Distribution.PackageDescription
@ -71,7 +71,7 @@ getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
-- Causes error, catched in the upper function. -- Causes error, catched in the upper function.
cabalBuildInfo :: GenericPackageDescription -> BuildInfo cabalBuildInfo :: GenericPackageDescription -> BuildInfo
cabalBuildInfo pd = fromMaybe emptyBuildInfo $ fromLibrary pd <|> fromExecutable pd cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
where where
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
fromExecutable c = buildInfo . condTreeData . snd <$> listToMaybe (condExecutables c) fromExecutable c = buildInfo . condTreeData . snd <$> listToMaybe (condExecutables c)

16
GHCApi.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
module GHCApi ( module GHCApi (
withGHC withGHC
, withGHCDummyFile , withGHCDummyFile
@ -50,13 +52,17 @@ data Build = CabalPkg | SingleFile deriving Eq
initializeFlagsWithCradle :: Options -> Cradle -> [GHCOption] -> Bool -> Ghc LogReader initializeFlagsWithCradle :: Options -> Cradle -> [GHCOption] -> Bool -> Ghc LogReader
initializeFlagsWithCradle opt cradle ghcOptions logging initializeFlagsWithCradle opt cradle ghcOptions logging
| cabal = do | cabal = withCabal `gcatch` fallback
(gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle | otherwise = withoutCabal
initSession CabalPkg opt gopts idirs (Just depPkgs) logging
| otherwise =
initSession SingleFile opt ghcOptions importDirs Nothing logging
where where
cabal = isJust $ cradleCabalFile cradle cabal = isJust $ cradleCabalFile cradle
withCabal = do
(gopts,idirs,depPkgs) <- liftIO $ fromCabalFile ghcOptions cradle
initSession CabalPkg opt gopts idirs (Just depPkgs) logging
withoutCabal =
initSession SingleFile opt ghcOptions importDirs Nothing logging
fallback :: SomeException -> Ghc LogReader
fallback _ = withoutCabal
---------------------------------------------------------------- ----------------------------------------------------------------