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