From 5af2c939b3dffe2ea85f842b6e805c8ee78af0c2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Gr=C3=B6ber?= Date: Tue, 15 Sep 2015 05:25:29 +0200 Subject: [PATCH] Cleanup some dead code --- Language/Haskell/GhcMod/Error.hs | 51 ++++---------------------------- Language/Haskell/GhcMod/Stack.hs | 2 +- Language/Haskell/GhcMod/Types.hs | 23 +++----------- 3 files changed, 10 insertions(+), 66 deletions(-) diff --git a/Language/Haskell/GhcMod/Error.hs b/Language/Haskell/GhcMod/Error.hs index 11df046..e69cc34 100644 --- a/Language/Haskell/GhcMod/Error.hs +++ b/Language/Haskell/GhcMod/Error.hs @@ -17,7 +17,6 @@ {-# LANGUAGE ExistentialQuantification #-} module Language.Haskell.GhcMod.Error ( GhcModError(..) - , GMConfigStateFileError(..) , GmError , gmeDoc , ghcExceptionDoc @@ -53,37 +52,6 @@ import Language.Haskell.GhcMod.Pretty type GmError m = MonadError GhcModError m -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." - gmeDoc :: GhcModError -> Doc gmeDoc e = case e of GMENoMsg -> @@ -91,12 +59,11 @@ gmeDoc e = case e of GMEString msg -> text msg GMECabalConfigure msg -> - text "Configuring cabal project failed: " <> gmeDoc msg - GMECabalFlags msg -> - text "Retrieval of the cabal configuration flags failed: " <> gmeDoc msg - GMECabalComponent cn -> - text "Cabal component " <> quotes (gmComponentNameDoc cn) - <> text " could not be found." + text "Configuring cabal project failed" <+>: gmeDoc msg + GMEStackConfigure msg -> + text "Configuring stack project failed" <+>: gmeDoc msg + GMEStackBootstrap msg -> + text "Bootstrapping stack project environment failed" <+>: gmeDoc msg GMECabalCompAssignment ctx -> text "Could not find a consistent component assignment for modules:" $$ (nest 4 $ foldr ($+$) empty $ map ctxDoc ctx) $$ @@ -125,7 +92,6 @@ gmeDoc e = case e of compsDoc sc | Set.null sc = text "has no known components" compsDoc sc = fsep $ punctuate comma $ map gmComponentNameDoc $ Set.toList sc - GMEProcess _fn cmd args emsg -> let c = showCommandForUser cmd args in case emsg of Right err -> @@ -138,11 +104,6 @@ gmeDoc e = case e of GMETooManyCabalFiles cfs -> text $ "Multiple cabal files found. Possible cabal files: \"" ++ intercalate "\", \"" cfs ++"\"." - GMECabalStateFile csfe -> - gmCsfeDoc csfe - GMEStackBootrap msg -> - (text $ "Boostrapping stack project failed") - <+>: text msg GMEWrongWorkingDirectory projdir cdir -> (text $ "You must run ghc-mod in the project directory as returned by `ghc-mod root`.") <+> text "Currently in:" <+> showDoc cdir @@ -169,7 +130,6 @@ ghcExceptionDoc (Panic msg) = vcat $ map text $ lines $ printf "\ ghcExceptionDoc e = text $ showGhcException e "" - liftMaybe :: MonadError e m => e -> m (Maybe a) -> m a liftMaybe e action = maybe (throwError e) return =<< action @@ -183,7 +143,6 @@ infixr 0 `modifyError'` modifyError' :: MonadError e m => m a -> (e -> e) -> m a modifyError' = flip modifyError - modifyGmError :: (MonadIO m, ExceptionMonad m) => (GhcModError -> GhcModError) -> m a -> m a modifyGmError f a = gcatch a $ \(ex :: GhcModError) -> liftIO $ throwIO (f ex) diff --git a/Language/Haskell/GhcMod/Stack.hs b/Language/Haskell/GhcMod/Stack.hs index 567fdda..b4bdfc0 100644 --- a/Language/Haskell/GhcMod/Stack.hs +++ b/Language/Haskell/GhcMod/Stack.hs @@ -86,4 +86,4 @@ readStack args = do lift $ flip gcatch (\(e :: IOError) -> exToErr e) $ do liftIO $ evaluate =<< readProc stack args "" where - exToErr = throw . GMEStackBootrap . show + exToErr = throw . GMEStackBootstrap . GMEString . show diff --git a/Language/Haskell/GhcMod/Types.hs b/Language/Haskell/GhcMod/Types.hs index 15ca68a..f20f92f 100644 --- a/Language/Haskell/GhcMod/Types.hs +++ b/Language/Haskell/GhcMod/Types.hs @@ -379,11 +379,11 @@ data GhcModError | GMECabalConfigure GhcModError -- ^ Configuring a cabal project failed. - | GMECabalFlags GhcModError - -- ^ Retrieval of the cabal configuration flags failed. + | GMEStackConfigure GhcModError + -- ^ Configuring a stack project failed. - | GMECabalComponent ChComponentName - -- ^ Cabal component could not be found + | GMEStackBootstrap GhcModError + -- ^ Bootstrapping @stack@ environment failed (process exited with failure) | GMECabalCompAssignment [(Either FilePath ModuleName, Set ChComponentName)] -- ^ Could not find a consistent component assignment for modules @@ -398,12 +398,6 @@ data GhcModError | GMETooManyCabalFiles [FilePath] -- ^ Too many cabal files found. - | GMECabalStateFile GMConfigStateFileError - -- ^ Reading Cabal's state configuration file falied somehow. - - | GMEStackBootrap String - -- ^ Bootstrapping @stack@ environment failed (process exited with failure) - | GMEWrongWorkingDirectory FilePath FilePath deriving (Eq,Show,Typeable) @@ -414,15 +408,6 @@ instance Error GhcModError where instance Exception GhcModError -data GMConfigStateFileError - = GMConfigStateFileNoHeader - | GMConfigStateFileBadHeader - | GMConfigStateFileNoParse - | GMConfigStateFileMissing --- | GMConfigStateFileBadVersion PackageIdentifier PackageIdentifier (Either ConfigStateFileError LocalBuildInfo) - deriving (Eq, Show, Read, Typeable) - - deriving instance Generic Version instance Serialize Version