replacing fromJust with an exception handling.

This commit is contained in:
Kazu Yamamoto 2013-05-08 16:27:54 +09:00
parent c340ba2f90
commit 48a00ea9f6
4 changed files with 32 additions and 12 deletions

View File

@ -12,7 +12,7 @@ module CabalApi (
import Control.Applicative
import Control.Exception (throwIO)
import Data.List (intercalate)
import Data.Maybe (maybeToList, listToMaybe, fromJust)
import Data.Maybe (maybeToList, listToMaybe)
import Data.Set (fromList, toList)
import Distribution.Package (Dependency(Dependency), PackageName(PackageName))
import Distribution.PackageDescription
@ -30,19 +30,21 @@ import Types
fromCabalFile :: [GHCOption]
-> Cradle
-> IO ([GHCOption],[IncludeDir],[Package])
fromCabalFile ghcOptions cradle =
cookInfo ghcOptions cradle <$> cabalParseFile cfile
fromCabalFile ghcOptions cradle = do
cabal <- cabalParseFile cfile
case cabalBuildInfo cabal of
Nothing -> throwIO BrokenCabalFile
Just binfo -> return $ cookInfo ghcOptions cradle cabal binfo
where
Just cfile = cradleCabalFile cradle
Just cfile = cradleCabalFile cradle
cookInfo :: [String] -> Cradle -> GenericPackageDescription
-> ([GHCOption],[IncludeDir],[Package])
cookInfo ghcOptions cradle cabal = (gopts,idirs,depPkgs)
cookInfo :: [String] -> Cradle -> GenericPackageDescription -> BuildInfo
-> ([GHCOption],[IncludeDir],[Package])
cookInfo ghcOptions cradle cabal binfo = (gopts,idirs,depPkgs)
where
owdir = cradleCurrentDir cradle
Just cdir = cradleCabalDir cradle
Just cfile = cradleCabalFile cradle
binfo = cabalBuildInfo cabal
gopts = getGHCOptions ghcOptions binfo
idirs = includeDirectories cdir owdir $ cabalAllSourceDirs cabal
depPkgs = removeMe cfile $ cabalAllDependPackages cabal
@ -70,8 +72,8 @@ getGHCOptions ghcOptions binfo = ghcOptions ++ exts ++ [lang] ++ libs ++ libDirs
----------------------------------------------------------------
-- Causes error, catched in the upper function.
cabalBuildInfo :: GenericPackageDescription -> BuildInfo
cabalBuildInfo pd = fromJust $ fromLibrary pd <|> fromExecutable pd
cabalBuildInfo :: GenericPackageDescription -> Maybe BuildInfo
cabalBuildInfo pd = fromLibrary pd <|> fromExecutable pd
where
fromLibrary c = libBuildInfo . condTreeData <$> condLibrary c
fromExecutable c = buildInfo . condTreeData . snd <$> listToMaybe (condExecutables c)

View File

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

View File

@ -61,7 +61,7 @@ initializeFlagsWithCradle opt cradle ghcOptions logging
initSession CabalPkg opt gopts idirs (Just depPkgs) logging
withoutCabal =
initSession SingleFile opt ghcOptions importDirs Nothing logging
fallback :: SomeException -> Ghc LogReader
fallback :: BrokenCabalFile -> Ghc LogReader
fallback _ = withoutCabal
----------------------------------------------------------------

View File

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