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

simplify the usage of IOChoice.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-05-09 10:09:12 +09:00
parent 56b1e14219
commit b632cb6df0
4 changed files with 5 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CabalApi.hs
View File

@ -33,7 +33,7 @@ fromCabalFile :: [GHCOption]
fromCabalFile ghcOptions cradle = do fromCabalFile ghcOptions cradle = do
cabal <- cabalParseFile cfile cabal <- cabalParseFile cfile
case cabalBuildInfo cabal of case cabalBuildInfo cabal of
Nothing -> throwIO BrokenCabalFile Nothing -> throwIO $ userError "cabal file is broken"
Just binfo -> return $ cookInfo ghcOptions cradle cabal binfo Just binfo -> return $ cookInfo ghcOptions cradle cabal binfo
where where
Just cfile = cradleCabalFile cradle Just cfile = cradleCabalFile cradle

11
Debug.hs
View File

@ -1,10 +1,8 @@
{-# LANGUAGE TemplateHaskell #-}
module Debug (debugInfo, debug) where module Debug (debugInfo, debug) where
import CabalApi import CabalApi
import Control.Applicative import Control.Applicative
import Control.Exception.IOChoice.TH import Control.Exception.IOChoice
import Control.Monad import Control.Monad
import Data.List (intercalate) import Data.List (intercalate)
import Data.Maybe import Data.Maybe
@ -15,11 +13,6 @@ import Types
---------------------------------------------------------------- ----------------------------------------------------------------
(||>>) :: IO a -> IO a -> IO a
(||>>) = $(newIOChoice [''BrokenCabalFile])
----------------------------------------------------------------
debugInfo :: Options -> Cradle -> String -> String -> IO String debugInfo :: Options -> Cradle -> String -> String -> IO String
debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName debugInfo opt cradle ver fileName = unlines <$> debug opt cradle ver fileName
@ -27,7 +20,7 @@ debug :: Options -> Cradle -> String -> String -> IO [String]
debug opt cradle ver fileName = do debug opt cradle ver fileName = do
(gopts, incDir, pkgs) <- (gopts, incDir, pkgs) <-
if cabal then if cabal then
fromCabalFile (ghcOpts opt) cradle ||>> return (ghcOpts opt, [], []) fromCabalFile (ghcOpts opt) cradle ||> return (ghcOpts opt, [], [])
else else
return (ghcOpts opt, [], []) return (ghcOpts opt, [], [])
[fast] <- withGHC fileName $ do [fast] <- withGHC fileName $ do

5
GHCApi.hs
View File

@ -22,6 +22,7 @@ import DynFlags
import ErrMsg import ErrMsg
import Exception import Exception
import GHC import GHC
import GHCChoice
import GHC.Paths (libdir) import GHC.Paths (libdir)
import System.Exit import System.Exit
import System.IO import System.IO
@ -52,7 +53,7 @@ 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 = withCabal `gcatch` fallback | cabal = withCabal ||> withoutCabal
| otherwise = withoutCabal | otherwise = withoutCabal
where where
cabal = isJust $ cradleCabalFile cradle cabal = isJust $ cradleCabalFile cradle
@ -61,8 +62,6 @@ initializeFlagsWithCradle opt cradle ghcOptions logging
initSession CabalPkg opt gopts idirs (Just depPkgs) logging initSession CabalPkg opt gopts idirs (Just depPkgs) logging
withoutCabal = withoutCabal =
initSession SingleFile opt ghcOptions importDirs Nothing logging initSession SingleFile opt ghcOptions importDirs Nothing logging
fallback :: BrokenCabalFile -> Ghc LogReader
fallback _ = withoutCabal
---------------------------------------------------------------- ----------------------------------------------------------------

10
Types.hs
View File

@ -1,11 +1,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Types where module Types where
import Control.Exception as E
import Data.Typeable
data OutputStyle = LispStyle | PlainStyle data OutputStyle = LispStyle | PlainStyle
data Options = Options { data Options = Options {
@ -82,9 +78,3 @@ type IncludeDir = FilePath
type Package = String type Package = String
data CheckSpeed = Slow | Fast data CheckSpeed = Slow | Fast
----------------------------------------------------------------
data BrokenCabalFile = BrokenCabalFile deriving (Show, Typeable)
instance Exception BrokenCabalFile