150 lines
5.1 KiB
Haskell
150 lines
5.1 KiB
Haskell
{-# LANGUAGE TypeFamilies, ScopedTypeVariables, DeriveDataTypeable #-}
|
|
-- ghc-mod: Making Haskell development *more* fun
|
|
-- Copyright (C) 2015 Daniel Gröber <dxld ÄT darkboxed DOT org>
|
|
--
|
|
-- This program is free software: you can redistribute it and/or modify
|
|
-- it under the terms of the GNU Affero General Public License as published by
|
|
-- the Free Software Foundation, either version 3 of the License, or
|
|
-- (at your option) any later version.
|
|
--
|
|
-- This program is distributed in the hope that it will be useful,
|
|
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
-- GNU Affero General Public License for more details.
|
|
--
|
|
-- You should have received a copy of the GNU Affero General Public License
|
|
-- along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
module Language.Haskell.GhcMod.Error (
|
|
GhcModError(..)
|
|
, GMConfigStateFileError(..)
|
|
, GmError
|
|
, gmeDoc
|
|
, modifyError
|
|
, modifyError'
|
|
, tryFix
|
|
, module Control.Monad.Error
|
|
, module Exception
|
|
) where
|
|
|
|
import Control.Monad.Error (MonadError(..), Error(..))
|
|
import Data.List
|
|
import Data.Typeable
|
|
import Exception
|
|
import Text.PrettyPrint
|
|
|
|
type GmError m = MonadError GhcModError m
|
|
|
|
data GhcModError = GMENoMsg
|
|
-- ^ Unknown error
|
|
|
|
| GMEString String
|
|
-- ^ Some Error with a message. These are produced mostly by
|
|
-- 'fail' calls on GhcModT.
|
|
|
|
| GMEIOException IOException
|
|
-- ^ IOExceptions captured by GhcModT's MonadIO instance
|
|
|
|
| GMECabalConfigure GhcModError
|
|
-- ^ Configuring a cabal project failed.
|
|
|
|
| GMECabalFlags GhcModError
|
|
-- ^ Retrieval of the cabal configuration flags failed.
|
|
|
|
| GMEProcess [String] GhcModError
|
|
-- ^ Launching an operating system process failed. The first
|
|
-- field is the command.
|
|
|
|
| GMENoCabalFile
|
|
-- ^ No cabal file found.
|
|
|
|
| GMETooManyCabalFiles [FilePath]
|
|
-- ^ Too many cabal files found.
|
|
|
|
| GMECabalStateFile GMConfigStateFileError
|
|
-- ^ Reading Cabal's state configuration file falied somehow.
|
|
deriving (Eq,Show,Typeable)
|
|
|
|
data GMConfigStateFileError
|
|
= GMConfigStateFileNoHeader
|
|
| GMConfigStateFileBadHeader
|
|
| GMConfigStateFileNoParse
|
|
| GMConfigStateFileMissing
|
|
-- | GMConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo)
|
|
deriving (Eq, Show, Read, Typeable)
|
|
|
|
gmCsfeDoc :: GMConfigStateFileError -> Doc
|
|
gmCsfeDoc GMConfigStateFileNoHeader = text $
|
|
"Saved package config file header is missing. "
|
|
++ "Try re-running the 'configure' command."
|
|
|
|
gmCsfeDoc GMConfigStateFileBadHeader = text $
|
|
"Saved package config file header is corrupt. "
|
|
++ "Try re-running the 'configure' command."
|
|
|
|
gmCsfeDoc GMConfigStateFileNoParse = text $
|
|
"Saved package config file body is corrupt. "
|
|
++ "Try re-running the 'configure' command."
|
|
|
|
gmCsfeDoc GMConfigStateFileMissing = text $
|
|
"Run the 'configure' command first."
|
|
|
|
-- gmCsfeDoc (ConfigStateFileBadVersion oldCabal oldCompiler _) = text $
|
|
-- "You need to re-run the 'configure' command. "
|
|
-- ++ "The version of Cabal being used has changed (was "
|
|
-- ++ display oldCabal ++ ", now "
|
|
-- ++ display currentCabalId ++ ")."
|
|
-- ++ badCompiler
|
|
-- where
|
|
-- badCompiler
|
|
-- | oldCompiler == currentCompilerId = ""
|
|
-- | otherwise =
|
|
-- " Additionally the compiler is different (was "
|
|
-- ++ display oldCompiler ++ ", now "
|
|
-- ++ display currentCompilerId
|
|
-- ++ ") which is probably the cause of the problem."
|
|
|
|
|
|
|
|
|
|
|
|
instance Exception GhcModError
|
|
|
|
instance Error GhcModError where
|
|
noMsg = GMENoMsg
|
|
strMsg = GMEString
|
|
|
|
gmeDoc :: GhcModError -> Doc
|
|
gmeDoc e = case e of
|
|
GMENoMsg ->
|
|
text "Unknown error"
|
|
GMEString msg ->
|
|
text msg
|
|
GMEIOException ioe ->
|
|
text $ show ioe
|
|
GMECabalConfigure msg ->
|
|
text "cabal configure failed: " <> gmeDoc msg
|
|
GMECabalFlags msg ->
|
|
text "retrieval of the cabal configuration flags failed: " <> gmeDoc msg
|
|
GMEProcess cmd msg ->
|
|
text ("launching operating system process `"++unwords cmd++"` failed: ")
|
|
<> gmeDoc msg
|
|
GMENoCabalFile ->
|
|
text "No cabal file found."
|
|
GMETooManyCabalFiles cfs ->
|
|
text $ "Multiple cabal files found. Possible cabal files: \""
|
|
++ intercalate "\", \"" cfs ++"\"."
|
|
GMECabalStateFile csfe ->
|
|
gmCsfeDoc csfe
|
|
|
|
|
|
modifyError :: MonadError e m => (e -> e) -> m a -> m a
|
|
modifyError f action = action `catchError` \e -> throwError $ f e
|
|
|
|
infixr 0 `modifyError'`
|
|
modifyError' :: MonadError e m => m a -> (e -> e) -> m a
|
|
modifyError' = flip modifyError
|
|
|
|
tryFix :: MonadError e m => m a -> (e -> m ()) -> m a
|
|
tryFix action fix = do
|
|
action `catchError` \e -> fix e >> action
|