From 8e50395b7c83ab8ce875d0bc71e0b3d0931e7ec9 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 29 Mar 2015 07:53:23 -0700 Subject: [PATCH] ErrorT -> ExceptT, handle mtl <2.2.1 && >=2.2.1 (#239) --- hledger-lib/Hledger/Data/Types.hs | 6 +-- hledger-lib/Hledger/Read.hs | 6 +-- hledger-lib/Hledger/Read/CsvReader.hs | 22 +++++----- hledger-lib/Hledger/Read/JournalReader.hs | 52 +++++++++++------------ hledger-lib/Hledger/Read/TimelogReader.hs | 8 ++-- hledger-lib/hledger-lib.cabal | 4 ++ hledger/hledger.cabal | 7 ++- 7 files changed, 56 insertions(+), 49 deletions(-) diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 5f38d9efa..a9fd652bc 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -19,7 +19,7 @@ For more detailed documentation on each type, see the corresponding modules. module Hledger.Data.Types where -import Control.Monad.Error (ErrorT) +import Control.Monad.Except (ExceptT) import Data.Data #ifndef DOUBLE import Data.Decimal @@ -200,7 +200,7 @@ data Journal = Journal { -- | A JournalUpdate is some transformation of a Journal. It can do I/O or -- raise an error. -type JournalUpdate = ErrorT String IO (Journal -> Journal) +type JournalUpdate = ExceptT String IO (Journal -> Journal) -- | The id of a data format understood by hledger, eg @journal@ or @csv@. type StorageFormat = String @@ -213,7 +213,7 @@ data Reader = Reader { -- quickly check if this reader can probably handle the given file path and file content ,rDetector :: FilePath -> String -> Bool -- parse the given string, using the given parse rules file if any, returning a journal or error aware of the given file path - ,rParser :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal + ,rParser :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal } instance Show Reader where show r = rFormat r ++ " reader" diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index d329b2ec6..1b7b8cb66 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -31,7 +31,7 @@ module Hledger.Read ( ) where import qualified Control.Exception as C -import Control.Monad.Error +import Control.Monad.Except import Data.List import Data.Maybe import System.Directory (doesFileExist, getHomeDirectory) @@ -127,7 +127,7 @@ readJournal format rulesfile assrt path s = firstSuccessOrBestError [] [] = return $ Left "no readers found" firstSuccessOrBestError errs (r:rs) = do dbgAtM 1 "trying reader" (rFormat r) - result <- (runErrorT . (rParser r) rulesfile assrt path') s + result <- (runExceptT . (rParser r) rulesfile assrt path') s dbgAtM 1 "reader result" $ either id show result case result of Right j -> return $ Right j -- success! Left e -> firstSuccessOrBestError (errs++[e]) rs -- keep trying @@ -235,7 +235,7 @@ tests_Hledger_Read = TestList $ tests_Hledger_Read_CsvReader, "journal" ~: do - r <- runErrorT $ parseWithCtx nullctx JournalReader.journal "" + r <- runExceptT $ parseWithCtx nullctx JournalReader.journal "" assertBool "journal should parse an empty file" (isRight $ r) jE <- readJournal Nothing Nothing True Nothing "" -- don't know how to get it from journal either error' (assertBool "journal parsing an empty file should give an empty journal" . null . jtxns) jE diff --git a/hledger-lib/Hledger/Read/CsvReader.hs b/hledger-lib/Hledger/Read/CsvReader.hs index 8ec72eb80..ae7324418 100644 --- a/hledger-lib/Hledger/Read/CsvReader.hs +++ b/hledger-lib/Hledger/Read/CsvReader.hs @@ -23,7 +23,7 @@ where import Control.Applicative ((<$>), (<*)) import Control.Exception hiding (try) import Control.Monad -import Control.Monad.Error +import Control.Monad.Except -- import Test.HUnit import Data.Char (toLower, isDigit, isSpace) import Data.List @@ -68,7 +68,7 @@ detect f s -- | Parse and post-process a "Journal" from CSV data, or give an error. -- XXX currently ignores the string and reads from the file path -parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse rulesfile _ f s = do r <- liftIO $ readJournalFromCsv rulesfile f s case r of Left e -> throwError e @@ -97,7 +97,7 @@ readJournalFromCsv mrulesfile csvfile csvdata = if created then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile else hPrintf stderr "using conversion rules file %s\n" rulesfile - rules_ <- liftIO $ runErrorT $ parseRulesFile rulesfile + rules_ <- liftIO $ runExceptT $ parseRulesFile rulesfile let rules = case rules_ of Right (t::CsvRules) -> t Left err -> throwerr $ show err @@ -340,15 +340,15 @@ getDirective :: DirectiveName -> CsvRules -> Maybe FieldTemplate getDirective directivename = lookup directivename . rdirectives -parseRulesFile :: FilePath -> ErrorT String IO CsvRules +parseRulesFile :: FilePath -> ExceptT String IO CsvRules parseRulesFile f = do s <- liftIO $ (readFile' f >>= expandIncludes (takeDirectory f)) let rules = parseCsvRules f s case rules of - Left e -> ErrorT $ return $ Left $ show e + Left e -> ExceptT $ return $ Left $ show e Right r -> do - r_ <- liftIO $ runErrorT $ validateRules r - ErrorT $ case r_ of + r_ <- liftIO $ runExceptT $ validateRules r + ExceptT $ case r_ of Left e -> return $ Left $ show $ toParseError e Right r -> return $ Right r where @@ -374,13 +374,13 @@ parseCsvRules rulesfile s = runParser rulesp rules rulesfile s -- | Return the validated rules, or an error. -validateRules :: CsvRules -> ErrorT String IO CsvRules +validateRules :: CsvRules -> ExceptT String IO CsvRules validateRules rules = do - unless (isAssigned "date") $ ErrorT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n" + unless (isAssigned "date") $ ExceptT $ return $ Left "Please specify (at top level) the date field. Eg: date %1\n" unless ((amount && not (amountin || amountout)) || (not amount && (amountin && amountout))) - $ ErrorT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n" - ErrorT $ return $ Right rules + $ ExceptT $ return $ Left "Please specify (at top level) either the amount field, or both the amount-in and amount-out fields. Eg: amount %2\n" + ExceptT $ return $ Right rules where amount = isAssigned "amount" amountin = isAssigned "amount-in" diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index d84ff32a7..3ee49b83b 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -48,7 +48,7 @@ where import Control.Applicative ((<*)) import qualified Control.Exception as C import Control.Monad -import Control.Monad.Error +import Control.Monad.Except import Data.Char (isNumber) import Data.List import Data.List.Split (wordsBy) @@ -87,7 +87,7 @@ detect f s -- | Parse and post-process a "Journal" from hledger's journal file -- format, or give an error. -parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseJournalWith journal -- parsing utils @@ -98,7 +98,7 @@ combineJournalUpdates us = liftM (foldl' (\acc new x -> new (acc x)) id) $ seque -- | Given a JournalUpdate-generating parsec parser, file path and data string, -- parse and post-process a Journal so that it's ready to use, or give an error. -parseJournalWith :: (ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate,JournalContext)) -> Bool -> FilePath -> String -> ErrorT String IO Journal +parseJournalWith :: (ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext)) -> Bool -> FilePath -> String -> ExceptT String IO Journal parseJournalWith p assrt f s = do tc <- liftIO getClockTime tl <- liftIO getCurrentLocalTime @@ -151,7 +151,7 @@ clearAccountAliases = modifyState (\(ctx@Ctx{..}) -> ctx{ctxAliases=[]}) -- | Top-level journal parser. Returns a single composite, I/O performing, -- error-raising "JournalUpdate" (and final "JournalContext") which can be -- applied to an empty journal to get the final result. -journal :: ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate,JournalContext) +journal :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate,JournalContext) journal = do journalupdates <- many journalItem eof @@ -171,7 +171,7 @@ journal = do ] "journal transaction or directive" -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives -directive :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +directive :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate directive = do optional $ char '!' choice' [ @@ -189,7 +189,7 @@ directive = do ] "directive" -includedirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +includedirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate includedirective = do string "include" many1 spacenonewline @@ -197,7 +197,7 @@ includedirective = do outerState <- getState outerPos <- getPosition let curdir = takeDirectory (sourceName outerPos) - let (u::ErrorT String IO (Journal -> Journal, JournalContext)) = do + let (u::ExceptT String IO (Journal -> Journal, JournalContext)) = do filepath <- expandPath curdir filename txt <- readFileOrError outerPos filepath let inIncluded = show outerPos ++ " in included file " ++ show filename ++ ":\n" @@ -210,18 +210,18 @@ includedirective = do return (u, ctx) Left err -> throwError $ inIncluded ++ show err where readFileOrError pos fp = - ErrorT $ liftM Right (readFile' fp) `C.catch` + ExceptT $ liftM Right (readFile' fp) `C.catch` \e -> return $ Left $ printf "%s reading %s:\n%s" (show pos) fp (show (e::C.IOException)) - r <- liftIO $ runErrorT u + r <- liftIO $ runExceptT u case r of Left err -> return $ throwError err - Right (ju, _finalparsectx) -> return $ ErrorT $ return $ Right ju + Right (ju, _finalparsectx) -> return $ ExceptT $ return $ Right ju journalAddFile :: (FilePath,String) -> Journal -> Journal journalAddFile f j@Journal{files=fs} = j{files=fs++[f]} -- NOTE: first encountered file to left, to avoid a reverse -accountdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +accountdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate accountdirective = do string "account" many1 spacenonewline @@ -229,16 +229,16 @@ accountdirective = do newline pushParentAccount parent -- return $ return id - return $ ErrorT $ return $ Right id + return $ ExceptT $ return $ Right id -enddirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +enddirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate enddirective = do string "end" popParentAccount -- return (return id) - return $ ErrorT $ return $ Right id + return $ ExceptT $ return $ Right id -aliasdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +aliasdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate aliasdirective = do string "alias" many1 spacenonewline @@ -249,13 +249,13 @@ aliasdirective = do ,accountNameWithoutPostingType $ strip alias) return $ return id -endaliasesdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +endaliasesdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endaliasesdirective = do string "end aliases" clearAccountAliases return (return id) -tagdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +tagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate tagdirective = do string "tag" "tag directive" many1 spacenonewline @@ -263,13 +263,13 @@ tagdirective = do restofline return $ return id -endtagdirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +endtagdirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate endtagdirective = do (string "end tag" <|> string "pop") "end tag or pop directive" restofline return $ return id -defaultyeardirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +defaultyeardirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultyeardirective = do char 'Y' "default year" many spacenonewline @@ -279,7 +279,7 @@ defaultyeardirective = do setYear y' return $ return id -defaultcommoditydirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +defaultcommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate defaultcommoditydirective = do char 'D' "default commodity" many1 spacenonewline @@ -288,7 +288,7 @@ defaultcommoditydirective = do restofline return $ return id -historicalpricedirective :: ParsecT [Char] JournalContext (ErrorT String IO) HistoricalPrice +historicalpricedirective :: ParsecT [Char] JournalContext (ExceptT String IO) HistoricalPrice historicalpricedirective = do char 'P' "historical price" many spacenonewline @@ -300,7 +300,7 @@ historicalpricedirective = do restofline return $ HistoricalPrice date symbol price -ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +ignoredpricecommoditydirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate ignoredpricecommoditydirective = do char 'N' "ignored-price commodity" many1 spacenonewline @@ -308,7 +308,7 @@ ignoredpricecommoditydirective = do restofline return $ return id -commodityconversiondirective :: ParsecT [Char] JournalContext (ErrorT String IO) JournalUpdate +commodityconversiondirective :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate commodityconversiondirective = do char 'C' "commodity conversion" many1 spacenonewline @@ -320,7 +320,7 @@ commodityconversiondirective = do restofline return $ return id -modifiertransaction :: ParsecT [Char] JournalContext (ErrorT String IO) ModifierTransaction +modifiertransaction :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction modifiertransaction = do char '=' "modifier transaction" many spacenonewline @@ -328,7 +328,7 @@ modifiertransaction = do postings <- postings return $ ModifierTransaction valueexpr postings -periodictransaction :: ParsecT [Char] JournalContext (ErrorT String IO) PeriodicTransaction +periodictransaction :: ParsecT [Char] JournalContext (ExceptT String IO) PeriodicTransaction periodictransaction = do char '~' "periodic transaction" many spacenonewline @@ -337,7 +337,7 @@ periodictransaction = do return $ PeriodicTransaction periodexpr postings -- | Parse a (possibly unbalanced) transaction. -transaction :: ParsecT [Char] JournalContext (ErrorT String IO) Transaction +transaction :: ParsecT [Char] JournalContext (ExceptT String IO) Transaction transaction = do -- ptrace "transaction" sourcepos <- getPosition diff --git a/hledger-lib/Hledger/Read/TimelogReader.hs b/hledger-lib/Hledger/Read/TimelogReader.hs index 2c56ad0d4..047481ffa 100644 --- a/hledger-lib/Hledger/Read/TimelogReader.hs +++ b/hledger-lib/Hledger/Read/TimelogReader.hs @@ -48,7 +48,7 @@ module Hledger.Read.TimelogReader ( ) where import Control.Monad -import Control.Monad.Error +import Control.Monad.Except import Data.List (isPrefixOf, foldl') import Test.HUnit import Text.Parsec hiding (parse) @@ -78,10 +78,10 @@ detect f s -- | Parse and post-process a "Journal" from timeclock.el's timelog -- format, saving the provided file path and the current time, or give an -- error. -parse :: Maybe FilePath -> Bool -> FilePath -> String -> ErrorT String IO Journal +parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal parse _ = parseJournalWith timelogFile -timelogFile :: ParsecT [Char] JournalContext (ErrorT String IO) (JournalUpdate, JournalContext) +timelogFile :: ParsecT [Char] JournalContext (ExceptT String IO) (JournalUpdate, JournalContext) timelogFile = do items <- many timelogItem eof ctx <- getState @@ -98,7 +98,7 @@ timelogFile = do items <- many timelogItem ] "timelog entry, or default year or historical price directive" -- | Parse a timelog entry. -timelogentry :: ParsecT [Char] JournalContext (ErrorT String IO) TimeLogEntry +timelogentry :: ParsecT [Char] JournalContext (ExceptT String IO) TimeLogEntry timelogentry = do sourcepos <- getPosition code <- oneOf "bhioO" diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 707eb9755..cb0d03009 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -45,6 +45,7 @@ flag old-locale if true then depend on time < 1.5 together with old-locale. default: False + library -- should set patchlevel here as in Makefile cpp-options: -DPATCHLEVEL=0 @@ -99,6 +100,7 @@ library ,directory ,filepath ,mtl + ,mtl-compat ,old-time ,parsec >= 3 ,regex-tdfa @@ -115,6 +117,7 @@ library else build-depends: time >= 1.5 + test-suite tests type: exitcode-stdio-1.0 main-is: suite.hs @@ -135,6 +138,7 @@ test-suite tests , filepath , HUnit , mtl + , mtl-compat , old-time , parsec >= 3 , regex-tdfa diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 9e7db6840..190ef8cbd 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -87,6 +87,7 @@ library ,haskeline >= 0.6 && <= 0.8 ,HUnit ,mtl + ,mtl-compat ,old-time ,parsec >= 3 ,process @@ -140,6 +141,7 @@ executable hledger ,haskeline >= 0.6 && <= 0.8 ,HUnit ,mtl + ,mtl-compat ,old-time ,parsec >= 3 ,process @@ -181,6 +183,7 @@ test-suite tests , haskeline , HUnit , mtl + , mtl-compat , old-time , parsec >= 3 , process @@ -196,12 +199,12 @@ test-suite tests , text , transformers , wizards == 1.0.* + if impl(ghc >= 7.4) + build-depends: pretty-show >= 1.6.4 if flag(old-locale) build-depends: time < 1.5, old-locale else build-depends: time >= 1.5 - if impl(ghc >= 7.4) - build-depends: pretty-show >= 1.6.4 -- not a standard cabal bench test, I think