From 50068221c3d748f15f6ccaa91cb1c605eed2b8f3 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Thu, 29 Mar 2012 21:19:35 +0000 Subject: [PATCH] fix build warnings in all GHC versions --- hledger-lib/Hledger/Read.hs | 9 +++++++-- hledger-lib/Hledger/Read/JournalReader.hs | 5 +++-- hledger/Hledger/Cli/Add.hs | 6 +++--- hledger/Hledger/Cli/Balance.hs | 1 - hledger/Hledger/Cli/Options.hs | 7 ++++--- hledger/Hledger/Cli/Utils.hs | 7 ++++--- 6 files changed, 21 insertions(+), 14 deletions(-) diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 6e3559fe6..24f92c34b 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-| This is the entry point to hledger's reading system, which can read @@ -25,6 +26,7 @@ module Hledger.Read ( tests_Hledger_Read, ) where +import qualified Control.Exception as C import Control.Monad.Error import Data.List import Data.Maybe @@ -75,9 +77,12 @@ defaultJournalPath = do s <- envJournalPath if null s then defaultJournalPath else return s where - envJournalPath = getEnv journalEnvVar `catch` (\_ -> getEnv journalEnvVar2 `catch` (\_ -> return "")) + envJournalPath = + getEnv journalEnvVar + `C.catch` (\(_::C.IOException) -> getEnv journalEnvVar2 + `C.catch` (\(_::C.IOException) -> return "")) defaultJournalPath = do - home <- getHomeDirectory `catch` (\_ -> return "") + home <- getHomeDirectory `C.catch` (\(_::C.IOException) -> return "") return $ home journalDefaultFilename -- | Read the default journal file specified by the environment, or raise an error. diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 1d5ec041e..ec56bdfb3 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -34,6 +34,7 @@ module Hledger.Read.JournalReader ( tests_Hledger_Read_JournalReader ) where +import qualified Control.Exception as C import Control.Monad import Control.Monad.Error import Data.Char (isNumber) @@ -185,8 +186,8 @@ includedirective = do Right (ju,_) -> combineJournalUpdates [return $ journalAddFile (filepath,txt), ju] `catchError` (throwError . (inIncluded ++)) Left err -> throwError $ inIncluded ++ show err where readFileOrError pos fp = - ErrorT $ liftM Right (readFile fp) `catch` - \err -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show err) + ErrorT $ liftM Right (readFile fp) `C.catch` + \e -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show (e::C.IOException)) journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} diff --git a/hledger/Hledger/Cli/Add.hs b/hledger/Hledger/Cli/Add.hs index aa6ce71f4..93e9f73e2 100644 --- a/hledger/Hledger/Cli/Add.hs +++ b/hledger/Hledger/Cli/Add.hs @@ -10,7 +10,7 @@ informational messages are mostly written to stderr rather than stdout. module Hledger.Cli.Add where -import Control.Exception (throw) +import Control.Exception as C import Control.Monad import Control.Monad.Trans (liftIO) import Data.Char (toUpper) @@ -56,7 +56,7 @@ add opts j ++"To stop adding transactions, enter . at a date prompt, or control-d/control-c." today <- getCurrentDay getAndAddTransactions j opts today - `catch` (\e -> unless (isEOFError e) $ ioError e) + `C.catch` (\e -> unless (isEOFError e) $ ioError e) where f = journalFilePath j -- | Read a number of transactions from the command line, prompting, @@ -197,7 +197,7 @@ askFor prompt def validator = do Nothing -> return input where showdef s = " [" ++ s ++ "]" - eofErr = throw $ mkIOError eofErrorType "end of input" Nothing Nothing + eofErr = C.throw $ mkIOError eofErrorType "end of input" Nothing Nothing -- | Append this transaction to the journal's file, and to the journal's -- transaction list. diff --git a/hledger/Hledger/Cli/Balance.hs b/hledger/Hledger/Cli/Balance.hs index e395997a8..b1e699e60 100644 --- a/hledger/Hledger/Cli/Balance.hs +++ b/hledger/Hledger/Cli/Balance.hs @@ -107,7 +107,6 @@ import Hledger import Prelude hiding (putStr) import Hledger.Utils.UTF8IOCompat (putStr) import Hledger.Data.FormatStrings -import qualified Hledger.Data.FormatStrings as Format import Hledger.Cli.Options diff --git a/hledger/Hledger/Cli/Options.hs b/hledger/Hledger/Cli/Options.hs index ce4edadf3..9a00b09f3 100644 --- a/hledger/Hledger/Cli/Options.hs +++ b/hledger/Hledger/Cli/Options.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-} {-| Command-line options for the hledger program, and option-parsing utilities. @@ -7,6 +7,7 @@ Command-line options for the hledger program, and option-parsing utilities. module Hledger.Cli.Options where +import Control.Exception as C import Data.List import Data.List.Split import Data.Maybe @@ -370,8 +371,8 @@ getHledgerProgramsInPath = do where hledgerprog = string progname >> char '-' >> many1 (letter <|> char '-') >> eof -getEnvSafe v = getEnv v `catch` (\_ -> return "") -getDirectoryContentsSafe d = getDirectoryContents d `catch` (\_ -> return []) +getEnvSafe v = getEnv v `C.catch` (\(_::C.IOException) -> return "") +getDirectoryContentsSafe d = getDirectoryContents d `C.catch` (\(_::C.IOException) -> return []) -- | Convert possibly encoded option values to regular unicode strings. decodeRawOpts = map (\(name,val) -> (name, fromSystemString val)) diff --git a/hledger/Hledger/Cli/Utils.hs b/hledger/Hledger/Cli/Utils.hs index 0956be600..8e3b0540b 100644 --- a/hledger/Hledger/Cli/Utils.hs +++ b/hledger/Hledger/Cli/Utils.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-| Utilities for top-level modules and ghci. See also Hledger.Read and @@ -20,7 +21,7 @@ module Hledger.Cli.Utils Test(TestList), ) where -import Control.Exception +import Control.Exception as C import Data.List import Data.Maybe import Safe (readMay) @@ -95,7 +96,7 @@ journalSpecifiedFileIsNewer Journal{filereadtime=tread} f = do fileModificationTime :: FilePath -> IO ClockTime fileModificationTime f | null f = getClockTime - | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime + | otherwise = getModificationTime f `C.catch` \(_::C.IOException) -> getClockTime -- | Attempt to open a web browser on the given url, all platforms. openBrowserOn :: String -> IO ExitCode @@ -135,7 +136,7 @@ writeFileWithBackup :: FilePath -> String -> IO () writeFileWithBackup f t = backUpFile f >> writeFile f t readFileStrictly :: FilePath -> IO String -readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s +readFileStrictly f = readFile f >>= \s -> C.evaluate (length s) >> return s -- | Back up this file with a (incrementing) numbered suffix, or give an error. backUpFile :: FilePath -> IO ()