better error handling.

This commit is contained in:
Kazu Yamamoto 2014-04-23 14:44:05 +09:00
parent d23f57e1b6
commit 3ea98737b1

View File

@ -20,12 +20,12 @@ module Main where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, readMVar) import Control.Concurrent (forkIO, MVar, newEmptyMVar, putMVar, readMVar)
import Control.Exception (SomeException(..)) import Control.Exception (SomeException(..), Exception)
import qualified Control.Exception as E import qualified Control.Exception as E
import Control.Monad (when, void) import Control.Monad (when, void)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.Function (on) import Data.Function (on)
import Data.List (intercalate, groupBy, sort, find) import Data.List (groupBy, sort, find)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as S import qualified Data.Set as S
@ -87,14 +87,14 @@ parseArgs :: [OptDescr (Options -> Options)] -> [String] -> (Options, [String])
parseArgs spec argv parseArgs spec argv
= case getOpt Permute spec argv of = case getOpt Permute spec argv of
(o,n,[] ) -> (foldr id defaultOptions o, n) (o,n,[] ) -> (foldr id defaultOptions o, n)
(_,_,errs) -> GE.throw (CmdArg errs) (_,_,errs) -> E.throw (CmdArg errs)
---------------------------------------------------------------- ----------------------------------------------------------------
data GHCModiError = CmdArg [String] data GHCModiError = CmdArg [String]
deriving (Show, Typeable) deriving (Show, Typeable)
instance GE.Exception GHCModiError instance Exception GHCModiError
---------------------------------------------------------------- ----------------------------------------------------------------
@ -102,26 +102,12 @@ instance GE.Exception GHCModiError
-- C-c since installSignalHandlers is called twice, sigh. -- C-c since installSignalHandlers is called twice, sigh.
main :: IO () main :: IO ()
main = handle [GE.Handler cmdHandler, GE.Handler someHandler] $ main = E.handle cmdHandler $
go =<< parseArgs argspec <$> getArgs go =<< parseArgs argspec <$> getArgs
where where
handle = flip GE.catches cmdHandler (CmdArg _) = putStr $ usageInfo usage argspec
LineSeparator lsc = lineSeparator defaultOptions go (_,"help":_) = putStr $ usageInfo usage argspec
cmdHandler (CmdArg e) = do go (opt,_) = E.handle someHandler $ do
putStr "ghc-modi:0:0:"
let x = intercalate lsc e
putStrLn x
putStr $ usageInfo usage argspec
putStrLn "NG"
someHandler (SomeException e) = do
putStr "ghc-modi:0:0:"
let x = intercalate lsc $ lines $ show e
putStrLn x
putStrLn "NG"
go (_,"help":_) = do
putStr $ usageInfo usage argspec
putStrLn "NG"
go (opt,_) = do
cradle0 <- findCradle cradle0 <- findCradle
let rootdir = cradleRootDir cradle0 let rootdir = cradleRootDir cradle0
cradle = cradle0 { cradleCurrentDir = rootdir } cradle = cradle0 { cradleCurrentDir = rootdir }
@ -130,6 +116,13 @@ main = handle [GE.Handler cmdHandler, GE.Handler someHandler] $
mlibdir <- getSystemLibDir mlibdir <- getSystemLibDir
void $ forkIO $ setupDB cradle mlibdir opt mvar void $ forkIO $ setupDB cradle mlibdir opt mvar
run cradle mlibdir opt $ loop opt S.empty mvar run cradle mlibdir opt $ loop opt S.empty mvar
where
someHandler (SomeException e) = do
-- fixme: this is not perfece for -l
-- because each command expect its own s-expression.
let ret = convert opt $ "ghc-modi:0:0:" ++ show e
putStr ret
putStrLn "NG"
---------------------------------------------------------------- ----------------------------------------------------------------