slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix a failing test, handle unicode better in errors

Browse Source
This commit is contained in:
Simon Michael 2010-09-05 18:18:50 +00:00
parent 4cd85ec767
commit d29b393ca2
15 changed files with 40 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Hledger/Cli/Commands/Chart.hs
View File

@ -44,7 +44,7 @@ getOption opts opt def =
parseSize :: String -> (Int,Int)
parseSize str = (read w, read h)
where
x = fromMaybe (error "Size should be in WIDTHxHEIGHT format") $ findIndex (=='x') str
x = fromMaybe (error' "Size should be in WIDTHxHEIGHT format") $ findIndex (=='x') str
(w,_:h) = splitAt x str
-- | Generate pie chart

8
Hledger/Cli/Commands/Convert.hs
View File

@ -7,7 +7,7 @@ module Hledger.Cli.Commands.Convert where
import Hledger.Cli.Options (Opt(Debug))
import Hledger.Cli.Version (versionstr)
import Hledger.Data.Types (Journal,AccountName,Transaction(..),Posting(..),PostingType(..))
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual)
import Hledger.Data.Utils (strip, spacenonewline, restofline, parseWithCtx, assertParse, assertParseEqual, error')
import Hledger.Read.Common (emptyCtx)
import Hledger.Read.Journal (someamount,ledgeraccountname)
import Hledger.Data.Amount (nullmixedamt)
@ -71,11 +71,11 @@ type CsvRecord = [String]
-- using/creating a .rules file.
convert :: [Opt] -> [String] -> Journal -> IO ()
convert opts args _ = do
when (null args) $ error "please specify a csv data file."
when (null args) $ error' "please specify a csv data file."
let csvfile = head args
csvparse <- parseCSVFromFile csvfile
let records = case csvparse of
Left e -> error $ show e
Left e -> error' $ show e
Right rs -> reverse $ filter (/= [""]) rs
let debug = Debug `elem` opts
rulesfile = rulesFileFor csvfile
@ -85,7 +85,7 @@ convert opts args _ = do
writeFile rulesfile initialRulesFileContent
else
hPrintf stderr "using conversion rules file %s\n" rulesfile
rules <- liftM (either (error.show) id) $ parseCsvRulesFile rulesfile
rules <- liftM (either (error'.show) id) $ parseCsvRulesFile rulesfile
when debug $ hPrintf stderr "rules: %s\n" (show rules)
let requiredfields = max 2 (maxFieldIndex rules + 1)
badrecords = take 1 $ filter ((< requiredfields).length) records

6
Hledger/Cli/Commands/Vty.hs
View File

@ -117,13 +117,13 @@ scrollY = sy . loc
posY a = scrollY a + cursorY a
setCursorY, setScrollY, setPosY :: Int -> AppState -> AppState
setCursorY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings
setCursorY _ AppState{alocs=[]} = error' "shouldn't happen" -- silence warnings
setCursorY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocCursorY y l
setScrollY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings
setScrollY _ AppState{alocs=[]} = error' "shouldn't happen" -- silence warnings
setScrollY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)} where l' = setLocScrollY y l
setPosY _ AppState{alocs=[]} = error "shouldn't happen" -- silence warnings
setPosY _ AppState{alocs=[]} = error' "shouldn't happen" -- silence warnings
setPosY y a@AppState{alocs=(l:locs)} = a{alocs=(l':locs)}
where
l' = setLocScrollY sy $ setLocCursorY cy l

2
Hledger/Cli/Commands/Web.hs
View File

@ -725,7 +725,7 @@ hdstringlist :: [String] -> HamletData HledgerWebAppRoute
hdstringlist ss = HDList [ [([], hdstring s)] | s <- ss ]
instance Failure HamletException Handler
where failure = error . show
where failure = error' . show
renderHamletFile :: FilePath -> HamletMap HledgerWebAppRoute -> Handler Html
renderHamletFile hfile hmap = do

2
Hledger/Cli/Options.hs
View File

@ -179,7 +179,7 @@ parseArguments = do
case (as,es) of
(cmd:args,[]) -> return (os'',cmd,args)
([],[]) -> return (os'',"",[])
(_,errs) -> ioError (userError (concat errs ++ help1))
(_,errs) -> ioError (userError' (concat errs ++ help1))
-- | Convert any fuzzy dates within these option values to explicit ones,
-- based on today's date.

10
Hledger/Cli/Tests.hs
View File

@ -61,8 +61,8 @@ tests = TestList [
tests_Hledger_Commands,
"account directive" ~:
let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error return
j2 <- readJournal Nothing str2 >>= either error return
let sameParse str1 str2 = do j1 <- readJournal Nothing str1 >>= either error' return
j2 <- readJournal Nothing str2 >>= either error' return
j1 `is` j2{filereadtime=filereadtime j1, jtext=jtext j1}
in TestList
[
@ -243,7 +243,7 @@ tests = TestList [
,"2008/1/1 test "
," a:b 10h @ $50"
," c:d "
]) >>= either error return
]) >>= either error' return
let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment
balanceReportAsText [] (balanceReport [] nullfilterspec j') `is`
unlines
@ -292,7 +292,7 @@ tests = TestList [
(Mixed [dollars (-1)])
(case e of
Right e' -> (pamount $ last $ tpostings e')
Left _ -> error "should not happen")
Left _ -> error' "should not happen")
,"journalCanonicaliseAmounts" ~:
"use the greatest precision" ~:
@ -385,7 +385,7 @@ tests = TestList [
"assets:bank" `isSubAccountNameOf` "my assets" `is` False
,"default year" ~: do
rl <- readJournal Nothing defaultyear_journal_str >>= either error return
rl <- readJournal Nothing defaultyear_journal_str >>= either error' return
tdate (head $ jtxns rl) `is` fromGregorian 2009 1 1
return ()

4
Hledger/Cli/Utils.hs
View File

@ -38,7 +38,7 @@ withJournalDo opts args _ cmd = do
-- We kludgily read the file before parsing to grab the full text, unless
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
-- to let the add command work.
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either error runcmd
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either (error'.trace "BBB") runcmd
where
costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
runcmd = cmd opts args . costify
@ -46,7 +46,7 @@ withJournalDo opts args _ cmd = do
-- | Get a journal from the given string and options, or throw an error.
readJournalWithOpts :: [Opt] -> String -> IO Journal
readJournalWithOpts opts s = do
j <- readJournal Nothing s >>= either error return
j <- readJournal Nothing s >>= either error' return
return $ (if cost then journalConvertAmountsToCost else id) j
where cost = CostBasis `elem` opts

4
Hledger/Cli/Version.hs
View File

@ -41,8 +41,8 @@ binaryfilename = prettify $ splitAtElement '.' buildversion :: String
prettify (major:minor:bugfix:[]) = prettify [major,minor,bugfix,"0"]
prettify (major:minor:[]) = prettify [major,minor,"0","0"]
prettify (major:[]) = prettify [major,"0","0","0"]
prettify [] = error "VERSION is empty, please fix"
prettify _ = error "VERSION has too many components, please fix"
prettify [] = error' "VERSION is empty, please fix"
prettify _ = error' "VERSION has too many components, please fix"
versionstr = prettify $ splitAtElement '.' buildversion :: String
where

6
hledger-lib/Hledger/Data/Amount.hs
View File

@ -64,9 +64,9 @@ instance Num MixedAmount where
fromInteger i = Mixed [Amount (comm "") (fromInteger i) Nothing]
negate (Mixed as) = Mixed $ map negateAmountPreservingPrice as
(+) (Mixed as) (Mixed bs) = normaliseMixedAmount $ Mixed $ as ++ bs
(*) = error "programming error, mixed amounts do not support multiplication"
abs = error "programming error, mixed amounts do not support abs"
signum = error "programming error, mixed amounts do not support signum"
(*) = error' "programming error, mixed amounts do not support multiplication"
abs = error' "programming error, mixed amounts do not support abs"
signum = error' "programming error, mixed amounts do not support signum"
instance Ord MixedAmount where
compare (Mixed as) (Mixed bs) = compare as bs

2
hledger-lib/Hledger/Data/Commodity.hs
View File

@ -37,7 +37,7 @@ defaultcommodities = [dollar, euro, pound, hour, unknown]
-- | Look up one of the hard-coded default commodities. For use in tests.
comm :: String -> Commodity
comm sym = fromMaybe
(error "commodity lookup failed")
(error' "commodity lookup failed")
$ find (\(Commodity{symbol=s}) -> s==sym) defaultcommodities
-- | Find the conversion rate between two commodities. Currently returns 1.

6
hledger-lib/Hledger/Data/Dates.hs
View File

@ -65,7 +65,7 @@ splitspan start next span@(DateSpan (Just b) (Just e))
: splitspan' start next (DateSpan (Just n) (Just e))
where s = start b
n = next s
splitspan' _ _ _ = error "won't happen, avoids warnings"
splitspan' _ _ _ = error' "won't happen, avoids warnings"
-- | Count the days in a DateSpan, or if it is open-ended return Nothing.
daysInSpan :: DateSpan -> Maybe Integer
@ -234,12 +234,12 @@ parsedateM s = firstJust [
-- | Parse a date-time string to a time type, or raise an error.
parsedatetime :: String -> LocalTime
parsedatetime s = fromMaybe (error $ "could not parse timestamp \"" ++ s ++ "\"")
parsedatetime s = fromMaybe (error' $ "could not parse timestamp \"" ++ s ++ "\"")
(parsedatetimeM s)
-- | Parse a date string to a time type, or raise an error.
parsedate :: String -> Day
parsedate s = fromMaybe (error $ "could not parse date \"" ++ s ++ "\"")
parsedate s = fromMaybe (error' $ "could not parse date \"" ++ s ++ "\"")
(parsedateM s)
-- | Parse a time string to a time type using the provided pattern, or

2
hledger-lib/Hledger/Data/TimeLog.hs
View File

@ -65,7 +65,7 @@ entryFromTimeLogInOut :: TimeLogEntry -> TimeLogEntry -> Transaction
entryFromTimeLogInOut i o
| otime >= itime = t
| otherwise =
error $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
error' $ "clock-out time less than clock-in time in:\n" ++ showTransaction t
where
t = Transaction {
tdate = idate,

10
hledger-lib/Hledger/Data/Utils.hs
View File

@ -175,6 +175,14 @@ toPlatformString = case os of
"darwin" -> UTF8.encodeString
_ -> id
-- | A version of error that's better at displaying unicode.
error' :: String -> a
error' = error . toPlatformString
-- | A version of userError that's better at displaying unicode.
userError' :: String -> IOError
userError' = userError . toPlatformString
-- math
difforzero :: (Num a, Ord a) => a -> a -> a
@ -281,7 +289,7 @@ parseWithCtx ctx p = runParser p ctx ""
fromparse :: Either ParseError a -> a
fromparse = either parseerror id
parseerror e = error $ showParseError e
parseerror e = error' $ showParseError e
showParseError e = "parse error at " ++ show e

6
hledger-lib/Hledger/Read.hs
View File

@ -129,11 +129,11 @@ myTimelogPath =
-- | Read the user's default journal file, or give an error.
myJournal :: IO Journal
myJournal = myJournalPath >>= readJournalFile Nothing >>= either error return
myJournal = myJournalPath >>= readJournalFile Nothing >>= either error' return
-- | Read the user's default timelog file, or give an error.
myTimelog :: IO Journal
myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error return
myTimelog = myTimelogPath >>= readJournalFile Nothing >>= either error' return
tests_Hledger_Read = TestList
[
@ -141,7 +141,7 @@ tests_Hledger_Read = TestList
"journalFile" ~: do
assertBool "journalFile should parse an empty file" (isRight $ parseWithCtx emptyCtx Journal.journalFile "")
jE <- readJournal Nothing "" -- don't know how to get it from journalFile
either error (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE
either error' (assertBool "journalFile parsing an empty file should give an empty journal" . null . jtxns) jE
,Journal.tests_Journal
,Timelog.tests_Timelog

2
hledger-lib/Hledger/Read/Common.hs
View File

@ -36,7 +36,7 @@ parseJournalWith p f s = do
tl <- liftIO getCurrentLocalTime
case runParser p emptyCtx f s of
Right updates -> liftM (journalFinalise tc tl f s) $ updates `ap` return nulljournal
Left err -> throwError $ show err -- XXX raises an uncaught exception if we have a parsec user error, eg from many ?
Left err -> throwError $ show err
-- | Some state kept while parsing a journal file.
data JournalContext = Ctx {